lustre/obdclass/obdcontrol

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