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_IOC_PUNCH () { &_IOC(3, ord(\'f\'), 24, 4);}' unless
  65   defined(&OBD_IOC_PUNCH);
  66 eval 'sub OBD_SNAP_SETTABLE () { &_IOC(3, ord(\'f\'), 40, 4);}' unless
  67   defined(&OBD_SNAP_SETTABLE);
  68 eval 'sub OBD_SNAP_PRINTTABLE () { &_IOC(3, ord(\'f\'), 41, 4);}' unless
  69   defined(&OBD_SNAP_PRINTTABLE);
  70 eval 'sub OBD_SNAP_DELETE() { &_IOC(3, ord(\'f\'), 42, 4);}' unless
  71   defined(&OBD_SNAP_DELETE);
  72 eval 'sub OBD_SNAP_RESTORE() { &_IOC(3, ord(\'f\'), 43, 4);}' unless
  73   defined(&OBD_SNAP_RESTORE);
  74
  75 eval 'sub OBD_EXT2_RUNIT () { &_IOC(3, ord(\'f\'), 61, 4);}' unless
  76   defined(&OBD_EXT2_RUNIT);
  77
  78 eval 'sub OBD_MD_FLALL   () {~0;}'   unless defined(&OBD_MD_FLALL);
  79 eval 'sub OBD_MD_FLATIME () {1<<1;}' unless defined(&OBD_MD_FLATIME);
  80 eval 'sub OBD_MD_FLMTIME () {1<<2;}' unless defined(&OBD_MD_FLMTIME);
  81 eval 'sub OBD_MD_FLCTIME () {1<<3;}' unless defined(&OBD_MD_FLCTIME);
  82 eval 'sub OBD_MD_FLSIZE  () {1<<4;}' unless defined(&OBD_MD_FLSIZE);
  83 eval 'sub OBD_MD_FLMODE  () {1<<7;}' unless defined(&OBD_MD_FLMODE);
  84 eval 'sub OBD_MD_FLUID   () {1<<8;}' unless defined(&OBD_MD_FLUID);
  85 eval 'sub OBD_MD_FLGID   () {1<<9;}' unless defined(&OBD_MD_FLGID);
  86
  87 use Getopt::Long;
  88 use File::stat;
  89 use Storable;
  90 use Carp;
  91 use Term::ReadLine;
  92 use IO::Handle;
  93
  94
  95 # NOTE long long are layed out in ia32 memory as follows:
  96 # u = 0xaaaabbbbccccdddd has ccccdddd at &u and aaaabbbb 4 bytes on
  97 # this may be different on other architectures
  98
  99 # we use 32-bit integers for all 64-bit quantities in this program
 100 # #define OBD_INLINESZ  60
 101 # #define OBD_OBDMDSZ   60
 102 # /* Note: 64-bit types are 64-bit aligned in structure */
 103 # struct obdo {
 104 #       obd_id                  o_id;
 105 #       obd_gr                  o_gr;
 106 #       obd_time                o_atime;
 107 #       obd_time                o_mtime;
 108 #       obd_time                o_ctime;
 109 #       obd_size                o_size;
 110 #       obd_blocks              o_blocks;
 111 #       obd_blksize             o_blksize;
 112 #       obd_mode                o_mode;
 113 #       obd_uid                 o_uid;
 114 #       obd_gid                 o_gid;
 115 #       obd_flag                o_flags;
 116 #       obd_flag                o_obdflags;
 117 #       obd_count               o_nlink;
 118 #       obd_count               o_generation;
 119 #       obd_flag                o_valid;        /* hot fields in this obdo */
 120 #       char                    o_inline[60];
 121 #       char                    o_obdmd[60];
 122 #       struct list_head        o_list;
 123 #       struct obd_ops          *o_op;
 124 # };
 125
 126 sub obdo_pack {
 127     my $obdo = shift;
 128     pack "LL LL LL LL LL LL LL L L L L L L L L L a60 a60 L L L",
 129     $obdo->{id}, 0,
 130     $obdo->{gr}, 0,
 131     $obdo->{atime}, 0,
 132     $obdo->{mtime}, 0 ,
 133     $obdo->{ctime}, 0,
 134     $obdo->{size}, 0,
 135     $obdo->{blocks}, 0,
 136     $obdo->{blksize},
 137     $obdo->{mode},
 138     $obdo->{uid},
 139     $obdo->{gid},
 140     $obdo->{flags},
 141     $obdo->{obdflags},
 142     $obdo->{nlink},
 143     $obdo->{generation},
 144     $obdo->{valid},
 145     $obdo->{inline},
 146     $obdo->{obdmd},
 147     0, 0, # struct list_head
 148     0;  #  struct obd_ops
 149 }
 150
 151 sub obdo_unpack {
 152     my $buf = shift;
 153     my $offset = shift;
 154     my $obdo;
 155     ($obdo->{id},
 156     $obdo->{gr},
 157     $obdo->{atime},
 158     $obdo->{mtime},
 159     $obdo->{ctime},
 160     $obdo->{size},
 161     $obdo->{blocks},
 162     $obdo->{blksize},
 163     $obdo->{mode},
 164     $obdo->{uid},
 165     $obdo->{gid},
 166     $obdo->{flags},
 167     $obdo->{obdflags},
 168     $obdo->{nlink},
 169     $obdo->{generation},
 170     $obdo->{valid},
 171     $obdo->{inline},
 172     $obdo->{obdmd}) = unpack "x${offset}Lx4 Lx4 Lx4 Lx4 Lx4 Lx4 Lx4 L L L L L L L L L a60 a60", $buf;
 173     $obdo;
 174 }
 175
 176 sub obdo_print {
 177
 178     my $obdo = shift;
 179
 180     printf "id: %d\ngrp: %d\natime: %s\nmtime: %s\nctime: %s\nsize: %d\nblocks: %d\nblksize: %d\nmode: %o\nuid: %d\ngid: %d\nflags: %x\nobdflags: %x\nnlink: %d\nvalid: %x\ninline: %s\nobdmd: %s\n",
 181     $obdo->{id},
 182     $obdo->{gr},
 183     $obdo->{atime},
 184     $obdo->{mtime},
 185     $obdo->{ctime},
 186     $obdo->{size},
 187     $obdo->{blocks},
 188     $obdo->{blksize},
 189     $obdo->{mode},
 190     $obdo->{uid},
 191     $obdo->{gid},
 192     $obdo->{flags},
 193     $obdo->{obdflags},
 194     $obdo->{nlink},
 195     $obdo->{valid},
 196     $obdo->{inline},
 197     $obdo->{obdmd};
 198 }
 199
 200
 201 my ($file);
 202
 203 GetOptions("f!" => \$file, "device=s" => \$::device, ) || die "Getoptions";
 204
 205
 206 # get a console for the app
 207
 208 my $line;
 209 my $command;
 210 my $arg;
 211
 212 my %commands =
 213     ('device' => {func => "Device", doc => "device <dev>: open another OBD device"},
 214      'create' => {func => "Create", doc => "create [<num> [<mode> [quiet]]]: create new object(s) (files, unless mode is given)"},
 215      'attach' => {func => "Attach", doc => "attach { obdext2 | obdsnap snapdev snapidx tableno | obdscsi adapter bus tid lun }: attach this minor device to the specified driver" },
 216      'detach' => {func => "Detach", doc => "detach this minor device"},
 217      'testext2iterator' => {func => "TestExt2Iterator", doc => "test ext2 iterator function"},
 218      'snapset' => {func => "SnapSetTable", doc => "snapset <tableno> <file>: set the table (created with snaptable) as table #tableno" },
 219      'snapprint' => {func => "SnapPrint", doc => "snapprint <tableno>: output the contents of table #tableno to the syslog"},
 220      'snapdelete' => {func => "SnapDelete", doc => "snapdelete: delete connected snap obd objects from disk"},
 221      'snaprestore' => {func => "SnapRestore", doc => "snaprestore : restore connected old snap objects to be current"},
 222      'snaptable' => {func => "SnapShotTable", doc => "snaptable: build a snapshot table (interactive)"},
 223      'copy' => {func => "Copy", doc => "copy <srcid> <tgtid>: copy objects"},
 224      'migrate' => {func => "Migrate", doc => "migrate <srcid> <tgtid>: migrate data from one object to another"},
 225      'partition' => {func => "Partition", doc => "partition <type> <adapter> <bus> <tid> <lun> <partition> <size>: create a partition"},
 226      'format' => {func => "Format", doc => "format <type> <adapter> <bus> <tid> <lun> <size>: format a partition"},
 227      'setup' => {func => "Setup", doc => "setup [type]: link this OBD device to the underlying device (default type obdext2)"},
 228      'connect' => {func => "Connect", doc => "connect: allocates client ID for this session"},
 229      'disconnect' => {func => "Disconnect", doc => "disconnect [id]: frees client resources"},
 230      'sync' => {func => "Sync", doc => "sync: flushes buffers to disk"},
 231      'destroy' => {func => "Destroy", doc => "destroy <id>: destroys an object"},
 232      'cleanup' => {func => "Cleanup", doc => "cleanup the minor obd device"},
 233      'dec_use_count' => {func => "Decusecount", doc => "decreases the module use count so that the module can be removed following an oops"},
 234      'read' => {func => "Read", doc => "read <id> <count> [offset]: read data from object"},
 235      'fsread' => {func => "Read2", doc => "read <id> <count> [offset]: read data from object"},
 236      'write' => {func => "Write", doc => "write <id> <offset> <text>: write data to object"},
 237      'punch' => {func => "Punch", doc => "punch <id> <start> <count>: punch a hole in object"},
 238      'setattr' => {func => "Setattr", doc => "setattr <id> [mode [uid [gid [size [atime [mtime [ctime]]]]]]]: sets object attributes"},
 239      'getattr' => {func => "Getattr", doc => "getattr <id>: displays object attributes"},
 240      'preallocate' => {func => "Preallocate", doc => "preallocate [num]: requests preallocation of num objects."},
 241      'statfs' => {func => "Statfs", doc => "statfs: filesystem status information"},
 242      'help' => {func => \&Help,  doc => "help: this message"},
 243      'quit' => {func => \&Quit,  doc => "see \"exit\""},
 244      'exit' => {func => \&Quit,  doc => "see \"quit\""}
 245     );
 246
 247 #
 248 #       setup completion function
 249 #
 250 my @jcm_cmd_list = keys %commands;
 251
 252 my $term, $attribs;
 253
 254
 255 # Get going....
 256
 257 Device($::device);
 258
 259 sub readl {
 260     if ( $file ) {
 261         my $str = <STDIN>;
 262         chop($str);
 263         return $str;
 264     } else {
 265         return $term->readline(@_);
 266     }
 267 }
 268
 269
 270
 271 if ( $file ) {
 272     while ( <STDIN> ) {
 273         print $_;
 274         execute_line($_);
 275     }
 276     exit 0;
 277 } else {
 278     $term = new Term::ReadLine 'obdcontrol ';
 279     $attribs = $term->Attribs;
 280     $attribs->{attempted_completion_function} = \&completeme;
 281     $term->ornaments('md,me,,');        # bold face prompt
 282
 283     # make sure stdout is not buffered
 284     STDOUT->autoflush(1);
 285
 286
 287     # Get on with the show
 288     process_line();
 289 }
 290
 291 #------------------------------------------------------------------------------
 292 sub completeme {
 293     my ($text, $line, $start, $end) = @_;
 294     if (substr($line, 0, $start) =~ /^\s*$/) {
 295         $attribs->{completion_word} = \@jcm_cmd_list;
 296         return $term->completion_matches($text,
 297                                          $attribs->{'list_completion_function'});
 298     }
 299 }
 300
 301 sub find_command {
 302     my $given = shift;
 303     my $name;
 304     my @completions = completeme($given, $given, 0, length($given));
 305     if ($#completions == 0) {
 306         $name = shift @completions;
 307     }
 308
 309     return $name;
 310 }
 311
 312 # start making requests
 313 sub process_line {
 314   foo:
 315     $line = $term->readline("obdcontrol > ");
 316     execute_line($line);
 317     goto foo;
 318 }
 319
 320 sub execute_line {
 321     my $line = shift;
 322
 323     my @cmdline = split(' ', $line);
 324     my $word = shift @cmdline;
 325
 326     my $cmd;
 327     if ( $file ) {
 328         $cmd = $word;
 329     } else {
 330         $cmd = find_command($word);
 331     }
 332     unless ($cmd) {
 333         printf STDERR "$word: No such command, or not unique.\n";
 334         return (-1);
 335     }
 336
 337     if ($cmd eq "help" || $cmd eq "exit" || $cmd eq "quit") {
 338         return (&{$commands{$cmd}->{func}}(@cmdline));
 339     }
 340
 341     # Call the function.
 342     return (&{$commands{$cmd}->{func}}(@cmdline));
 343 }
 344
 345
 346 # select the OBD device we talk to
 347 sub Device {
 348     my $device = shift;
 349
 350     if ($::client_id) {
 351         print "Disconnecting active session ($::client_id)...";
 352         Disconnect($::client_id);
 353     }
 354     if (! $device ) {
 355         $device = "/dev/obd0";
 356     }
 357     $::device = $device;
 358     # Open the device, as we need an FD for the ioctl
 359     sysopen(DEV_OBD, $device, 0) || die "Cannot open $device";
 360     print "Device now $device\n";
 361 }
 362
 363
 364 sub Attach {
 365     my $err = 0;
 366     my $type = shift;
 367     my $data;
 368     my $datalen = 0;
 369
 370     if ( ! $type ) {
 371         print "error: missing type\n";
 372 usage:
 373         print "usage: attach {obdext2 | obdsnap | obdscsi}\n";
 374         return;
 375     }
 376
 377     if ($type eq "obdscsi" ) {
 378         my $adapter = shift;
 379         my $bus = shift;
 380         my $tid = shift;
 381         my $lun = shift;
 382
 383         $data = pack("iiii", $adapter, $bus, $tid, $lun);
 384         $datalen = 4 * 4;
 385     } elsif ($type eq "obdsnap" ) {
 386         my $snapdev = shift;
 387         my $snapidx = shift;
 388         my $tableno = shift;
 389
 390         $data = pack("iii", $snapdev, $snapidx, $tableno);
 391         $datalen = 3 * 4;
 392     } elsif ($type eq "obdext2") {
 393         $data = pack("i", 4711);   # bogus data
 394         $datalen = 0;
 395     } else {
 396         print "error: unknown attach type $type\n";
 397         goto usage;
 398     }
 399
 400     my $len = length($type);
 401     my $cl = length($data);
 402
 403     print "type $type (len $len), datalen $datalen ($cl)\n";
 404     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 405
 406     my $rc = ioctl(DEV_OBD, &OBD_IOC_ATTACH, $packed);
 407
 408     if (!defined $rc) {
 409         print STDERR "ioctl failed: $!\n";
 410     } elsif ($rc eq "0 but true") {
 411         print "Finished (success)\n";
 412     } else {
 413         print "ioctl returned error code $rc.\n";
 414     }
 415 }
 416
 417
 418 sub Detach {
 419     my $err = 0;
 420     my $data = "";
 421     my $rc = ioctl(DEV_OBD, &OBD_IOC_DETACH, $data);
 422
 423     if (!defined $rc) {
 424         print STDERR "ioctl failed: $!\n";
 425     } elsif ($rc eq "0 but true") {
 426         print "Finished (success)\n";
 427     } else {
 428         print "ioctl returned error code $rc.\n";
 429     }
 430 }
 431
 432
 433 sub TestExt2Iterator {
 434     if (!defined($::client_id)) {
 435         print "You must first ``connect''.\n";
 436         return;
 437     }
 438
 439     my $err = 0;
 440     my $type = "obdext2";
 441
 442     $data = pack("i", 4711); # bogus data
 443     $datalen = 4;
 444
 445     my $len = length($type);
 446     my $cl = length($data);
 447     print "type $type (len $len), datalen $datalen ($cl)\n";
 448     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 449
 450     my $rc = ioctl(DEV_OBD, &OBD_EXT2_RUNIT, $packed);
 451
 452     if (!defined $rc) {
 453         print STDERR "ioctl failed: $!\n";
 454     } elsif ($rc eq "0 but true") {
 455         print "Finished (success)\n";
 456     } else {
 457         print "ioctl returned error code $rc.\n";
 458     }
 459 }
 460
 461
 462 sub SnapDelete {
 463     if (!defined($::client_id)) {
 464         print "You must first ``connect''.\n";
 465         return;
 466     }
 467
 468     my $err = 0;
 469     my $type = "obdsnap";
 470
 471     $data = pack("i", 4711); # bogus data
 472     $datalen = 4;
 473
 474     my $len = length($type);
 475     my $cl = length($data);
 476     print "type $type (len $len), datalen $datalen ($cl)\n";
 477     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 478
 479     # XXX We need to fix this up so that after the objects in this snapshot
 480     #     are deleted, the snapshot itself is also removed from the table.
 481     my $rc = ioctl(DEV_OBD, &OBD_SNAP_DELETE, $packed);
 482
 483     if (!defined $rc) {
 484         print STDERR "ioctl failed: $!\n";
 485     } elsif ($rc eq "0 but true") {
 486         print "Finished (success)\n";
 487     } else {
 488         print "ioctl returned error code $rc.\n";
 489     }
 490 }
 491
 492
 493 #      this routine does the whole job
 494 sub SnapRestore {
 495     my $restoreto = shift;
 496     my $snaptable = shift;
 497     my $tableno = shift;
 498     my $restoretime;
 499
 500     # don't do anything until connected
 501     if (!defined($::client_id)) {
 502         print "You must first ``connect''.\n";
 503         return;
 504     }
 505
 506     if ( ! $snaptable || ! defined $restoreto ) {
 507         print "Usage: snaprestore \"restore to slot\" \"snaptable\" \"tableno\"\n";
 508         return;
 509     }
 510
 511     if ( ! -f $snaptable ) {
 512         print "Table $snaptable doesn't exist\n";
 513         return;
 514     }
 515
 516     my $table = ReadSnapShotTable($snaptable);
 517     $restoretime = FindSnapInTable($table, $restoreto);
 518     if ( ! defined $table->{0} || ! defined $restoretime ) {
 519         PrintSnapShotTable($table);
 520         print "No current or $restoreto slot in this table\n";
 521         return;
 522     }
 523
 524     my $currentindex = $table->{0};
 525     if (  $table->{$restoretime} == $currentindex ) {
 526         print "You should not restore to the current snapshot\n";
 527         return;
 528     }
 529
 530     # swap the entries for 0 and $restoreto
 531     my $tmp = $table->{$restoretime};
 532     $table->{$restoretime} = $table->{0};
 533     $table->{0} = $tmp;
 534     # PrintSnapShotTable($table);
 535
 536     # write it back
 537     WriteSnapShotTable($snaptable, $table);
 538
 539     # set it in the kernel
 540     SnapSetTable($tableno, $snaptable);
 541
 542     # ready for the ioctl
 543     my $err = 0;
 544     my $type = "obdsnap";
 545     $data = pack("i", $currentindex); # slot of previous current snapshot
 546     $datalen = 4;
 547
 548     my $len = length($type);
 549     my $cl = length($data);
 550     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 551
 552     my $rc = ioctl(DEV_OBD, &OBD_SNAP_RESTORE, $packed);
 553
 554     if (!defined $rc) {
 555         print STDERR "ioctl failed: $!\n";
 556     } elsif ($rc eq "0 but true") {
 557         print "Snaprestore finished (success)\n";
 558         delete $table->{$restoretime} if defined $restoretime;
 559         # write it back
 560         WriteSnapShotTable($snaptable, $table);
 561
 562         # set it in the kernel
 563         SnapSetTable($tableno, $snaptable);
 564         # PrintSnapShotTable($table);
 565
 566     } else {
 567         print "ioctl returned error code $rc.\n";
 568     }
 569 }
 570
 571 sub FindSnapInTable {
 572     my $table = shift;
 573     my $snapno =shift;
 574
 575     foreach my $restoretime ( keys %{$table} ) {
 576         if ( $table->{$restoretime} == $snapno) {
 577             print "Found key $restoretime for snapno $snapno\n";
 578             return $restoretime;
 579         }
 580     }
 581     undef;
 582 }
 583
 584
 585 sub SnapPrint {
 586     my $err = 0;
 587     my $type = "obdsnap";
 588     my $snaptableno = shift;
 589
 590     $data = pack("i", $snaptableno);
 591     $datalen = 4;
 592
 593     my $len = length($type);
 594     my $cl = length($data);
 595     print "type $type (len $len), datalen $datalen ($cl)\n";
 596     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 597
 598     my $rc = ioctl(DEV_OBD, &OBD_SNAP_PRINTTABLE, $packed);
 599
 600     if (!defined $rc) {
 601         print STDERR "ioctl failed: $!\n";
 602     } elsif ($rc eq "0 but true") {
 603         print "Finished (success)\n";
 604     } else {
 605         print "ioctl returned error code $rc.\n";
 606     }
 607 }
 608
 609 sub SnapSetTable {
 610     my $err = 0;
 611     my $type = "obdsnap";
 612     my $snaptableno = shift;
 613     my $file = shift;
 614     my $snapcount;
 615     my $table = {};
 616     my $data;
 617     my $datalen = 0;
 618
 619     if ( ! -f $file ) {
 620         print "No such file $file\n";
 621     }
 622
 623     $table = ReadSnapShotTable($file);
 624
 625     $snapcount = keys %{$table};
 626     print "Snapcount $snapcount\n";
 627
 628     if ( ! defined $table->{0} ) {
 629         print "No current snapshot in table! First make one\n";
 630         return ;
 631     }
 632     $data = pack("ii", $snaptableno, $snapcount);
 633     $datalen = 2 * 4;
 634     foreach my $time (sort keys %{$table}) {
 635         # XXX we should change to pack LL instead of I for times
 636         $data .= pack("Ii", $time, $table->{$time});
 637         $datalen += 8;
 638     }
 639
 640     my $len = length($type);
 641     my $cl = length($data);
 642     print "type $type (len $len), datalen $datalen ($cl)\n";
 643     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 644
 645     my $rc = ioctl(DEV_OBD, &OBD_SNAP_SETTABLE, $packed);
 646
 647     if (!defined $rc) {
 648         print STDERR "ioctl failed: $!\n";
 649     } elsif ($rc eq "0 but true") {
 650         print "Finished (success)\n";
 651     } else {
 652         print "ioctl returned error code $rc.\n";
 653     }
 654 }
 655
 656
 657 sub SnapShotTable  {
 658
 659     my $file = &readl("enter file name: ");
 660     if ( ! -f $file ) {
 661         `touch $file`;
 662     }
 663     my $table = ReadSnapShotTable($file);
 664
 665   again:
 666     PrintSnapShotTable($table);
 667     my $action = &readl("Add, Delete or Quit [adq]: ");
 668     goto done if ($action  =~ "^q.*" );
 669     goto add if ($action =~ "^a.*");
 670     goto del  if ($action =~ "^d.*");
 671     goto again;
 672
 673   add:
 674     my $idx = &readl("enter index where you want this snapshot: ");
 675     my $time = &readl("enter time or 'now' or 'current': ");
 676     my $oldtime = SnapFindTimeFromIdx($idx, $table);
 677     if (defined $oldtime) {
 678         print "This already exists, first clean up\n";
 679         goto again;
 680     }
 681
 682     if ( $time  eq 'now' ) {
 683         $time = time;
 684     } elsif ( $time eq 'current' ) {
 685         $time = 0;
 686     }
 687     $table->{$time} = $idx;
 688     goto again;
 689
 690   del:
 691     $didx = &readl("Enter index to delete: ");
 692     my $deltime = SnapFindTimeFromIdx($didx, $table);
 693     delete $table->{$deltime} if defined $deltime;
 694     goto again;
 695
 696   done:
 697     my $ok = &readl("OK with new table? [Yn]: ");
 698     unless ( $ok eq "n" )  {
 699         WriteSnapShotTable($file, $table);
 700     }
 701 }
 702
 703 sub SnapFindTimeFromIdx {
 704     my $idx = shift;
 705     my $table = shift;
 706
 707     foreach my $time ( keys %{$table} ) {
 708         if ( $table->{$time} == $idx ) {
 709             return $time;
 710         }
 711     }
 712     undef;
 713 }
 714
 715 sub PrintSnapShotTable {
 716     my $table = shift;
 717     my $time;
 718
 719     foreach  $time ( sort keys %{$table} ) {
 720         my $stime = localtime($time);
 721         if ( ! $time ) {
 722             $stime = "current";
 723         }
 724         printf "Time: %s -- Index %d\n", $stime, $table->{$time};
 725     }
 726 }
 727
 728 sub ReadSnapShotTable {
 729
 730     my $file = shift;
 731     my $table = {};
 732
 733     open FH, "<$file";
 734     while ( <FH> ) {
 735         my ($time, $index) = split ;
 736         $table->{$time} = $index;
 737     }
 738     close FH;
 739
 740     PrintSnapShotTable($table);
 741
 742     return $table;
 743 }
 744
 745 sub WriteSnapShotTable {
 746     my $file = shift;
 747     my $table = shift;
 748
 749     open FH, ">$file";
 750     foreach my $time ( sort keys %{$table}  ) {
 751         print FH "$time $table->{$time}\n";
 752     }
 753     close FH;
 754 }
 755
 756 sub Copy {
 757     my $err = 0;
 758     my $src_obdo;
 759     my $dst_obdo;
 760
 761     # Note: _copy IOCTL takes parameters as dst, src.
 762     #       Copy function takes parameters as src, dst.
 763     $src_obdo->{id} = shift;
 764     $dst_obdo->{id} = shift;
 765     $src_obdo->{valid} = &OBD_MD_FLALL;
 766
 767     # XXX need to fix copy so we can have 2 client IDs here
 768     my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
 769
 770     my $rc = ioctl(DEV_OBD, &OBD_IOC_COPY, $packed);
 771
 772     if (!defined $rc) {
 773         print STDERR "ioctl failed: $!\n";
 774     } elsif ($rc eq "0 but true") {
 775         print "Finished (success)\n";
 776     } else {
 777         print "ioctl returned error code $rc.\n";
 778     }
 779 }
 780
 781 sub Migrate {
 782     my $err = 0;
 783
 784     # Note: _migr IOCTL takes parameters as dst, src.
 785     #       Migrate function takes parameters as src, dst.
 786     $src_obdo->{id} = shift;
 787     $dst_obdo->{id} = shift;
 788     $src_obdo->{valid} = &OBD_MD_FLALL;
 789
 790     # We pack a dummy connection ID here
 791     my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
 792
 793     my $rc = ioctl(DEV_OBD, &OBD_IOC_MIGR, $packed);
 794
 795     if (!defined $rc) {
 796         print STDERR "ioctl failed: $!\n";
 797     } elsif ($rc eq "0 but true") {
 798         print "Finished (success)\n";
 799     } else {
 800         print "ioctl returned error code $rc.\n";
 801     }
 802 }
 803
 804
 805 sub Format {
 806     my $err = 0;
 807     my $size = shift;
 808     my $data = pack("i", $size);
 809     my $datalen = 4;
 810
 811     my $packed = pack("ip", $datalen, $data);
 812     my $rc = ioctl(DEV_OBD, &OBD_IOC_FORMATOBD, $packed);
 813
 814     if (!defined $rc) {
 815         print STDERR "ioctl failed: $!\n";
 816     } elsif ($rc eq "0 but true") {
 817         print "Finished (success)\n";
 818     } else {
 819         print "ioctl returned error code $rc.\n";
 820     }
 821 }
 822
 823 sub Partition {
 824     my $err = 0;
 825     my $partno = shift;
 826     my $size = shift;
 827     my $data = pack("ii", $partno, $size);
 828     my $datalen = 2 * 4;
 829
 830     my $packed = pack("ip", $datalen, $data);
 831     my $rc = ioctl(DEV_OBD, &OBD_IOC_PARTITION, $packed);
 832
 833     if (!defined $rc) {
 834         print STDERR "ioctl failed: $!\n";
 835     } elsif ($rc eq "0 but true") {
 836         print "Finished (success)\n";
 837     } else {
 838         print "ioctl returned error code $rc.\n";
 839     }
 840 }
 841
 842 sub Setup {
 843     my $err = 0;
 844     my $arg = shift;
 845     my $data;
 846     my $datalen = 0;
 847
 848     # XXX we need a getinfo ioctl to validate parameters
 849     # by type here
 850
 851     if ($arg && !defined($::st = stat($arg))) {
 852             print "$dev is not a valid device\n";
 853             return;
 854     }
 855
 856     if ( $arg ) {
 857         $dev = $::st->rdev() unless $dev;
 858         $data = pack("i", $dev);
 859         $datalen = 4;
 860     }
 861
 862     my $packed = pack("ip", $datalen, $data);
 863     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETUP, $packed);
 864
 865     if (!defined $rc) {
 866         print STDERR "ioctl failed: $!\n";
 867     } elsif ($rc eq "0 but true") {
 868         print "Finished (success)\n";
 869     } else {
 870         print "ioctl returned error code $rc.\n";
 871     }
 872 }
 873
 874 sub Cleanup {
 875     my $err = "0";
 876     my $rc = ioctl(DEV_OBD, &OBD_IOC_CLEANUP, $err);
 877
 878     if (!defined $rc) {
 879         print STDERR "ioctl failed: $!\n";
 880     } elsif ($rc eq "0 but true") {
 881         print "Finished (success)\n";
 882         $::client_id = 0;
 883     } else {
 884         print "ioctl returned error code $rc.\n";
 885     }
 886 }
 887
 888
 889 sub Connect {
 890     my $rc;
 891
 892     my $packed = "";
 893     $rc = ioctl(DEV_OBD, &OBD_IOC_CONNECT, $packed);
 894     $id = unpack("I", $packed);
 895
 896     if (!defined $rc) {
 897         print STDERR "ioctl failed: $!\n";
 898     } elsif ($rc eq "0 but true") {
 899         $::client_id = $id;
 900         print "Client ID     : $id\n";
 901         print "Finished (success)\n";
 902     } else {
 903         print "ioctl returned error code $rc.\n";
 904     }
 905 }
 906
 907 sub Disconnect {
 908     my $id = shift;
 909
 910     if (!defined($id)) {
 911         $id = $::client_id;
 912     }
 913
 914     if (!defined($id)) {
 915         print "syntax: disconnect [client ID]\n";
 916         print "When client ID is not given, the last valid client ID to be returned by a\n";
 917         print "connect command this session is used; there is no such ID.\n";
 918         return;
 919     }
 920
 921     my $packed = pack("L", $id);
 922     my $rc = ioctl(DEV_OBD, &OBD_IOC_DISCONNECT, $packed);
 923
 924     if (!defined $rc) {
 925         print STDERR "ioctl failed: $!\n";
 926     } elsif ($rc eq "0 but true") {
 927         $::client_id = undef;
 928         print "Finished (success)\n";
 929     } else {
 930         print "ioctl returned error code $rc.\n";
 931     }
 932 }
 933
 934 sub Create {
 935     if (!defined($::client_id)) {
 936         print "You must first ``connect''.\n";
 937         return;
 938     }
 939
 940     my $num = shift;
 941     my $mode = shift;
 942     my $quiet = shift;
 943     my $rc;
 944     my $prealloc = 0;
 945
 946     if (!defined($num)) {
 947         $num = 1;
 948     }
 949
 950     if (!defined($mode)) {
 951         $mode = 0100644;         # create a file (rw-r--r--) if not specified
 952     }
 953
 954     if (scalar($num) < 1 || defined($quiet) && $quiet ne "quiet") {
 955         print "usage: create [<number of objects> [<mode> [quiet]]]\n";
 956         return;
 957     }
 958
 959     my $i;
 960     my $id = 0;                 # can't currently request IDs
 961
 962     print "Creating " . scalar($num) . " object";
 963     if (scalar($num) > 1) {
 964         print "s";
 965     }
 966     print "\n";
 967
 968     for ($i = 0; $i < scalar($num); $i++) {
 969         my $obdo;
 970         $obdo->{id} = $id;
 971         $obdo->{mode} = scalar($mode);
 972         $obdo->{valid} = &OBD_MD_FLMODE;
 973
 974         my $packed = pack("I", $::client_id) . obdo_pack($obdo);
 975         $rc = ioctl(DEV_OBD, &OBD_IOC_CREATE, $packed);
 976         if ($rc ne "0 but true") {
 977             last;
 978         } elsif (!defined($quiet)) {
 979             $obdo = obdo_unpack($packed, 4);
 980             print "Created object #$obdo->{id}.\n";
 981         }
 982     }
 983
 984     if (!defined $rc) {
 985         print STDERR "ioctl failed: $!\n";
 986     } elsif ($rc eq "0 but true") {
 987         print "Finished (success)\n";
 988     } else {
 989         print "ioctl returned error code $rc.\n";
 990     }
 991 }
 992
 993 sub Sync {
 994     my $err = "0";
 995     my $rc = ioctl(DEV_OBD, &OBD_IOC_SYNC, $err);
 996
 997     if (!defined $rc) {
 998         print STDERR "ioctl failed: $!\n";
 999     } elsif ($rc eq "0 but true") {
1000         print "Finished (success)\n";
1001     } else {
1002         print "ioctl returned error code $rc.\n";
1003     }
1004 }
1005
1006 sub Destroy {
1007     if (!defined($::client_id)) {
1008         print "You must first ``connect''.\n";
1009         return;
1010     }
1011
1012     my $id = shift;
1013
1014     if (!defined($id) || scalar($id) < 1) {
1015         print "usage: destroy <object number>\n";
1016         return;
1017     }
1018
1019     print "Destroying object $id...\n";
1020     my $packed = pack("IL", $::client_id, $id);
1021     my $rc = ioctl(DEV_OBD, &OBD_IOC_DESTROY, $packed);
1022
1023     if (!defined $rc) {
1024         print STDERR "ioctl failed: $!\n";
1025     } elsif ($rc eq "0 but true") {
1026         print "Finished (success)\n";
1027     } else {
1028         print "ioctl returned error code $rc.\n";
1029     }
1030 }
1031
1032 sub Getattr {
1033     if (!defined($::client_id)) {
1034         print "You must first ``connect''.\n";
1035         return;
1036     }
1037
1038     my $id = shift;
1039
1040     if (!defined($id) || scalar($id) < 1) {
1041         print "invalid arguments; type \"help getattr\" for a synopsis\n";
1042         return;
1043     }
1044
1045     # see Setattr
1046     my $obdo;
1047     $obdo->{id} = $id;
1048     $obdo->{valid} = &OBD_MD_FLALL;
1049     my $packed = pack("L", $::client_id) . obdo_pack($obdo);
1050     my $rc = ioctl(DEV_OBD, &OBD_IOC_GETATTR, $packed);
1051
1052     if (!defined $rc) {
1053         print STDERR "ioctl failed: $!\n";
1054     } elsif ($rc eq "0 but true") {
1055         $obdo = obdo_unpack($packed,  4);
1056         obdo_print($obdo);
1057     } else {
1058         print "ioctl returned error code $rc.\n";
1059     }
1060 }
1061
1062 sub Setattr {
1063     if (!defined($::client_id)) {
1064         print "You must first ``connect''.\n";
1065         return;
1066     }
1067
1068     my $id = shift;
1069
1070     if (!defined($id) || scalar($id) < 1) {
1071         print "invalid arguments; type \"help setattr\" for a synopsis\n";
1072         return;
1073     }
1074
1075     # XXX we do not currently set all of the fields in the obdo
1076     my $obdo;
1077     $obdo->{id} = $id;
1078     $obdo->{mode} = oct(shift);
1079     $obdo->{uid} = shift;
1080     $obdo->{gid} = shift;
1081     $obdo->{size} = shift;
1082     $obdo->{atime} = shift;
1083     $obdo->{mtime} = shift;
1084     $obdo->{ctime} = shift;
1085     $obdo->{valid} = 0;
1086
1087     if (defined($obdo->{atime})) {
1088         $obdo->{valid} |= &OBD_MD_FLATIME;
1089     }
1090     if (defined($obdo->{mtime})) {
1091         $obdo->{valid} |= &OBD_MD_FLMTIME;
1092     }
1093     if (defined($obdo->{ctime})) {
1094         $obdo->{valid} |= &OBD_MD_FLCTIME;
1095     }
1096     if (defined($obdo->{size})) {
1097         $obdo->{valid} |= &OBD_MD_FLSIZE;
1098     }
1099     if (defined($obdo->{mode})) {
1100         $obdo->{valid} |= &OBD_MD_FLMODE;
1101     }
1102     if (defined($obdo->{uid})) {
1103         $obdo->{valid} |= &OBD_MD_FLUID;
1104     }
1105     if (defined($obdo->{gid})) {
1106         $obdo->{valid} |= &OBD_MD_FLGID;
1107     }
1108
1109     printf "valid is %x, mode is %o\n", $obdo->{valid}, $obdo->{mode};
1110     my $packed = pack("L", $::client_id) . obdo_pack($obdo);
1111     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETATTR, $packed);
1112
1113     if (!defined $rc) {
1114         print STDERR "ioctl failed: $!\n";
1115     } elsif ($rc eq "0 but true") {
1116         print "Finished (success)\n";
1117     } else {
1118         print "ioctl returned error code $rc.\n";
1119     }
1120 }
1121
1122 sub Read {
1123     if (!defined($::client_id)) {
1124         print "You must first ``connect''.\n";
1125         return;
1126     }
1127
1128     my $id = shift;
1129     my $count = shift;
1130     my $offset = shift;
1131
1132     if (!defined($id) || scalar($id) < 1 || !defined($count) ||
1133         $count < 1 || (defined($offset) && $offset < 0)) {
1134         print "invalid arguments; type \"help read\" for a synopsis\n";
1135         return;
1136     }
1137
1138     if (!defined($offset)) {
1139         $offset = 0;
1140     }
1141
1142     print("Reading $count bytes starting at byte $offset from object " .
1143           "$id...\n");
1144
1145     # "allocate" a large enough buffer
1146     my $buf = sprintf("%${count}s", " ");
1147     die "suck" if (length($buf) != $count);
1148
1149     my $obdo;
1150     $obdo->{id} = $id;
1151
1152     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1153     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1154                  pack("p LL LL", $buf, $count, $offset);
1155
1156     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ, $packed);
1157
1158     $retval = unpack("l", $packed);
1159
1160     if (!defined $rc) {
1161         print STDERR "ioctl failed: $!\n";
1162     } elsif ($rc eq "0 but true") {
1163         if ($retval >= 0) {
1164                 print substr($buf, 0, $retval);
1165                 print "\nRead $retval of an attempted $count bytes.\n";
1166                 print "Finished (success)\n";
1167         } else {
1168                 print "Finished (error $retval)\n";
1169         }
1170     } else {
1171         print "ioctl returned error code $rc.\n";
1172     }
1173 }
1174
1175 sub Read2 {
1176     if (!defined($::client_id)) {
1177         print "You must first ``connect''.\n";
1178         return;
1179     }
1180
1181     my $id = shift;
1182     my $count = shift;
1183     my $offset = shift;
1184
1185     if (!defined($id) || scalar($id) < 1 || !defined($count) ||
1186         $count < 1 || (defined($offset) && $offset < 0)) {
1187         print "invalid arguments; type \"help read\" for a synopsis\n";
1188         return;
1189     }
1190
1191     if (!defined($offset)) {
1192         $offset = 0;
1193     }
1194
1195     print("Reading $count bytes starting at byte $offset from object " .
1196           "$id...\n");
1197
1198     # "allocate" a large enough buffer
1199     my $buf = sprintf("%${count}s", " ");
1200     die "suck" if (length($buf) != $count);
1201
1202     my $obdo;
1203     $obdo->{id} = $id;
1204
1205     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1206     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1207                  pack("p LL LL", $buf, $count, $offset);
1208
1209     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ2, $packed);
1210
1211     $retval = unpack("l", $packed);
1212
1213     if (!defined $rc) {
1214         print STDERR "ioctl failed: $!\n";
1215     } elsif ($rc eq "0 but true") {
1216         if ($retval >= 0) {
1217                 print substr($buf, 0, $retval);
1218                 print "\nRead $retval of an attempted $count bytes.\n";
1219                 print "Finished (success)\n";
1220         } else {
1221                 print "Finished (error $retval)\n";
1222         }
1223     } else {
1224         print "ioctl returned error code $rc.\n";
1225     }
1226 }
1227
1228 sub Write {
1229     if (!defined($::client_id)) {
1230         print "You must first ``connect''.\n";
1231         return;
1232     }
1233
1234     my $id = shift;
1235     my $offset = shift;
1236     my $text = join(' ', @_);
1237     my $count = length($text);
1238
1239     if (!defined($id) || scalar($id) < 1 || !defined($offset) ||
1240         scalar($offset) < 0) {
1241         print "invalid arguments; type \"help write\" for a synopsis\n";
1242         return;
1243     }
1244
1245     if (!defined($text)) {
1246         $text = "";
1247         $count = 0;
1248     }
1249
1250     print("Writing $count bytes starting at byte $offset to object $id...\n");
1251
1252     my $obdo;
1253     $obdo->{id} = $id;
1254
1255     # the perl we're using doesn't support pack type Q
1256     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1257                  pack("p LL LL", $buf, $count, $offset);
1258
1259     my $rc = ioctl(DEV_OBD, &OBD_IOC_WRITE, $packed);
1260
1261     $retval = unpack("l", $packed);
1262
1263     if (!defined $rc) {
1264         print STDERR "ioctl failed: $!\n";
1265     } elsif ($rc eq "0 but true") {
1266         if ($retval >= 0) {
1267                 print "\nWrote $retval of an attempted $count bytes.\n";
1268                 print "Finished (success)\n";
1269         } else {
1270                 print "Finished (error $retval)\n";
1271         }
1272     } else {
1273         print "ioctl returned error code $rc.\n";
1274     }
1275 }
1276
1277 sub Punch {
1278     if (!defined($::client_id)) {
1279         print "You must first ``connect''.\n";
1280         return;
1281     }
1282
1283     my $id = shift;
1284     my $start = shift;
1285     my $count = shift;
1286
1287     if (!defined($id) || scalar($id) < 1 || !defined($start) ||
1288         scalar($start) < 0 || !defined($count) || scalar($count) < 0) {
1289         print "invalid arguments; type \"help punch\" for a synopsis\n";
1290         return;
1291     }
1292
1293     print("Punching $count bytes starting at byte $start in object $id...\n");
1294
1295     my $obdo;
1296     $obdo->{id} = $id;
1297
1298     # the perl we're using doesn't support pack type Q
1299     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1300                  pack("p LL LL", $buf, $start, $count);
1301
1302     my $rc = ioctl(DEV_OBD, &OBD_IOC_PUNCH, $packed);
1303
1304     $retval = unpack("l", $packed);
1305
1306     if (!defined $rc) {
1307         print STDERR "ioctl failed: $!\n";
1308     } elsif ($rc eq "0 but true") {
1309         if ($retval >= 0) {
1310                 print "\nPunched $retval of an attempted $count bytes.\n";
1311                 print "Finished (success)\n";
1312         } else {
1313                 print "Finished (error $retval)\n";
1314         }
1315     } else {
1316         print "ioctl returned error code $rc.\n";
1317     }
1318 }
1319
1320 sub Preallocate {
1321     my $num = shift;
1322
1323     if (!defined($::client_id)) {
1324         print "You must first ``connect''.\n";
1325         return;
1326     }
1327
1328     if (!defined($num) || scalar($num) < 1 || scalar($num) > 32) {
1329         $num = 32;
1330     }
1331
1332     print "Preallocating $num objects...\n";
1333     # client id, alloc, id[32]
1334     my $packed = pack("LLx128", $::client_id, $num);
1335
1336     my $rc = ioctl(DEV_OBD, &OBD_IOC_PREALLOCATE, $packed);
1337
1338     if (!defined $rc) {
1339         print STDERR "ioctl failed: $!\n";
1340     } elsif ($rc eq "0 but true") {
1341         my $alloc = unpack("x4L", $packed);
1342         my @ids = unpack("x8L32", $packed);
1343         my $i;
1344
1345         print "Got $alloc objects: ";
1346         foreach $i (@ids) {
1347             print $i . " ";
1348         }
1349         print "\nFinished (success)\n";
1350     } else {
1351         print "ioctl returned error code $rc.\n";
1352     }
1353 }
1354
1355 sub Decusecount {
1356     my $rc = ioctl(DEV_OBD, &OBD_IOC_DEC_USE_COUNT, 0);
1357
1358     if (!defined $rc) {
1359         print STDERR "ioctl failed: $!\n";
1360     } elsif ($rc eq "0 but true") {
1361         print "Finished (success)\n";
1362     } else {
1363         print "ioctl returned error code $rc.\n";
1364     }
1365 }
1366
1367 sub Statfs {
1368     if (!defined($::client_id)) {
1369         print "You must first ``connect''.\n";
1370         return;
1371     }
1372
1373     # struct statfs {
1374     #         long f_type;
1375     #         long f_bsize;
1376     #         long f_blocks;
1377     #         long f_bfree;
1378     #         long f_bavail;
1379     #         long f_files;
1380     #         long f_ffree;
1381     #         __kernel_fsid_t f_fsid; (64 bits)
1382     #         long f_namelen;
1383     #         long f_spare[6];
1384     # };
1385
1386     my $packed = pack("LLLLLLLIILL6", $::client_id, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1387                       0, 0, 0, 0, 0, 0);
1388
1389     my $rc = ioctl(DEV_OBD, &OBD_IOC_STATFS, $packed);
1390
1391     if (!defined $rc) {
1392         print STDERR "ioctl failed: $!\n";
1393     } elsif ($rc eq "0 but true") {
1394         # skip both the conn_id and the fs_type in the buffer
1395         my ($bsize, $blocks, $bfree, $bavail, $files, $ffree) =
1396             unpack("x4x4LLLLLL", $packed);
1397         print("$bsize byte blocks: $blocks, " . ($blocks - $bfree) . " used, " .
1398               "$bfree free ($bavail available).\n");
1399         print "$files files, " . ($files - $ffree) . " used, $ffree free.\n";
1400         print "Finished (success)\n";
1401     } else {
1402         print "ioctl returned error code $rc.\n";
1403     }
1404 }
1405
1406 sub Help {
1407     my $cmd = shift;
1408
1409     if ( !$cmd || !$commands{$cmd} ) {
1410         print "Comands: ", join( ' ', @jcm_cmd_list), "\n";
1411     } else {
1412         print "Usage: " .  $commands{$cmd}->{doc} . "\n";
1413     }
1414 }
1415
1416 sub Quit {
1417     if ($::client_id) {
1418         print "Disconnecting active session ($::client_id)...";
1419         Disconnect($::client_id);
1420     }
1421     exit;
1422 }