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