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