lustre/obdclass/obdcontrol

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