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