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