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