lustre/obdclass/obdcontrol

   1 #!/usr/bin/perl
   2
   3 #
   4 # This code is issued under the GNU General Public License.
   5 # See the file COPYING in this distribution
   6 #
   7 # Copyright (C) 1998, Stelias Computing
   8 #
   9 # Modified for InterMezzo from Gordian's HSM bcache device/jcm module
  10 # Copyright (C) 1999, Carnegie Mellon University
  11 #
  12 # Derived from InterMezzo's incontrol, modified for OBD's
  13 # Copyright (C) 1999, Stelias Computing
  14 #
  15 #
  16
  17 #use strict;
  18 BEGIN { require "asm/errno.ph" };
  19 BEGIN { require "asm/ioctl.ph" };
  20
  21 # p2ph generated invalid macros for ioctl stuff, so I override some of it here
  22 eval 'sub OBD_IOC_CREATE () { &_IOC(2, ord(\'f\'), 3, 4);}' unless
  23   defined(&OBD_IOC_CREATE);
  24 eval 'sub OBD_IOC_SETUP () { &_IOC(1, ord(\'f\'), 4, 4);}' unless
  25   defined(&OBD_IOC_SETUP);
  26 eval 'sub OBD_IOC_CLEANUP () { &_IOC(0, ord(\'f\'), 5, 0);}' unless
  27   defined(&OBD_IOC_CLEANUP);
  28 eval 'sub OBD_IOC_DESTROY () { &_IOC(1, ord(\'f\'), 6, 4);}' unless
  29   defined(&OBD_IOC_DESTROY);
  30 eval 'sub OBD_IOC_PREALLOCATE () { &_IOC(3, ord(\'f\'), 7, 4);}' unless
  31   defined(&OBD_IOC_PREALLOCATE);
  32 eval 'sub OBD_IOC_DEC_USE_COUNT () { &_IOC(0, ord(\'f\'), 8, 0);}' unless
  33   defined(&OBD_IOC_DEC_USE_COUNT);
  34 eval 'sub OBD_IOC_SETATTR () { &_IOC(1, ord(\'f\'), 9, 4);}' unless
  35   defined(&OBD_IOC_SETATTR);
  36 eval 'sub OBD_IOC_GETATTR () { &_IOC(2, ord(\'f\'), 10, 4);}' unless
  37   defined(&OBD_IOC_GETATTR);
  38 eval 'sub OBD_IOC_READ () { &_IOC(3, ord(\'f\'), 11, 4);}' unless
  39   defined(&OBD_IOC_READ);
  40 eval 'sub OBD_IOC_WRITE () { &_IOC(3, ord(\'f\'), 12, 4);}' unless
  41   defined(&OBD_IOC_WRITE);
  42 eval 'sub OBD_IOC_CONNECT () { &_IOC(2, ord(\'f\'), 13, 4);}' unless
  43   defined(&OBD_IOC_CONNECT);
  44 eval 'sub OBD_IOC_DISCONNECT () { &_IOC(1, ord(\'f\'), 14, 4);}' unless
  45   defined(&OBD_IOC_DISCONNECT);
  46 eval 'sub OBD_IOC_STATFS () { &_IOC(3, ord(\'f\'), 15, 4);}' unless
  47   defined(&OBD_IOC_STATFS);
  48 eval 'sub OBD_IOC_SYNC () { &_IOC(2, ord(\'f\'), 16, 4);}' unless
  49   defined(&OBD_IOC_SYNC);
  50 eval 'sub OBD_IOC_READ2 () { &_IOC(3, ord(\'f\'), 17, 4);}' unless
  51   defined(&OBD_IOC_READ2);
  52 eval 'sub OBD_IOC_FORMATOBD () { &_IOC(3, ord(\'f\'), 18, 4);}' unless
  53   defined(&OBD_IOC_FORMATOBD);
  54 eval 'sub OBD_IOC_PARTITION () { &_IOC(3, ord(\'f\'), 19, 4);}' unless
  55   defined(&OBD_IOC_PARTITION);
  56 eval 'sub OBD_IOC_ATTACH () { &_IOC(3, ord(\'f\'), 20, 4);}' unless
  57   defined(&OBD_IOC_ATTACH);
  58 eval 'sub OBD_IOC_DETACH () { &_IOC(3, ord(\'f\'), 21, 4);}' unless
  59   defined(&OBD_IOC_DETACH);
  60 eval 'sub OBD_IOC_COPY () { &_IOC(3, ord(\'f\'), 22, 4);}' unless
  61   defined(&OBD_IOC_COPY);
  62 eval 'sub OBD_IOC_MIGR () { &_IOC(3, ord(\'f\'), 23, 4);}' unless
  63   defined(&OBD_IOC_MIGR);
  64 eval 'sub OBD_SNAP_SETTABLE () { &_IOC(3, ord(\'f\'), 40, 4);}' unless
  65   defined(&OBD_SNAP_SETTABLE);
  66 eval 'sub OBD_SNAP_PRINTTABLE () { &_IOC(3, ord(\'f\'), 41, 4);}' unless
  67   defined(&OBD_SNAP_PRINTTABLE);
  68
  69 eval 'sub OBD_EXT2_RUNIT () { &_IOC(3, ord(\'f\'), 61, 4);}' unless
  70   defined(&OBD_EXT2_RUNIT);
  71
  72 eval 'sub ATTR_MODE () {1;}' unless defined(&ATTR_MODE);
  73 eval 'sub ATTR_UID () {2;}' unless defined(&ATTR_UID);
  74 eval 'sub ATTR_GID () {4;}' unless defined(&ATTR_GID);
  75 eval 'sub ATTR_SIZE () {8;}' unless defined(&ATTR_SIZE);
  76 eval 'sub ATTR_ATIME () {16;}' unless defined(&ATTR_ATIME);
  77 eval 'sub ATTR_MTIME () {32;}' unless defined(&ATTR_MTIME);
  78 eval 'sub ATTR_CTIME () {64;}' unless defined(&ATTR_CTIME);
  79
  80 use Getopt::Long;
  81 use File::stat;
  82 use Storable;
  83 use Carp;
  84 use Term::ReadLine;
  85 use IO::Handle;
  86
  87
  88 my ($file);
  89
  90 GetOptions("f!" => \$file, "device=s" => \$::device, "fs=s" => $::filesystem) || die "Getoptions";
  91
  92
  93 # get a console for the app
  94
  95 my $line;
  96 my $command;
  97 my $arg;
  98
  99 my %commands =
 100     ('device' => {func => "Device", doc => "device <dev>: open another OBD device"},
 101      'filesystem' => {func => "Filesystem", doc => "filesystem <dev>: partition for direct OBD device"},
 102      'create' => {func => "Create", doc => "create: creates a new inode"},
 103      'attach' => {func => "Attach", doc => "attach type [adapter bus tid lun]"},
 104      'detach' => {func => "Detach", doc => "detach this device"},
 105      'snapattach' => {func => "SnapAttach", doc => "snapattach snapno table"},
 106      'snapset' => {func => "SnapSetTable", doc => "snapset tableno file" },
 107      'snapprint' => {func => "SnapPrint", doc => "snapprint tableno"},
 108
 109      'testiterator' => {func => "TestIterator", doc => ""},
 110
 111      'snaptable' => {func => "SnapShotTable", doc => "snaptable: build a snapshot table (interactive)"},
 112      'copy' => {func => "Copy", doc => "copy srcid tgtid"},
 113      'migrate' => {func => "Migrate", doc => "migrate srcid tgtid"},
 114      'format' => {func => "Format", doc => "format type adapter bus tid lun size"},
 115      'partition' => {func => "Partition", doc => "partition type adapter bus tid lun partition size"},
 116      'setup' => {func => "Setup", doc => "setup: link the ext2 partition (default /dev/loop0) to this obddev"},
 117      'connect' => {func => "Connect", doc => "connect: allocates client ID for this session"},
 118      'disconnect' => {func => "Disconnect", doc => "disconnect [id]: frees client resources"},
 119      'sync' => {func => "Sync", doc => "sync: flushes buffers to disk"},
 120      'destroy' => {func => "Destroy", doc => "setup: destroys an inode"},
 121      'cleanup' => {func => "Cleanup", doc => "cleanup the minor obd device"},
 122      'dec_use_count' => {func => "Decusecount", doc => "decreases the module use count so that the module can be removed following an oops"},
 123      'read' => {func => "Read", doc => "read <inode> <count> [offset]"},
 124      'fsread' => {func => "Read2", doc => "read <inode> <count> [offset]"},
 125      'write' => {func => "Write", doc => "write <inode> <offset> <text>"},
 126      'setattr' => {func => "Setattr", doc => "setattr <inode> [mode [uid [gid [size [atime [mtime [ctime]]]]]]]"},
 127      'getattr' => {func => "Getattr", doc => "getattr <inode>: displays inode object attributes"},
 128      'preallocate' => {func => "Preallocate", doc => "preallocate [num]: requests preallocation of num inodes."},
 129      'statfs' => {func => "Statfs", doc => "statfs: filesystem status information"},
 130      'help' => {func => \&Help,  doc => "help: this message"},
 131      'quit' => {func => \&Quit,  doc => "see \"exit\""},
 132      'exit' => {func => \&Quit,  doc => "see \"quit\""}
 133     );
 134
 135 #
 136 #       setup completion function
 137 #
 138 my @jcm_cmd_list = keys %commands;
 139
 140 my $term, $attribs;
 141
 142
 143 # Get going....
 144
 145 Device($::device);
 146 Filesystem($::filesystem);
 147
 148 sub readl {
 149     if ( $file ) {
 150         my $str = <STDIN>;
 151         chop($str);
 152         return $str;
 153   } else {
 154       return $term->readline(@_);
 155   }
 156 }
 157
 158
 159
 160 if ( $file ) {
 161         while ( <STDIN> ) {
 162             print $_;
 163             execute_line($_);
 164         }
 165         exit 0;
 166 } else {
 167     $term = new Term::ReadLine 'obdcontrol ';
 168     $attribs = $term->Attribs;
 169     $attribs->{attempted_completion_function} = \&completeme;
 170     $term->ornaments('md,me,,');        # bold face prompt
 171
 172     # make sure stdout is not buffered
 173     STDOUT->autoflush(1);
 174
 175
 176     # Get on with the show
 177     process_line();
 178 }
 179
 180 #------------------------------------------------------------------------------
 181 sub completeme {
 182     my ($text, $line, $start, $end) = @_;
 183     if (substr($line, 0, $start) =~ /^\s*$/) {
 184         $attribs->{completion_word} = \@jcm_cmd_list;
 185         return $term->completion_matches($text,
 186                                          $attribs->{'list_completion_function'});
 187     }
 188 }
 189
 190 sub find_command {
 191     my $given = shift;
 192     my $name;
 193     my @completions = completeme($given, $given, 0, length($given));
 194     if ($#completions == 0) {
 195         $name = shift @completions;
 196     }
 197
 198     return $name;
 199 }
 200
 201 # start making requests
 202 sub process_line {
 203   foo:
 204     $line = $term->readline("obdcontrol > ");
 205     execute_line($line);
 206     goto foo;
 207 }
 208
 209 sub execute_line {
 210     my $line = shift;
 211
 212     my @arg = split(' ', $line);
 213     my $word = shift @arg;
 214
 215     my $cmd;
 216     if ( $file ) {
 217         $cmd = $word;
 218     } else {
 219         $cmd = find_command($word);
 220     }
 221     unless ($cmd) {
 222         printf STDERR "$word: No such command, or not unique.\n";
 223         return (-1);
 224     }
 225
 226     if ($cmd eq "help" || $cmd eq "exit" || $cmd eq "quit") {
 227         return (&{$commands{$cmd}->{func}}(@arg));
 228     }
 229
 230     # Call the function.
 231     return (&{$commands{$cmd}->{func}}(@arg));
 232 }
 233
 234 # set the object store in the ext2 formatted block device
 235 sub Filesystem {
 236     my $filesystem = shift;
 237     $filesystem = "/dev/loop0" unless $filesystem;
 238
 239     $::filesystem = $filesystem;
 240     if (!defined($::st = stat($filesystem))) {
 241         die "Unable to stat $filesystem.\n";
 242     }
 243 }
 244
 245 # select the OBD device we talk to
 246 sub Device {
 247     my $device = shift;
 248
 249     if (! $device ) {
 250         $device = "/dev/obd0";
 251     }
 252     $::device = $device;
 253     # Open the device, as we need an FD for the ioctl
 254     sysopen(DEV_OBD, $device, 0) || die "Cannot open $device";
 255     print "Device now $device\n";
 256 }
 257
 258
 259
 260 sub Attach {
 261     my $err = 0;
 262     my $type = shift;
 263     my $data;
 264     my $datalen = 0;
 265
 266     if ($type eq "obdscsi" ) {
 267         my $adapter = shift;
 268         my $bus = shift;
 269         my $tid = shift;
 270         my $lun = shift;
 271         $data = pack("iiiii", $adapter, $bus, $tid, $lun, $size);
 272         $datalen = 4 * 4;
 273     }
 274
 275     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 276
 277     my $rc = ioctl(DEV_OBD, &OBD_IOC_ATTACH, $packed);
 278
 279     if (!defined $rc) {
 280         print STDERR "ioctl failed: $!\n";
 281     } elsif ($rc eq "0 but true") {
 282         print "Finished (success)\n";
 283     } else {
 284         print "ioctl returned error code $rc.\n";
 285     }
 286 }
 287
 288 sub Detach {
 289     my $err = 0;
 290     my $data = "";
 291     my $rc = ioctl(DEV_OBD, &OBD_IOC_DETACH, $data);
 292
 293     if (!defined $rc) {
 294         print STDERR "ioctl failed: $!\n";
 295     } elsif ($rc eq "0 but true") {
 296         print "Finished (success)\n";
 297     } else {
 298         print "ioctl returned error code $rc.\n";
 299     }
 300 }
 301
 302
 303
 304 sub TestIterator {
 305     my $err = 0;
 306     my $type = "ext2_obd";
 307
 308     $data = pack("i", 4711);
 309     $datalen = 4;
 310
 311     my $len = length($type);
 312     my $cl = length($data);
 313     my $add = pack("p", $data);
 314     print "type $type (len $len), datalen $datalen ($cl)\n";
 315     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 316
 317     my $rc = ioctl(DEV_OBD, &OBD_EXT2_RUNIT, $packed);
 318
 319     if (!defined $rc) {
 320         print STDERR "ioctl failed: $!\n";
 321     } elsif ($rc eq "0 but true") {
 322         print "Finished (success)\n";
 323     } else {
 324         print "ioctl returned error code $rc.\n";
 325     }
 326 }
 327
 328 sub SnapPrint {
 329     my $err = 0;
 330     my $type = "snap_obd";
 331     my $snaptableno = shift;
 332
 333     $data = pack("i", $snaptableno);
 334     $datalen = 4;
 335
 336     my $len = length($type);
 337     my $cl = length($data);
 338     my $add = pack("p", $data);
 339     print "type $type (len $len), datalen $datalen ($cl)\n";
 340     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 341
 342     my $rc = ioctl(DEV_OBD, &OBD_SNAP_PRINTTABLE, $packed);
 343
 344     if (!defined $rc) {
 345         print STDERR "ioctl failed: $!\n";
 346     } elsif ($rc eq "0 but true") {
 347         print "Finished (success)\n";
 348     } else {
 349         print "ioctl returned error code $rc.\n";
 350     }
 351 }
 352
 353 sub SnapSetTable {
 354     my $err = 0;
 355     my $type = "snap_obd";
 356     my $snaptableno = shift;
 357     my $file = shift;
 358     my $snapcount;
 359     my $table = {};
 360     my $data;
 361     my $datalen = 0;
 362
 363     if ( ! -f $file ) {
 364         print "No such file $file\n";
 365     }
 366
 367     $table = ReadSnapShotTable($file);
 368
 369     $snapcount = keys %{$table};
 370     print "Snapcount $snapcount\n";
 371
 372     if ( ! defined $table->{0} ) {
 373         print "No current snapshot in table! First make one\n";
 374         return ;
 375     }
 376     $data = pack("ii", $snaptableno, $snapcount);
 377     $datalen = 2 * 4;
 378     foreach my $time (sort keys %{$table}) {
 379         $data .= pack("Ii", $time, $table->{$time});
 380         $datalen += 8;
 381     }
 382
 383     my $len = length($type);
 384     my $cl = length($data);
 385     my $add = pack("p", $data);
 386     print "type $type (len $len), datalen $datalen ($cl)\n";
 387     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 388
 389     my $rc = ioctl(DEV_OBD, &OBD_SNAP_SETTABLE, $packed);
 390
 391     if (!defined $rc) {
 392         print STDERR "ioctl failed: $!\n";
 393     } elsif ($rc eq "0 but true") {
 394         print "Finished (success)\n";
 395     } else {
 396         print "ioctl returned error code $rc.\n";
 397     }
 398 }
 399
 400
 401 sub SnapAttach {
 402     my $err = 0;
 403     my $type = "snap_obd";
 404     my $snapdev = shift;
 405     my $snapno = shift;
 406     my $tableno = shift;
 407     my $snapcount;
 408     my $data;
 409     my $datalen = 0;
 410
 411 #    if ( ! -f $file ) {
 412 #       print "No such file $file\n";
 413 #    }
 414
 415 #    $table = ReadSnapShotTable($file);
 416     $data = pack("iii", $snapdev, $snapno, $tableno);
 417     $datalen = 3 * 4;
 418
 419     my $len = length($type);
 420     my $cl = length($data);
 421     my $add = pack("p", $data);
 422     print "type $type (len $len), datalen $datalen ($cl)\n";
 423     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 424
 425     my $rc = ioctl(DEV_OBD, &OBD_IOC_ATTACH, $packed);
 426
 427     if (!defined $rc) {
 428         print STDERR "ioctl failed: $!\n";
 429     } elsif ($rc eq "0 but true") {
 430         print "Finished (success)\n";
 431     } else {
 432         print "ioctl returned error code $rc.\n";
 433     }
 434 }
 435
 436
 437 sub SnapShotTable  {
 438
 439     my $file = &readl("enter file name: ");
 440     if ( ! -f $file ) {
 441         `touch $file`;
 442     }
 443     my $table = ReadSnapShotTable($file);
 444
 445   again:
 446     PrintSnapShotTable($table);
 447     my $action = &readl("Add, Delete or Quit [adq]: ");
 448     goto done if ($action  =~ "^q.*" );
 449     goto add if ($action =~ "^a.*");
 450     goto del  if ($action =~ "^d.*");
 451     goto again;
 452
 453   add:
 454     my $idx = &readl("enter index where you want this snapshot: ");
 455     my $time = &readl("enter time or 'now' or 'current': ");
 456     my $oldtime = SnapFindTimeFromIdx($idx, $table);
 457     if (defined $oldtime) {
 458         print "This already exists, first clean up\n";
 459         goto again;
 460     }
 461
 462     if ( $time  eq 'now' ) {
 463         $time = time;
 464     } elsif ( $time eq 'current' ) {
 465         $time = 0;
 466     }
 467     $table->{$time} = $idx;
 468     goto again;
 469
 470   del:
 471     $didx = &readl("Enter index to delete: ");
 472     my $deltime = SnapFindTimeFromIdx($didx, $table);
 473     delete $table->{$deltime} if defined $deltime;
 474     goto again;
 475
 476   done:
 477     my $ok = &readl("OK with new table? [Yn]: ");
 478     unless ( $ok eq "no" )  {
 479       WriteSnapShotTable($file, $table);
 480   }
 481 }
 482
 483 sub SnapFindTimeFromIdx {
 484     my $idx = shift;
 485     my $table = shift;
 486
 487     foreach my $time ( keys %{$table} ) {
 488         if ( $table->{$time} == $idx ) {
 489             return $time;
 490         }
 491     }
 492     undef;
 493 }
 494
 495 sub PrintSnapShotTable {
 496     my $table = shift;
 497     my $time;
 498
 499     foreach  $time ( sort keys %{$table} ) {
 500         my $stime = localtime($time);
 501         if ( ! $time ) {
 502             $stime = "current";
 503         }
 504         printf "Time: %s -- Index %d\n", $stime, $table->{$time};
 505     }
 506 }
 507
 508 sub ReadSnapShotTable {
 509
 510     my $file = shift;
 511     my $table = {};
 512
 513     open FH, "<$file";
 514     while ( <FH> ) {
 515         my ($time, $index) = split ;
 516         $table->{$time} = $index;
 517     }
 518     close FH;
 519
 520     PrintSnapShotTable($table);
 521
 522     return $table;
 523 }
 524
 525 sub WriteSnapShotTable {
 526     my $file = shift;
 527     my $table = shift;
 528
 529     open FH, ">$file";
 530     foreach my $time ( sort keys %{$table}  ) {
 531         print FH "$time $table->{$time}\n";
 532     }
 533     close FH;
 534 }
 535
 536 sub Copy {
 537     my $err = 0;
 538     my $srcid = shift;
 539     my $tgtid = shift;
 540     my $data = pack("III", $::client_id, $srcid, $tgtid);
 541     my $datalen = 12;
 542
 543     my $packed = pack("ip", $datalen, $data);
 544     my $rc = ioctl(DEV_OBD, &OBD_IOC_COPY, $packed);
 545
 546     if (!defined $rc) {
 547         print STDERR "ioctl failed: $!\n";
 548     } elsif ($rc eq "0 but true") {
 549         print "Finished (success)\n";
 550     } else {
 551         print "ioctl returned error code $rc.\n";
 552     }
 553 }
 554
 555 sub Migrate {
 556     my $err = 0;
 557     my $srcid = shift;
 558     my $tgtid = shift;
 559     my $data = pack("III", $::client_id, $srcid, $tgtid);
 560     my $datalen = 12;
 561
 562     my $packed = pack("ip", $datalen, $data);
 563     my $rc = ioctl(DEV_OBD, &OBD_IOC_MIGR, $packed);
 564
 565     if (!defined $rc) {
 566         print STDERR "ioctl failed: $!\n";
 567     } elsif ($rc eq "0 but true") {
 568         print "Finished (success)\n";
 569     } else {
 570         print "ioctl returned error code $rc.\n";
 571     }
 572 }
 573
 574
 575 sub Format {
 576     my $err = 0;
 577     my $size = shift;
 578     my $data = pack("i", $size);
 579     my $datalen = 4;
 580
 581     my $packed = pack("ip", $datalen, $data);
 582     my $rc = ioctl(DEV_OBD, &OBD_IOC_FORMATOBD, $packed);
 583
 584     if (!defined $rc) {
 585         print STDERR "ioctl failed: $!\n";
 586     } elsif ($rc eq "0 but true") {
 587         print "Finished (success)\n";
 588     } else {
 589         print "ioctl returned error code $rc.\n";
 590     }
 591 }
 592
 593 sub Partition {
 594     my $err = 0;
 595     my $partno = shift;
 596     my $size = shift;
 597     my $data = pack("ii", $partno, $size);
 598     my $datalen = 2 * 4;
 599
 600     my $packed = pack("ip", $datalen, $data);
 601     my $rc = ioctl(DEV_OBD, &OBD_IOC_PARTITION, $packed);
 602
 603     if (!defined $rc) {
 604         print STDERR "ioctl failed: $!\n";
 605     } elsif ($rc eq "0 but true") {
 606         print "Finished (success)\n";
 607     } else {
 608         print "ioctl returned error code $rc.\n";
 609     }
 610 }
 611
 612 sub Setup {
 613     my $err = 0;
 614     my $type = shift;
 615     my $data;
 616     my $datalen = 0;
 617
 618     $type = "ext2_obd" unless $type;
 619
 620     if ( $type eq "ext2_obd" ) {
 621         my $dev = shift;
 622         $dev = $::st->rdev() unless $dev;
 623         $data = pack("i", $dev);
 624         $datalen = 4;
 625     }
 626
 627     my $packed = pack("ip", $datalen, $data);
 628     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETUP, $packed);
 629
 630     if (!defined $rc) {
 631         print STDERR "ioctl failed: $!\n";
 632     } elsif ($rc eq "0 but true") {
 633         print "Finished (success)\n";
 634     } else {
 635         print "ioctl returned error code $rc.\n";
 636     }
 637 }
 638
 639 sub Cleanup {
 640     my $err = "0";
 641     my $rc = ioctl(DEV_OBD, &OBD_IOC_CLEANUP, $err);
 642
 643     if (!defined $rc) {
 644         print STDERR "ioctl failed: $!\n";
 645     } elsif ($rc eq "0 but true") {
 646         print "Finished (success)\n";
 647         $::client_id = 0;
 648     } else {
 649         print "ioctl returned error code $rc.\n";
 650     }
 651 }
 652
 653
 654 sub Connect {
 655     my $rc;
 656
 657     my $packed = "";
 658     $rc = ioctl(DEV_OBD, &OBD_IOC_CONNECT, $packed);
 659     $id = unpack("I", $packed);
 660
 661     if (!defined $rc) {
 662         print STDERR "ioctl failed: $!\n";
 663     } elsif ($rc eq "0 but true") {
 664         $::client_id = $id;
 665         print "Client ID     : $id\n";
 666         print "Finished (success)\n";
 667     } else {
 668         print "ioctl returned error code $rc.\n";
 669     }
 670 }
 671
 672 sub Disconnect {
 673     my $id = shift;
 674
 675     if (!defined($id)) {
 676         $id = $::client_id;
 677     }
 678
 679     if (!defined($id)) {
 680         print "syntax: disconnect [client ID]\n";
 681         print "When client ID is not given, the last valid client ID to be returned by a\n";
 682         print "connect command this session is used; there is no such ID.\n";
 683         return;
 684     }
 685
 686     my $packed = pack("L", $id);
 687     my $rc = ioctl(DEV_OBD, &OBD_IOC_DISCONNECT, $packed);
 688
 689     if (!defined $rc) {
 690         print STDERR "ioctl failed: $!\n";
 691     } elsif ($rc eq "0 but true") {
 692         $::client_id = undef;
 693         print "Finished (success)\n";
 694     } else {
 695         print "ioctl returned error code $rc.\n";
 696     }
 697 }
 698
 699 sub Create {
 700     my $arg = shift;
 701     my $quiet = shift;
 702     my $rc;
 703     my $prealloc = 0;
 704
 705     if (defined($quiet) && !($quiet eq "quiet")) {
 706         print "syntax: create [number of objects [quiet]]\n";
 707         return;
 708     }
 709
 710     my $packed = pack("IL", $::client_id, $prealloc);
 711     if (!defined($arg) || scalar($arg) < 2) {
 712         print "Creating 1 object...\n";
 713         $rc = ioctl(DEV_OBD, &OBD_IOC_CREATE, $packed);
 714         if (!defined($quiet)) {
 715             my $ino = unpack("L", $packed);
 716             print "Created object #$ino.\n";
 717         }
 718     } else {
 719         my $i;
 720
 721         print "Creating " . scalar($arg) . " objects...\n";
 722         for ($i = 0; $i < scalar($arg); $i++) {
 723             $rc = ioctl(DEV_OBD, &OBD_IOC_CREATE, $packed);
 724             my $ino = unpack("L", $packed);
 725             if (!($rc eq "0 but true")) {
 726                 last;
 727                 $packed = pack("IL", $::client_id, $prealloc);
 728             } elsif (!defined($quiet)) {
 729                 $packed = pack("IL", $::client_id, $prealloc);
 730                 print "Created object #$ino.\n";
 731             }
 732         }
 733     }
 734
 735     if (!defined $rc) {
 736         print STDERR "ioctl failed: $!\n";
 737     } elsif ($rc eq "0 but true") {
 738         print "Finished (success)\n";
 739     } else {
 740         print "ioctl returned error code $rc.\n";
 741     }
 742 }
 743
 744 sub Sync {
 745     my $err = "0";
 746     my $rc = ioctl(DEV_OBD, &OBD_IOC_SYNC, $err);
 747
 748     if (!defined $rc) {
 749         print STDERR "ioctl failed: $!\n";
 750     } elsif ($rc eq "0 but true") {
 751         print "Finished (success)\n";
 752     } else {
 753         print "ioctl returned error code $rc.\n";
 754     }
 755 }
 756
 757 sub Destroy {
 758     if (!defined($::client_id)) {
 759         print "You must first ``connect''.\n";
 760         return;
 761     }
 762
 763     my $arg = shift;
 764
 765     if (!defined($arg) || scalar($arg) < 1) {
 766         print "destroy requires the object number to destroy.\n";
 767         return;
 768     }
 769
 770     print "Destroying object $arg...\n";
 771     my $packed = pack("IL", $::client_id, $arg);
 772     my $rc = ioctl(DEV_OBD, &OBD_IOC_DESTROY, $packed);
 773
 774     if (!defined $rc) {
 775         print STDERR "ioctl failed: $!\n";
 776     } elsif ($rc eq "0 but true") {
 777         print "Finished (success)\n";
 778     } else {
 779         print "ioctl returned error code $rc.\n";
 780     }
 781 }
 782
 783 sub Getattr {
 784     if (!defined($::client_id)) {
 785         print "You must first ``connect''.\n";
 786         return;
 787     }
 788
 789     my $inode = shift;
 790
 791     if (!defined($inode) || scalar($inode) < 1) {
 792         print "invalid arguments; type \"help getattr\" for a synopsis\n";
 793         return;
 794     }
 795
 796     # see Setattr
 797     my $packed = pack("ILsx2lLLLI", $::client_id, $inode, 0, 0, 0, 0, 0, 0, 0,
 798                       0);
 799     my $rc = ioctl(DEV_OBD, &OBD_IOC_GETATTR, $packed);
 800
 801     if (!defined $rc) {
 802         print STDERR "ioctl failed: $!\n";
 803     } elsif ($rc eq "0 but true") {
 804         my ($valid, $mode, $uid, $gid, $size, $atime, $mtime, $ctime, $flags);
 805         ($valid, $mode, $uid, $gid, $size, $atime, $mtime, $ctime, $flags) =
 806           unpack("ISssx2lLLLI", $packed);
 807
 808         printf("Inode: %d  Mode:  %o\n", $inode, $mode);
 809         printf("User: %6d   Group: %6d   Size: %d\n", $uid, $gid, $size);
 810         printf("ctime: %08lx -- %s\n", $ctime, scalar(gmtime($ctime)));
 811         printf("atime: %08lx -- %s\n", $atime, scalar(gmtime($atime)));
 812         printf("mtime: %08lx -- %s\n", $mtime, scalar(gmtime($mtime)));
 813         printf("flags: %08x\n", $flags);
 814         print "Finished (success)\n";
 815     } else {
 816         print "ioctl returned error code $rc.\n";
 817     }
 818 }
 819
 820 sub Setattr {
 821     if (!defined($::client_id)) {
 822         print "You must first ``connect''.\n";
 823         return;
 824     }
 825
 826     my $inode = shift;
 827     my $valid = 0;
 828     my $mode = oct(shift);
 829     my $uid = shift;
 830     my $gid = shift;
 831     my $size = shift;
 832     my $atime = shift;
 833     my $mtime = shift;
 834     my $ctime = shift;
 835
 836     if (defined($uid)) {
 837         $valid |= &ATTR_UID;
 838     }
 839     if (defined($gid)) {
 840         $valid |= &ATTR_GID;
 841     }
 842     if (defined($size)) {
 843         $valid |= &ATTR_SIZE;
 844     }
 845     if (defined($atime)) {
 846         $valid |= &ATTR_ATIME;
 847     }
 848     if (defined($mtime)) {
 849         $valid |= &ATTR_MTIME;
 850     }
 851     if (defined($ctime)) {
 852         $valid |= &ATTR_CTIME;
 853     }
 854     if (defined($mode)) {
 855         $valid |= &ATTR_MODE;
 856     }
 857
 858     if (!defined($inode) || scalar($inode) < 1) {
 859         print "invalid arguments; type \"help setattr\" for a synopsis\n";
 860         return;
 861     }
 862
 863     #struct iattr {
 864     #        unsigned int    ia_valid; (32)
 865     #        umode_t         ia_mode; (16)
 866     #        uid_t           ia_uid; (16)
 867     #        gid_t           ia_gid; (16)
 868     # -- 16 bit alignment here! --
 869     #        off_t           ia_size; (32)
 870     #        time_t          ia_atime; (32)
 871     #        time_t          ia_mtime; (32)
 872     #        time_t          ia_ctime; (32)
 873     #        unsigned int    ia_attr_flags; (32)
 874     #};
 875
 876     printf "valid is %x, mode is %o\n", $valid, $mode;
 877     my $packed = pack("ILLSssx2ILLLL", $::client_id, $inode, $valid, $mode,
 878                       $uid, $gid, $size, $atime, $mtime, $ctime, 0);
 879     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETATTR, $packed);
 880
 881     if (!defined $rc) {
 882         print STDERR "ioctl failed: $!\n";
 883     } elsif ($rc eq "0 but true") {
 884         print "Finished (success)\n";
 885     } else {
 886         print "ioctl returned error code $rc.\n";
 887     }
 888 }
 889
 890 sub Read {
 891     if (!defined($::client_id)) {
 892         print "You must first ``connect''.\n";
 893         return;
 894     }
 895
 896     my $inode = shift;
 897     my $count = shift;
 898     my $offset = shift;
 899
 900     if (!defined($inode) || scalar($inode) < 1 || !defined($count) ||
 901         $count < 1 || (defined($offset) && $offset < 0)) {
 902         print "invalid arguments; type \"help read\" for a synopsis\n";
 903         return;
 904     }
 905
 906     if (!defined($offset)) {
 907         $offset = 0;
 908     }
 909
 910     print("Reading $count bytes starting at byte $offset from object " .
 911           "$inode...\n");
 912
 913     # "allocate" a large enough buffer
 914     my $buf = sprintf("%${count}s", " ");
 915     die "suck" if (length($buf) != $count);
 916
 917     # the perl we're using doesn't support pack type Q, and offset is 64 bits
 918     my $packed = pack("ILpLLL", $::client_id, $inode, $buf, $count, $offset, 0);
 919
 920     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ, $packed);
 921
 922     $retval = unpack("l", $packed);
 923
 924     if (!defined $rc) {
 925         print STDERR "ioctl failed: $!\n";
 926     } elsif ($rc eq "0 but true") {
 927         if ($retval >= 0) {
 928                 print substr($buf, 0, $retval);
 929                 print "\nRead $retval of an attempted $count bytes.\n";
 930                 print "Finished (success)\n";
 931         } else {
 932                 print "Finished (error $retval)\n";
 933         }
 934     } else {
 935         print "ioctl returned error code $rc.\n";
 936     }
 937 }
 938
 939 sub Read2 {
 940     if (!defined($::client_id)) {
 941         print "You must first ``connect''.\n";
 942         return;
 943     }
 944
 945     my $inode = shift;
 946     my $count = shift;
 947     my $offset = shift;
 948
 949     if (!defined($inode) || scalar($inode) < 1 || !defined($count) ||
 950         $count < 1 || (defined($offset) && $offset < 0)) {
 951         print "invalid arguments; type \"help read\" for a synopsis\n";
 952         return;
 953     }
 954
 955     if (!defined($offset)) {
 956         $offset = 0;
 957     }
 958
 959     print("Reading $count bytes starting at byte $offset from object " .
 960           "$inode...\n");
 961
 962     # "allocate" a large enough buffer
 963     my $buf = sprintf("%${count}s", " ");
 964     die "suck" if (length($buf) != $count);
 965
 966     # the perl we're using doesn't support pack type Q, and offset is 64 bits
 967     my $packed = pack("ILpLLL", $::client_id, $inode, $buf, $count, $offset, 0);
 968
 969     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ2, $packed);
 970
 971     $retval = unpack("l", $packed);
 972
 973     if (!defined $rc) {
 974         print STDERR "ioctl failed: $!\n";
 975     } elsif ($rc eq "0 but true") {
 976         if ($retval >= 0) {
 977                 print substr($buf, 0, $retval);
 978                 print "\nRead $retval of an attempted $count bytes.\n";
 979                 print "Finished (success)\n";
 980         } else {
 981                 print "Finished (error $retval)\n";
 982         }
 983     } else {
 984         print "ioctl returned error code $rc.\n";
 985     }
 986 }
 987
 988 sub Write {
 989     if (!defined($::client_id)) {
 990         print "You must first ``connect''.\n";
 991         return;
 992     }
 993
 994     my $inode = shift;
 995     my $offset = shift;
 996     my $text = join(' ', @_);
 997     my $count = length($text);
 998
 999     if (!defined($inode) || scalar($inode) < 1 || !defined($offset) ||
1000         scalar($offset) < 0) {
1001         print "invalid arguments; type \"help write\" for a synopsis\n";
1002         return;
1003     }
1004
1005     if (!defined($text)) {
1006         $text = "";
1007         $count = 0;
1008     }
1009
1010     print("Writing $count bytes starting at byte $offset to object " .
1011           "$inode...\n");
1012
1013     # the perl we're using doesn't support pack type Q
1014     my $packed = pack("ILpLLL", $::client_id, $inode, $text, $count, $offset, 0);
1015     my $rc = ioctl(DEV_OBD, &OBD_IOC_WRITE, $packed);
1016
1017     $retval = unpack("l", $packed);
1018
1019     if (!defined $rc) {
1020         print STDERR "ioctl failed: $!\n";
1021     } elsif ($rc eq "0 but true") {
1022         if ($retval >= 0) {
1023                 print "\nWrote $retval of an attempted $count bytes.\n";
1024                 print "Finished (success)\n";
1025         } else {
1026                 print "Finished (error $retval)\n";
1027         }
1028     } else {
1029         print "ioctl returned error code $rc.\n";
1030     }
1031 }
1032
1033 sub Preallocate {
1034     my $arg = shift;
1035
1036     if (!defined($::client_id)) {
1037         print "You must first ``connect''.\n";
1038         return;
1039     }
1040
1041     if (!defined($arg) || scalar($arg) < 1 || scalar($arg) > 32) {
1042         $arg = 32;
1043     }
1044
1045     print "Preallocating $arg inodes...\n";
1046     my $packed = pack("LLx128", $::client_id, $arg);
1047     # client id, alloc, inodes[32]
1048
1049     my $rc = ioctl(DEV_OBD, &OBD_IOC_PREALLOCATE, $packed);
1050
1051     if (!defined $rc) {
1052         print STDERR "ioctl failed: $!\n";
1053     } elsif ($rc eq "0 but true") {
1054         my $alloc = unpack("x4L", $packed);
1055         my @inodes = unpack("x8L32", $packed);
1056         my $i;
1057
1058         print "Got $alloc inodes: ";
1059         foreach $i (@inodes) {
1060             print $i . " ";
1061         }
1062         print "\nFinished (success)\n";
1063     } else {
1064         print "ioctl returned error code $rc.\n";
1065     }
1066 }
1067
1068 sub Decusecount {
1069     my $rc = ioctl(DEV_OBD, &OBD_IOC_DEC_USE_COUNT, 0);
1070
1071     if (!defined $rc) {
1072         print STDERR "ioctl failed: $!\n";
1073     } elsif ($rc eq "0 but true") {
1074         print "Finished (success)\n";
1075     } else {
1076         print "ioctl returned error code $rc.\n";
1077     }
1078 }
1079
1080 sub Statfs {
1081     if (!defined($::client_id)) {
1082         print "You must first ``connect''.\n";
1083         return;
1084     }
1085
1086     # struct statfs {
1087     #         long f_type;
1088     #         long f_bsize;
1089     #         long f_blocks;
1090     #         long f_bfree;
1091     #         long f_bavail;
1092     #         long f_files;
1093     #         long f_ffree;
1094     #         __kernel_fsid_t f_fsid; (64 bits)
1095     #         long f_namelen;
1096     #         long f_spare[6];
1097     # };
1098
1099     my $packed = pack("LLLLLLLIILL6", $::client_id, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1100                       0, 0, 0, 0, 0, 0);
1101
1102     my $rc = ioctl(DEV_OBD, &OBD_IOC_STATFS, $packed);
1103
1104     if (!defined $rc) {
1105         print STDERR "ioctl failed: $!\n";
1106     } elsif ($rc eq "0 but true") {
1107         # skip both the conn_id and the fs_type in the buffer
1108         my ($bsize, $blocks, $bfree, $bavail, $files, $ffree) =
1109             unpack("x4x4LLLLLL", $packed);
1110         print("$bsize byte blocks: $blocks, " . ($blocks - $bfree) . " used, " .
1111               "$bfree free ($bavail available).\n");
1112         print "$files files, " . ($files - $ffree) . " used, $ffree free.\n";
1113         print "Finished (success)\n";
1114     } else {
1115         print "ioctl returned error code $rc.\n";
1116     }
1117 }
1118
1119 sub Help {
1120     my $arg = shift;
1121
1122     if ( !$arg || !$commands{$arg} ) {
1123         print "Comands: ", join( ' ', @jcm_cmd_list), "\n";
1124     } else {
1125         print "Usage: " .  $commands{$arg}->{doc} . "\n";
1126     }
1127 }
1128
1129 sub Quit {
1130     if ($::client_id) {
1131         print "Disconnecting active session ($::client_id)...";
1132         Disconnect($::client_id);
1133     }
1134     exit;
1135 }