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 @procsysobd_objects = ('debug', 'index', 'reset', 'trace', 'vars');
 213
 214 my %commands =
 215     ('status' => {func => "Status", doc => "status: show obd device status"},
 216      'procsys' => {func => "Procsys", doc => "procsys <file> <value> (set /proc/sys/obd configuration)"},
 217      'shell' => {func => "Shell", doc => "shell <shell-command>: execute shell-commands"},
 218      'script' => {func => "Script", doc => "script <filename>: read and execute commands from a file"},
 219      'insmod' => {func => "Insmod", doc => "insmod <module>: insert kernel module"},
 220      'rmmod' => {func => "Rmmod", doc => "rmmod <module>: insert kernel module"},
 221      'lsmod' => {func => "Lsmod", doc => "lsmod <module>: list kernel modules"},
 222      'device' => {func => "Device", doc => "device <dev>: open another OBD device"},
 223      'close' => {func => "Close", doc => "close <dev>: close OBD device"},
 224      'create' => {func => "Create", doc => "create [<num> [<mode> [quiet]]]: create new object(s) (files, unless mode is given)"},
 225      'attach' => {func => "Attach", doc => "attach { obdext2 | obdsnap snapdev snapidx tableno | obdscsi adapter bus tid lun }: attach this minor device to the specified driver" },
 226      'detach' => {func => "Detach", doc => "detach this minor device"},
 227      'testext2iterator' => {func => "TestExt2Iterator", doc => "test ext2 iterator function"},
 228      'snapset' => {func => "SnapSetTable", doc => "snapset <tableno> <file>: set the table (created with snaptable) as table #tableno" },
 229      'snapprint' => {func => "SnapPrint", doc => "snapprint <tableno>: output the contents of table #tableno to the syslog"},
 230      'snapdelete' => {func => "SnapDelete", doc => "snapdelete: delete connected snap obd objects from disk"},
 231      'snaprestore' => {func => "SnapRestore", doc => "snaprestore : restore connected old snap objects to be current"},
 232      'snaptable' => {func => "SnapShotTable", doc => "snaptable: build a snapshot table (interactive)"},
 233      'copy' => {func => "Copy", doc => "copy <srcid> <tgtid>: copy objects"},
 234      'migrate' => {func => "Migrate", doc => "migrate <srcid> <tgtid>: migrate data from one object to another"},
 235      'partition' => {func => "Partition", doc => "partition <type> <adapter> <bus> <tid> <lun> <partition> <size>: create a partition"},
 236      'format' => {func => "Format", doc => "format <type> <adapter> <bus> <tid> <lun> <size>: format a partition"},
 237      'setup' => {func => "Setup", doc => "setup [type]: link this OBD device to the underlying device (default type obdext2)"},
 238      'connect' => {func => "Connect", doc => "connect: allocates client ID for this session"},
 239      'disconnect' => {func => "Disconnect", doc => "disconnect [id]: frees client resources"},
 240      'sync' => {func => "Sync", doc => "sync: flushes buffers to disk"},
 241      'destroy' => {func => "Destroy", doc => "destroy <id>: destroys an object"},
 242      'cleanup' => {func => "Cleanup", doc => "cleanup the minor obd device"},
 243      'dec_use_count' => {func => "Decusecount", doc => "decreases the module use count so that the module can be removed following an oops"},
 244      'read' => {func => "Read", doc => "read <id> <count> [offset]: read data from object"},
 245      'fsread' => {func => "Read2", doc => "read <id> <count> [offset]: read data from object"},
 246      'write' => {func => "Write", doc => "write <id> <offset> <text>: write data to object"},
 247      'punch' => {func => "Punch", doc => "punch <id> <start> <count>: punch a hole in object"},
 248      'setattr' => {func => "Setattr", doc => "setattr <id> [mode [uid [gid [size [atime [mtime [ctime]]]]]]]: sets object attributes"},
 249      'getattr' => {func => "Getattr", doc => "getattr <id>: displays object attributes"},
 250      'preallocate' => {func => "Preallocate", doc => "preallocate [num]: requests preallocation of num objects."},
 251      'statfs' => {func => "Statfs", doc => "statfs: filesystem status information"},
 252      'help' => {func => \&Help,  doc => "help: this message"},
 253      'quit' => {func => \&Quit,  doc => "see \"exit\""},
 254      'exit' => {func => \&Quit,  doc => "see \"quit\""}
 255     );
 256
 257 #
 258 #       setup completion function
 259 #
 260 my @jcm_cmd_list = keys %commands;
 261
 262 my $term, $attribs;
 263
 264
 265 # Get going....
 266
 267 #Device($::device);
 268
 269 sub readl {
 270     if ( $file ) {
 271         my $str = <STDIN>;
 272         chop($str);
 273         return $str;
 274     } else {
 275         return $term->readline(@_);
 276     }
 277 }
 278
 279
 280
 281 if ( $file ) {
 282     while ( <STDIN> ) {
 283         print $_;
 284         my $rc = execute_line($_);
 285         if ($rc != 0) { last; }
 286     }
 287     exit 0;
 288 } else {
 289     $term = new Term::ReadLine 'obdcontrol ';
 290     $attribs = $term->Attribs;
 291     $attribs->{attempted_completion_function} = \&completeme;
 292     $term->ornaments('md,me,,');        # bold face prompt
 293
 294     # make sure stdout is not buffered
 295     STDOUT->autoflush(1);
 296
 297
 298     # Get on with the show
 299     process_line();
 300 }
 301
 302 #------------------------------------------------------------------------------
 303 sub completeme {
 304     my ($text, $line, $start, $end) = @_;
 305     if (substr($line, 0, $start) =~ /^\s*$/) {
 306         if ($] < 5.6) { # PErl version is less than 5.6.0
 307             return (exists $commands{$text}) ? $text : 0;
 308 #Above line doesn't perform command completion, but
 309 #perl5.005 Term-ReadLine lacks support for completion matching
 310 #and perl5.6.0 requires glibc2.2.2 that won't run under Redhat6.2......sigh.
 311         }
 312         else {
 313             $attribs->{completion_word} = \@jcm_cmd_list;
 314             return $term->completion_matches($text,
 315                        $attribs->{'list_completion_function'});
 316         }
 317     }
 318 }
 319
 320 sub find_command {
 321     my $given = shift;
 322     my $name;
 323     my @completions = completeme($given, $given, 0, length($given));
 324     if ($#completions == 0) {
 325         $name = shift @completions;
 326     }
 327
 328     return $name;
 329 }
 330
 331 # start making requests
 332 sub process_line {
 333   foo:
 334     $line = $term->readline("obdcontrol > ");
 335     execute_line($line);
 336     goto foo;
 337 }
 338
 339 sub execute_line {
 340     my $line = shift;
 341
 342     my @cmdline = split(' ', $line);
 343     my $word = shift @cmdline;
 344
 345     return 0 unless ($word);
 346
 347     my $cmd;
 348     if ( $file ) {
 349         $cmd = $word;
 350     } else {
 351         $cmd = find_command($word);
 352     }
 353     unless ($cmd) {
 354         printf STDERR "$word: No such command, or not unique.\n";
 355         return (-1);
 356     }
 357
 358     # Call the function.
 359     return (&{$commands{$cmd}->{func}}(@cmdline));
 360 }
 361
 362 my %opendevfds = ();
 363
 364 # select the OBD device we talk to
 365 sub Device {
 366     my $device = shift;
 367
 368     if ( ! $device && ! $::device ) { # first time ever
 369         $device = '/dev/obd0';
 370     }
 371
 372     if (($device) && ($::device ne $device)) {
 373         local *NEW_OBD;
 374         my $newfd;
 375
 376         if ($::client_id) {
 377             print "Disconnecting active session ($::client_id)...";
 378             Disconnect($::client_id);
 379         }
 380
 381         if ($opendevfds{$device}) {
 382             $::dev_obd = $opendevfds{$device};
 383         }
 384         else {
 385             # Open the device, as we need an FD for the ioctl
 386             if (!sysopen(NEW_OBD, $device, 0)) {
 387                 print "Cannot open $device. Did you insert the obdclass module ?\n";
 388                 return -1;
 389             }
 390             print "Opened device $device\n";
 391             $opendevfds{$device} = *NEW_OBD;
 392             $::dev_obd = *NEW_OBD;
 393         }
 394         $::device = $device;
 395     }
 396     print "Current device is $::device\n";
 397     return 0;
 398 }
 399
 400 sub Close {
 401     my $device = shift;
 402     my $fd2close;
 403
 404     if ( ! $device && ! $::device ) { # first time ever
 405         print "Nothing to close\n";
 406         return -1;
 407     }
 408
 409     if ( ! $device ) {
 410         $device = $::device;
 411     }
 412
 413     if ($::device eq $device) {
 414         if ($::client_id) {
 415             print "Disconnecting active session ($::client_id)...";
 416             Disconnect($::client_id);
 417         }
 418     }
 419
 420     $fd2close = $opendevfds{$device};
 421     if ($fd2close) { # XXXX something wrong in this if statement
 422         close ($fd2close);
 423         $opendevfds{$device} = undef;
 424         print "Closed device $device\n";
 425     }
 426     else {
 427         print "Device $device was not open\n";
 428         return -1;
 429     }
 430
 431     if ($::device eq $device) {
 432         $::dev_obd = undef;
 433         $::device = undef;
 434     }
 435     print "No current device. You just closed the current device ($device).\n";
 436     return 0;
 437 }
 438
 439 sub Script {
 440     my $cmdfilename = shift;
 441     my $rc = 0;
 442     if ( ! $cmdfilename )  {
 443         print "please specify a command file name\n";
 444         return -1;
 445     }
 446     if (! open(CMDF, $cmdfilename)) {
 447         print "Cannot open $cmdfilename: $!\n";
 448         return -1;
 449     }
 450     while (<CMDF>) {
 451         if (/^#/) {
 452             next;
 453         }
 454         print "execute> $_";
 455         $rc = execute_line($_);
 456         if ($rc != 0) {
 457             print "Something went wrong .......command exit status: $rc\n";
 458             last;
 459         }
 460     }
 461     close(CMDF);
 462     return $rc;
 463 }
 464
 465 sub Shell {
 466     my $user_shell=$ENV{'SHELL'};
 467     print "% $user_shell -c '@_'\n";
 468     if ( ! @_ ) {
 469         print "please specify a shell command\n";
 470         return;
 471     }
 472     system("$user_shell -c '@_'");
 473     return ($? >> 8);
 474 }
 475
 476 sub Status {
 477     my $oldfh = select(STDOUT);
 478     $| = 1;
 479
 480     system('cat /proc/lustre/obd/*/status');
 481     my $rc = ($? >> 8);
 482
 483     select($oldfh);
 484     $| = 0;
 485
 486     return $rc;
 487 }
 488
 489 sub Procsys {
 490     my $set_sysobd = shift;
 491     my $value = shift;
 492
 493     foreach $i (0 .. $#procsysobd_objects) {
 494         my $sysobd = $procsysobd_objects[$i];
 495
 496         if (defined $set_sysobd) {
 497             if ($sysobd ne $set_sysobd) { next; }
 498
 499             if (defined $value) { # set this one
 500                 system("echo \"$value\" > /proc/sys/obd/$sysobd");
 501             }
 502             system("echo \"/proc/sys/obd/$sysobd:\"; cat /proc/sys/obd/$sysobd");
 503             last;
 504         }
 505         else {
 506             system("echo \"/proc/sys/obd/$sysobd:\"; cat /proc/sys/obd/$sysobd");
 507         }
 508     }
 509     return ($? >> 8);
 510 }
 511
 512 sub Insmod {
 513     my $module = shift;
 514     system("insmod $module");
 515     return ($? >> 8);
 516 }
 517
 518 sub Rmmod {
 519     my $module = shift;
 520     system("rmmod $module");
 521     return ($? >> 8);
 522 }
 523
 524 sub Lsmod {
 525     my $module = shift;
 526     system("lsmod $module");
 527     return ($? >> 8);
 528 }
 529
 530 sub Attach {
 531     my $err = 0;
 532     my $type = shift;
 533     my $data;
 534     my $datalen = 0;
 535
 536     if ( ! $type ) {
 537         print "error: missing type\n";
 538 usage:
 539         print "usage: attach {obdext2 | obdsnap | obdscsi | obdtrace }\n";
 540         return -1;
 541     }
 542
 543     if ($type eq "obdscsi" ) {
 544         my $adapter = shift;
 545         my $bus = shift;
 546         my $tid = shift;
 547         my $lun = shift;
 548
 549         $data = pack("iiii", $adapter, $bus, $tid, $lun);
 550         $datalen = 4 * 4;
 551     } elsif ($type eq "obdsnap" ) {
 552         my $snapdev = shift;
 553         my $snapidx = shift;
 554         my $tableno = shift;
 555
 556         $data = pack("iii", $snapdev, $snapidx, $tableno);
 557         $datalen = 3 * 4;
 558     } elsif ($type eq "obdext2") {
 559         $data = pack("i", 4711);   # bogus data
 560         $datalen = 4;
 561     } elsif ($type eq "obdtrace") {
 562         $data = pack("i", 4711);   # bogus data
 563         $datalen = 4;
 564     } else {
 565         print "error: unknown attach type $type\n";
 566         goto usage;
 567     }
 568
 569     my $len = length($type);
 570     my $cl = length($data);
 571
 572     print "type $type (len $len), datalen $datalen ($cl)\n";
 573     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 574
 575     if (! defined $::dev_obd) {
 576         print "No current device.\n";
 577         return -1;
 578     }
 579     my $rc = ioctl($::dev_obd, &OBD_IOC_ATTACH, $packed);
 580
 581     if (!defined $rc) {
 582         print STDERR "ioctl failed: $!\n";
 583         return -1;
 584     } elsif ($rc eq "0 but true") {
 585         print "Finished (success)\n";
 586         return 0;
 587     } else {
 588         print "ioctl returned error code $rc.\n";
 589         return -1;
 590     }
 591 }
 592
 593
 594 sub Detach {
 595     my $err = 0;
 596     my $data = "";
 597
 598     if (! defined $::dev_obd) {
 599         print "No current device.\n";
 600         return -1;
 601     }
 602
 603     my $rc = ioctl($::dev_obd, &OBD_IOC_DETACH, $data);
 604
 605     if (!defined $rc) {
 606         print STDERR "ioctl failed: $!\n";
 607         return -1;
 608     } elsif ($rc eq "0 but true") {
 609         print "Finished (success)\n";
 610         return 0;
 611     } else {
 612         print "ioctl returned error code $rc.\n";
 613         return -1;
 614     }
 615 }
 616
 617
 618 sub TestExt2Iterator {
 619     if (!defined($::client_id)) {
 620         print "You must first ``connect''.\n";
 621         return;
 622     }
 623
 624     my $err = 0;
 625     my $type = "obdext2";
 626
 627     $data = pack("i", 4711); # bogus data
 628     $datalen = 4;
 629
 630     my $len = length($type);
 631     my $cl = length($data);
 632     print "type $type (len $len), datalen $datalen ($cl)\n";
 633     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 634     if (! defined $::dev_obd) {
 635         print "No current device.\n";
 636         return -1;
 637     }
 638
 639     my $rc = ioctl($::dev_obd, &OBD_EXT2_RUNIT, $packed);
 640
 641     if (!defined $rc) {
 642         print STDERR "ioctl failed: $!\n";
 643         return -1;
 644     } elsif ($rc eq "0 but true") {
 645         print "Finished (success)\n";
 646         return 0;
 647     } else {
 648         print "ioctl returned error code $rc.\n";
 649         return -1;
 650     }
 651 }
 652
 653
 654 sub SnapDelete {
 655     if (!defined($::client_id)) {
 656         print "You must first ``connect''.\n";
 657         return -1;
 658     }
 659
 660     my $err = 0;
 661     my $type = "obdsnap";
 662
 663     $data = pack("i", 4711); # bogus data
 664     $datalen = 4;
 665
 666     my $len = length($type);
 667     my $cl = length($data);
 668     print "type $type (len $len), datalen $datalen ($cl)\n";
 669     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 670
 671     # XXX We need to fix this up so that after the objects in this snapshot
 672     #     are deleted, the snapshot itself is also removed from the table.
 673
 674     if (! defined $::dev_obd) {
 675         print "No current device.\n";
 676         return -1;
 677     }
 678
 679     my $rc = ioctl($::dev_obd, &OBD_SNAP_DELETE, $packed);
 680
 681     if (!defined $rc) {
 682         print STDERR "ioctl failed: $!\n";
 683         return -1;
 684     } elsif ($rc eq "0 but true") {
 685         print "Finished (success)\n";
 686         return 0;
 687     } else {
 688         print "ioctl returned error code $rc.\n";
 689         return -1;
 690     }
 691 }
 692
 693
 694 #      this routine does the whole job
 695 sub SnapRestore {
 696     my $restoreto = shift;
 697     my $snaptable = shift;
 698     my $tableno = shift;
 699     my $restoretime;
 700
 701     # don't do anything until connected
 702     if (!defined($::client_id)) {
 703         print "You must first ``connect''.\n";
 704         return -1;
 705     }
 706
 707     if ( ! $snaptable || ! defined $restoreto ) {
 708         print "Usage: snaprestore \"restore to slot\" \"snaptable\" \"tableno\"\n";
 709         return -1;
 710     }
 711
 712     if ( ! -f $snaptable ) {
 713         print "Table $snaptable doesn't exist\n";
 714         return -1;
 715     }
 716
 717     my $table = ReadSnapShotTable($snaptable);
 718     $restoretime = FindSnapInTable($table, $restoreto);
 719     if ( ! defined $table->{0} || ! defined $restoretime ) {
 720         PrintSnapShotTable($table);
 721         print "No current or $restoreto slot in this table\n";
 722         return -1;
 723     }
 724
 725     my $currentindex = $table->{0};
 726     if (  $table->{$restoretime} == $currentindex ) {
 727         print "You should not restore to the current snapshot\n";
 728         return -1;
 729     }
 730
 731     # swap the entries for 0 and $restoreto
 732     my $tmp = $table->{$restoretime};
 733     $table->{$restoretime} = $table->{0};
 734     $table->{0} = $tmp;
 735     # PrintSnapShotTable($table);
 736
 737     # write it back
 738     WriteSnapShotTable($snaptable, $table);
 739
 740     # set it in the kernel
 741     SnapSetTable($tableno, $snaptable);
 742
 743     # ready for the ioctl
 744     my $err = 0;
 745     my $type = "obdsnap";
 746     $data = pack("i", $currentindex); # slot of previous current snapshot
 747     $datalen = 4;
 748
 749     my $len = length($type);
 750     my $cl = length($data);
 751     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 752     if (! defined $::dev_obd) {
 753         print "No current device.\n";
 754         return -1;
 755     }
 756
 757     my $rc = ioctl($::dev_obd, &OBD_SNAP_RESTORE, $packed);
 758
 759     if (!defined $rc) {
 760         print STDERR "ioctl failed: $!\n";
 761         return -1;
 762     } elsif ($rc eq "0 but true") {
 763         print "Snaprestore finished (success)\n";
 764         delete $table->{$restoretime} if defined $restoretime;
 765         # write it back
 766         WriteSnapShotTable($snaptable, $table);
 767
 768         # set it in the kernel
 769         SnapSetTable($tableno, $snaptable);
 770         # PrintSnapShotTable($table);
 771         return 0;
 772     } else {
 773         print "ioctl returned error code $rc.\n";
 774         return -1;
 775     }
 776 }
 777
 778 sub FindSnapInTable {
 779     my $table = shift;
 780     my $snapno =shift;
 781
 782     foreach my $restoretime ( keys %{$table} ) {
 783         if ( $table->{$restoretime} == $snapno) {
 784             print "Found key $restoretime for snapno $snapno\n";
 785             return $restoretime;
 786         }
 787     }
 788     undef;
 789 }
 790
 791
 792 sub SnapPrint {
 793     my $err = 0;
 794     my $type = "obdsnap";
 795     my $snaptableno = shift;
 796
 797     $data = pack("i", $snaptableno);
 798     $datalen = 4;
 799
 800     my $len = length($type);
 801     my $cl = length($data);
 802     print "type $type (len $len), datalen $datalen ($cl)\n";
 803     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 804     if (! defined $::dev_obd) {
 805         print "No current device.\n";
 806         return -1;
 807     }
 808
 809     my $rc = ioctl($::dev_obd, &OBD_SNAP_PRINTTABLE, $packed);
 810
 811     if (!defined $rc) {
 812         print STDERR "ioctl failed: $!\n";
 813         return -1;
 814     } elsif ($rc eq "0 but true") {
 815         print "Finished (success)\n";
 816         return 0;
 817     } else {
 818         print "ioctl returned error code $rc.\n";
 819         return -1;
 820     }
 821 }
 822
 823 sub SnapSetTable {
 824     my $err = 0;
 825     my $type = "obdsnap";
 826     my $snaptableno = shift;
 827     my $file = shift;
 828     my $snapcount;
 829     my $table = {};
 830     my $data;
 831     my $datalen = 0;
 832
 833     if ( ! -f $file ) {
 834         print "No such file $file\n";
 835         return -1;
 836     }
 837
 838     $table = ReadSnapShotTable($file);
 839
 840     $snapcount = keys %{$table};
 841     print "Snapcount $snapcount\n";
 842
 843     if ( ! defined $table->{0} ) {
 844         print "No current snapshot in table! First make one\n";
 845         return -1;
 846     }
 847     $data = pack("ii", $snaptableno, $snapcount);
 848     $datalen = 2 * 4;
 849     foreach my $time (sort keys %{$table}) {
 850         # XXX we should change to pack LL instead of I for times
 851         $data .= pack("Ii", $time, $table->{$time});
 852         $datalen += 8;
 853     }
 854
 855     my $len = length($type);
 856     my $cl = length($data);
 857     print "type $type (len $len), datalen $datalen ($cl)\n";
 858     my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
 859     if (! defined $::dev_obd) {
 860         print "No current device.\n";
 861         return -1;
 862     }
 863
 864     my $rc = ioctl($::dev_obd, &OBD_SNAP_SETTABLE, $packed);
 865
 866     if (!defined $rc) {
 867         print STDERR "ioctl failed: $!\n";
 868         return -1;
 869     } elsif ($rc eq "0 but true") {
 870         print "Finished (success)\n";
 871         return 0;
 872     } else {
 873         print "ioctl returned error code $rc.\n";
 874         return -1;
 875     }
 876 }
 877
 878
 879 sub SnapShotTable  {
 880
 881     my $file = &readl("enter file name: ");
 882     if ( ! -f $file ) {
 883         `touch $file`;
 884     }
 885     my $table = ReadSnapShotTable($file);
 886
 887   again:
 888     PrintSnapShotTable($table);
 889     my $action = &readl("Add, Delete or Quit [adq]: ");
 890     goto done if ($action  =~ "^q.*" );
 891     goto add if ($action =~ "^a.*");
 892     goto del  if ($action =~ "^d.*");
 893     goto again;
 894
 895   add:
 896     my $idx = &readl("enter index where you want this snapshot: ");
 897     my $time = &readl("enter time or 'now' or 'current': ");
 898     my $oldtime = SnapFindTimeFromIdx($idx, $table);
 899     if (defined $oldtime) {
 900         print "This already exists, first clean up\n";
 901         goto again;
 902     }
 903
 904     if ( $time  eq 'now' ) {
 905         $time = time;
 906     } elsif ( $time eq 'current' ) {
 907         $time = 0;
 908     }
 909     $table->{$time} = $idx;
 910     goto again;
 911
 912   del:
 913     $didx = &readl("Enter index to delete: ");
 914     my $deltime = SnapFindTimeFromIdx($didx, $table);
 915     delete $table->{$deltime} if defined $deltime;
 916     goto again;
 917
 918   done:
 919     my $ok = &readl("OK with new table? [Yn]: ");
 920     unless ( $ok eq "n" )  {
 921         WriteSnapShotTable($file, $table);
 922     }
 923     return 0;
 924 }
 925
 926 sub SnapFindTimeFromIdx {
 927     my $idx = shift;
 928     my $table = shift;
 929
 930     foreach my $time ( keys %{$table} ) {
 931         if ( $table->{$time} == $idx ) {
 932             return $time;
 933         }
 934     }
 935     undef;
 936 }
 937
 938 sub PrintSnapShotTable {
 939     my $table = shift;
 940     my $time;
 941
 942     foreach  $time ( sort keys %{$table} ) {
 943         my $stime = localtime($time);
 944         if ( ! $time ) {
 945             $stime = "current";
 946         }
 947         printf "Time: %s -- Index %d\n", $stime, $table->{$time};
 948     }
 949 }
 950
 951 sub ReadSnapShotTable {
 952
 953     my $file = shift;
 954     my $table = {};
 955
 956     open FH, "<$file";
 957     while ( <FH> ) {
 958         my ($time, $index) = split ;
 959         $table->{$time} = $index;
 960     }
 961     close FH;
 962
 963     PrintSnapShotTable($table);
 964
 965     return $table;
 966 }
 967
 968 sub WriteSnapShotTable {
 969     my $file = shift;
 970     my $table = shift;
 971
 972     open FH, ">$file";
 973     foreach my $time ( sort keys %{$table}  ) {
 974         print FH "$time $table->{$time}\n";
 975     }
 976     close FH;
 977 }
 978
 979 sub Copy {
 980     my $err = 0;
 981     my $src_obdo;
 982     my $dst_obdo;
 983
 984     # Note: _copy IOCTL takes parameters as dst, src.
 985     #       Copy function takes parameters as src, dst.
 986     $src_obdo->{id} = shift;
 987     $dst_obdo->{id} = shift;
 988     $src_obdo->{valid} = &OBD_MD_FLALL;
 989
 990     # XXX need to fix copy so we can have 2 client IDs here
 991     my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
 992     if (! defined $::dev_obd) {
 993         print "No current device.\n";
 994         return -1;
 995     }
 996
 997     my $rc = ioctl($::dev_obd, &OBD_IOC_COPY, $packed);
 998
 999     if (!defined $rc) {
1000         print STDERR "ioctl failed: $!\n";
1001         return -1;
1002     } elsif ($rc eq "0 but true") {
1003         print "Finished (success)\n";
1004         return 0;
1005     } else {
1006         print "ioctl returned error code $rc.\n";
1007         return -1;
1008     }
1009 }
1010
1011 sub Migrate {
1012     my $err = 0;
1013
1014     # Note: _migr IOCTL takes parameters as dst, src.
1015     #       Migrate function takes parameters as src, dst.
1016     $src_obdo->{id} = shift;
1017     $dst_obdo->{id} = shift;
1018     $src_obdo->{valid} = &OBD_MD_FLALL;
1019
1020     # We pack a dummy connection ID here
1021     my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
1022     if (! defined $::dev_obd) {
1023         print "No current device.\n";
1024         return -1;
1025     }
1026
1027     my $rc = ioctl($::dev_obd, &OBD_IOC_MIGR, $packed);
1028
1029     if (!defined $rc) {
1030         print STDERR "ioctl failed: $!\n";
1031         return -1;
1032     } elsif ($rc eq "0 but true") {
1033         print "Finished (success)\n";
1034         return 0;
1035     } else {
1036         print "ioctl returned error code $rc.\n";
1037         return -1;
1038     }
1039 }
1040
1041
1042 sub Format {
1043     my $err = 0;
1044     my $size = shift;
1045     my $data = pack("i", $size);
1046     my $datalen = 4;
1047
1048     my $packed = pack("ip", $datalen, $data);
1049     if (! defined $::dev_obd) {
1050         print "No current device.\n";
1051         return -1;
1052     }
1053     my $rc = ioctl($::dev_obd, &OBD_IOC_FORMATOBD, $packed);
1054
1055     if (!defined $rc) {
1056         print STDERR "ioctl failed: $!\n";
1057         return -1;
1058     } elsif ($rc eq "0 but true") {
1059         print "Finished (success)\n";
1060         return 0;
1061     } else {
1062         print "ioctl returned error code $rc.\n";
1063         return -1;
1064     }
1065 }
1066
1067 sub Partition {
1068     my $err = 0;
1069     my $partno = shift;
1070     my $size = shift;
1071     my $data = pack("ii", $partno, $size);
1072     my $datalen = 2 * 4;
1073
1074     my $packed = pack("ip", $datalen, $data);
1075     if (! defined $::dev_obd) {
1076         print "No current device.\n";
1077         return -1;
1078     }
1079     my $rc = ioctl($::dev_obd, &OBD_IOC_PARTITION, $packed);
1080
1081     if (!defined $rc) {
1082         print STDERR "ioctl failed: $!\n";
1083         return -1;
1084     } elsif ($rc eq "0 but true") {
1085         print "Finished (success)\n";
1086         return 0;
1087     } else {
1088         print "ioctl returned error code $rc.\n";
1089         return -1;
1090     }
1091 }
1092
1093 sub Setup {
1094     my $err = 0;
1095     my $arg = shift;
1096     my $data;
1097     my $datalen = 0;
1098
1099     # XXX we need a getinfo ioctl to validate parameters
1100     # by type here
1101
1102     if ($arg && !defined($::st = stat($arg))) {
1103             print "$arg is not a valid device\n";
1104             return -1;
1105     }
1106
1107     if ( $arg ) {
1108         $data = $arg;
1109         $datalen = length($arg)+1; # need null character also
1110     }
1111
1112     my $packed = pack("ip", $datalen, $data);
1113     if (! defined $::dev_obd) {
1114         print "No current device.\n";
1115         return -1;
1116     }
1117     my $rc = ioctl($::dev_obd, &OBD_IOC_SETUP, $packed);
1118
1119     if (!defined $rc) {
1120         print STDERR "ioctl failed: $!\n";
1121         return -1;
1122     } elsif ($rc eq "0 but true") {
1123         print "Finished (success)\n";
1124         return 0;
1125     } else {
1126         print "ioctl returned error code $rc.\n";
1127         return -1;
1128     }
1129 }
1130
1131 sub Cleanup {
1132     my $err = "0";
1133     if (! defined $::dev_obd) {
1134         print "No current device.\n";
1135         return -1;
1136     }
1137     my $rc = ioctl($::dev_obd, &OBD_IOC_CLEANUP, $err);
1138
1139     if (!defined $rc) {
1140         print STDERR "ioctl failed: $!\n";
1141         return -1;
1142     } elsif ($rc eq "0 but true") {
1143         print "Finished (success)\n";
1144         $::client_id = 0;
1145         return 0;
1146     } else {
1147         print "ioctl returned error code $rc.\n";
1148         return -1;
1149     }
1150 }
1151
1152
1153 sub Connect {
1154     my $rc;
1155
1156     my $packed = "";
1157     if (! defined $::dev_obd) {
1158         print "No current device.\n";
1159         return -1;
1160     }
1161     $rc = ioctl($::dev_obd, &OBD_IOC_CONNECT, $packed);
1162     $id = unpack("I", $packed);
1163
1164     if (!defined $rc) {
1165         print STDERR "ioctl failed: $!\n";
1166         return -1;
1167     } elsif ($rc eq "0 but true") {
1168         $::client_id = $id;
1169         print "Client ID     : $id\n";
1170         print "Finished (success)\n";
1171         return 0;
1172     } else {
1173         print "ioctl returned error code $rc.\n";
1174         return -1;
1175     }
1176 }
1177
1178 sub Disconnect {
1179     my $id = shift;
1180
1181     if (!defined($id)) {
1182         $id = $::client_id;
1183     }
1184
1185     if (!defined($id)) {
1186         print "syntax: disconnect [client ID]\n";
1187         print "When client ID is not given, the last valid client ID to be returned by a\n";
1188         print "connect command this session is used; there is no such ID.\n";
1189         return -1;
1190     }
1191
1192     my $packed = pack("L", $id);
1193     if (! defined $::dev_obd) {
1194         print "No current device.\n";
1195         return -1;
1196     }
1197     my $rc = ioctl($::dev_obd, &OBD_IOC_DISCONNECT, $packed);
1198
1199     if (!defined $rc) {
1200         print STDERR "ioctl failed: $!\n";
1201         return -1;
1202     } elsif ($rc eq "0 but true") {
1203         $::client_id = undef;
1204         print "Finished (success)\n";
1205         return 0;
1206     } else {
1207         print "ioctl returned error code $rc.\n";
1208         return -1;
1209     }
1210 }
1211
1212 sub Create {
1213     if (!defined($::client_id)) {
1214         print "You must first ``connect''.\n";
1215         return -1;
1216     }
1217
1218     my $num = shift;
1219     my $mode = shift;
1220     my $quiet = shift;
1221     my $rc;
1222     my $prealloc = 0;
1223
1224     if (!defined($num)) {
1225         $num = 1;
1226     }
1227
1228     if (!defined($mode)) {
1229         $mode = 0100644;         # create a file (rw-r--r--) if not specified
1230     }
1231
1232     if (scalar($num) < 1 || defined($quiet) && $quiet ne "quiet") {
1233         print "usage: create [<number of objects> [<mode> [quiet]]]\n";
1234         return -1;
1235     }
1236
1237     my $i;
1238     my $id = 0;                 # can't currently request IDs
1239
1240     print "Creating " . scalar($num) . " object";
1241     if (scalar($num) > 1) {
1242         print "s";
1243     }
1244     print "\n";
1245
1246     for ($i = 0; $i < scalar($num); $i++) {
1247         my $obdo;
1248         $obdo->{id} = $id;
1249         $obdo->{mode} = scalar($mode);
1250         $obdo->{valid} = &OBD_MD_FLMODE;
1251
1252         my $packed = pack("I", $::client_id) . obdo_pack($obdo);
1253         if (! defined $::dev_obd) {
1254             print "No current device.\n";
1255             return -1;
1256         }
1257         $rc = ioctl($::dev_obd, &OBD_IOC_CREATE, $packed);
1258         if ($rc ne "0 but true") {
1259             last;
1260         } elsif (!defined($quiet)) {
1261             $obdo = obdo_unpack($packed, 4);
1262             print "Created object #$obdo->{id}.\n";
1263         }
1264     }
1265
1266     if (!defined $rc) {
1267         print STDERR "ioctl failed: $!\n";
1268         return -1;
1269     } elsif ($rc eq "0 but true") {
1270         print "Finished (success)\n";
1271         return 0;
1272     } else {
1273         print "ioctl returned error code $rc.\n";
1274         return -1;
1275     }
1276 }
1277
1278 sub Sync {
1279     my $err = "0";
1280     if (! defined $::dev_obd) {
1281         print "No current device.\n";
1282         return -1;
1283     }
1284     my $rc = ioctl($::dev_obd, &OBD_IOC_SYNC, $err);
1285
1286     if (!defined $rc) {
1287         print STDERR "ioctl failed: $!\n";
1288         return -1;
1289     } elsif ($rc eq "0 but true") {
1290         print "Finished (success)\n";
1291         return 0;
1292     } else {
1293         print "ioctl returned error code $rc.\n";
1294         return -1;
1295     }
1296 }
1297
1298 sub Destroy {
1299     if (!defined($::client_id)) {
1300         print "You must first ``connect''.\n";
1301         return -1;
1302     }
1303
1304     my $id = shift;
1305
1306     if (!defined($id) || scalar($id) < 1) {
1307         print "usage: destroy <object number>\n";
1308         return -1;
1309     }
1310
1311     print "Destroying object $id...\n";
1312     my $packed = pack("IL", $::client_id, $id);
1313     if (! defined $::dev_obd) {
1314         print "No current device.\n";
1315         return -1;
1316     }
1317     my $rc = ioctl($::dev_obd, &OBD_IOC_DESTROY, $packed);
1318
1319     if (!defined $rc) {
1320         print STDERR "ioctl failed: $!\n";
1321         return -1;
1322     } elsif ($rc eq "0 but true") {
1323         print "Finished (success)\n";
1324         return 0;
1325     } else {
1326         print "ioctl returned error code $rc.\n";
1327         return -1;
1328     }
1329 }
1330
1331 sub Getattr {
1332     if (!defined($::client_id)) {
1333         print "You must first ``connect''.\n";
1334         return -1;
1335     }
1336
1337     my $id = shift;
1338
1339     if (!defined($id) || scalar($id) < 1) {
1340         print "invalid arguments; type \"help getattr\" for a synopsis\n";
1341         return -1;
1342     }
1343
1344     # see Setattr
1345     my $obdo;
1346     $obdo->{id} = $id;
1347     $obdo->{valid} = &OBD_MD_FLALL;
1348     my $packed = pack("L", $::client_id) . obdo_pack($obdo);
1349     if (! defined $::dev_obd) {
1350         print "No current device.\n";
1351         return -1;
1352     }
1353     my $rc = ioctl($::dev_obd, &OBD_IOC_GETATTR, $packed);
1354
1355     if (!defined $rc) {
1356         print STDERR "ioctl failed: $!\n";
1357         return -1;
1358     } elsif ($rc eq "0 but true") {
1359         $obdo = obdo_unpack($packed,  4);
1360         obdo_print($obdo);
1361         return 0;
1362     } else {
1363         print "ioctl returned error code $rc.\n";
1364         return -1;
1365     }
1366 }
1367
1368 sub Setattr {
1369     if (!defined($::client_id)) {
1370         print "You must first ``connect''.\n";
1371         return -1;
1372     }
1373
1374     my $id = shift;
1375
1376     if (!defined($id) || scalar($id) < 1) {
1377         print "invalid arguments; type \"help setattr\" for a synopsis\n";
1378         return -1;
1379     }
1380
1381     # XXX we do not currently set all of the fields in the obdo
1382     my $obdo;
1383     $obdo->{id} = $id;
1384     $obdo->{mode} = oct(shift);
1385     $obdo->{uid} = shift;
1386     $obdo->{gid} = shift;
1387     $obdo->{size} = shift;
1388     $obdo->{atime} = shift;
1389     $obdo->{mtime} = shift;
1390     $obdo->{ctime} = shift;
1391     $obdo->{valid} = 0;
1392
1393     if (defined($obdo->{atime})) {
1394         $obdo->{valid} |= &OBD_MD_FLATIME;
1395     }
1396     if (defined($obdo->{mtime})) {
1397         $obdo->{valid} |= &OBD_MD_FLMTIME;
1398     }
1399     if (defined($obdo->{ctime})) {
1400         $obdo->{valid} |= &OBD_MD_FLCTIME;
1401     }
1402     if (defined($obdo->{size})) {
1403         $obdo->{valid} |= &OBD_MD_FLSIZE;
1404     }
1405     if (defined($obdo->{mode})) {
1406         $obdo->{valid} |= &OBD_MD_FLMODE;
1407     }
1408     if (defined($obdo->{uid})) {
1409         $obdo->{valid} |= &OBD_MD_FLUID;
1410     }
1411     if (defined($obdo->{gid})) {
1412         $obdo->{valid} |= &OBD_MD_FLGID;
1413     }
1414
1415     printf "valid is %x, mode is %o\n", $obdo->{valid}, $obdo->{mode};
1416     my $packed = pack("L", $::client_id) . obdo_pack($obdo);
1417     if (! defined $::dev_obd) {
1418         print "No current device.\n";
1419         return -1;
1420     }
1421     my $rc = ioctl($::dev_obd, &OBD_IOC_SETATTR, $packed);
1422
1423     if (!defined $rc) {
1424         print STDERR "ioctl failed: $!\n";
1425         return -1;
1426     } elsif ($rc eq "0 but true") {
1427         print "Finished (success)\n";
1428         return 0;
1429     } else {
1430         print "ioctl returned error code $rc.\n";
1431         return -1;
1432     }
1433 }
1434
1435 sub Read {
1436     if (!defined($::client_id)) {
1437         print "You must first ``connect''.\n";
1438         return -1;
1439     }
1440
1441     my $id = shift;
1442     my $count = shift;
1443     my $offset = shift;
1444
1445     if (!defined($id) || scalar($id) < 1 || !defined($count) ||
1446         $count < 1 || (defined($offset) && $offset < 0)) {
1447         print "invalid arguments; type \"help read\" for a synopsis\n";
1448         return -1;
1449     }
1450
1451     if (!defined($offset)) {
1452         $offset = 0;
1453     }
1454
1455     print("Reading $count bytes starting at byte $offset from object " .
1456           "$id...\n");
1457
1458     # "allocate" a large enough buffer
1459     my $buf = sprintf("%${count}s", " ");
1460     die "suck" if (length($buf) != $count);
1461
1462     my $obdo;
1463     $obdo->{id} = $id;
1464
1465     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1466     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1467                  pack("p LL LL", $buf, $count, $offset);
1468
1469     if (! defined $::dev_obd) {
1470         print "No current device.\n";
1471         return -1;
1472     }
1473     my $rc = ioctl($::dev_obd, &OBD_IOC_READ, $packed);
1474
1475     $retval = unpack("l", $packed);
1476
1477     if (!defined $rc) {
1478         print STDERR "ioctl failed: $!\n";
1479         return -1;
1480     } elsif ($rc eq "0 but true") {
1481         if ($retval >= 0) {
1482                 print substr($buf, 0, $retval);
1483                 print "\nRead $retval of an attempted $count bytes.\n";
1484                 print "Finished (success)\n";
1485                 return 0;
1486         } else {
1487                 print "Finished (error $retval)\n";
1488                 return $retval;
1489         }
1490     } else {
1491         print "ioctl returned error code $rc.\n";
1492         return -1;
1493     }
1494 }
1495
1496 sub Read2 {
1497     if (!defined($::client_id)) {
1498         print "You must first ``connect''.\n";
1499         return -1;
1500     }
1501
1502     my $id = shift;
1503     my $count = shift;
1504     my $offset = shift;
1505
1506     if (!defined($id) || scalar($id) < 1 || !defined($count) ||
1507         $count < 1 || (defined($offset) && $offset < 0)) {
1508         print "invalid arguments; type \"help read\" for a synopsis\n";
1509         return -1;
1510     }
1511
1512     if (!defined($offset)) {
1513         $offset = 0;
1514     }
1515
1516     print("Reading $count bytes starting at byte $offset from object " .
1517           "$id...\n");
1518
1519     # "allocate" a large enough buffer
1520     my $buf = sprintf("%${count}s", " ");
1521     die "suck" if (length($buf) != $count);
1522
1523     my $obdo;
1524     $obdo->{id} = $id;
1525
1526     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1527     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1528                  pack("p LL LL", $buf, $count, $offset);
1529
1530     if (! defined $::dev_obd) {
1531         print "No current device.\n";
1532         return -1;
1533     }
1534     my $rc = ioctl($::dev_obd, &OBD_IOC_READ2, $packed);
1535
1536     $retval = unpack("l", $packed);
1537
1538     if (!defined $rc) {
1539         print STDERR "ioctl failed: $!\n";
1540         return -1;
1541     } elsif ($rc eq "0 but true") {
1542         if ($retval >= 0) {
1543                 print substr($buf, 0, $retval);
1544                 print "\nRead $retval of an attempted $count bytes.\n";
1545                 print "Finished (success)\n";
1546                 return 0;
1547          } else {
1548                 print "Finished (error $retval)\n";
1549                 return $retval;
1550         }
1551     } else {
1552         print "ioctl returned error code $rc.\n";
1553         return -1;
1554     }
1555 }
1556
1557 sub Write {
1558     if (!defined($::client_id)) {
1559         print "You must first ``connect''.\n";
1560         return -1;
1561     }
1562
1563     my $id = shift;
1564     my $offset = shift;
1565     my $text = join(' ', @_);
1566     my $count = length($text);
1567
1568     if (!defined($id) || scalar($id) < 1 || !defined($offset) ||
1569         scalar($offset) < 0) {
1570         print "invalid arguments; type \"help write\" for a synopsis\n";
1571         return -1;
1572     }
1573
1574     if (!defined($text)) {
1575         $text = "";
1576         $count = 0;
1577     }
1578
1579     print("Writing $count bytes starting at byte $offset to object $id...\n");
1580
1581     my $obdo;
1582     $obdo->{id} = $id;
1583
1584     # the perl we're using doesn't support pack type Q
1585     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1586                  pack("p LL LL", $text, $count, $offset);
1587
1588     if (! defined $::dev_obd) {
1589         print "No current device.\n";
1590         return -1;
1591     }
1592     my $rc = ioctl($::dev_obd, &OBD_IOC_WRITE, $packed);
1593
1594     $retval = unpack("l", $packed);
1595
1596     if (!defined $rc) {
1597         print STDERR "ioctl failed: $!\n";
1598         return -1;
1599     } elsif ($rc eq "0 but true") {
1600         if ($retval >= 0) {
1601                 print "\nWrote $retval of an attempted $count bytes.\n";
1602                 print "Finished (success)\n";
1603                 return 0;
1604         } else {
1605                 print "Finished (error $retval)\n";
1606                 return $retval;
1607         }
1608     } else {
1609         print "ioctl returned error code $rc.\n";
1610         return -1;
1611     }
1612 }
1613
1614 sub Punch {
1615     if (!defined($::client_id)) {
1616         print "You must first ``connect''.\n";
1617         return -1;
1618     }
1619
1620     my $id = shift;
1621     my $start = shift;
1622     my $count = shift;
1623
1624     if (!defined($id) || scalar($id) < 1 || !defined($start) ||
1625         scalar($start) < 0 || !defined($count) || scalar($count) < 0) {
1626         print "invalid arguments; type \"help punch\" for a synopsis\n";
1627         return -1;
1628     }
1629
1630     print("Punching $count bytes starting at byte $start from object $id...\n");
1631
1632     my $obdo;
1633     $obdo->{id} = $id;
1634
1635     # the perl we're using doesn't support pack type Q
1636     my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
1637                  pack("p LL LL", $buf, $start, $count);
1638
1639     if (! defined $::dev_obd) {
1640         print "No current device.\n";
1641         return -1;
1642     }
1643     my $rc = ioctl($::dev_obd, &OBD_IOC_PUNCH, $packed);
1644
1645     $retval = unpack("l", $packed);
1646
1647     if (!defined $rc) {
1648         print STDERR "ioctl failed: $!\n";
1649     } elsif ($rc eq "0 but true") {
1650         if ($retval >= 0) {
1651                 print "\nPunched $retval of an attempted $count bytes.\n";
1652                 print "Finished (success)\n";
1653                 return 0;
1654         } else {
1655                 print "Finished (error $retval)\n";
1656                 return $retval;
1657         }
1658     } else {
1659         print "ioctl returned error code $rc.\n";
1660         return -1;
1661     }
1662 }
1663
1664 sub Preallocate {
1665     my $num = shift;
1666
1667     if (!defined($::client_id)) {
1668         print "You must first ``connect''.\n";
1669         return -1;
1670     }
1671
1672     if (!defined($num) || scalar($num) < 1 || scalar($num) > 32) {
1673         $num = 32;
1674     }
1675
1676     print "Preallocating $num objects...\n";
1677     # client id, alloc, id[32]
1678     my $packed = pack("LLx128", $::client_id, $num);
1679
1680     if (! defined $::dev_obd) {
1681         print "No current device.\n";
1682         return -1;
1683     }
1684     my $rc = ioctl($::dev_obd, &OBD_IOC_PREALLOCATE, $packed);
1685
1686     if (!defined $rc) {
1687         print STDERR "ioctl failed: $!\n";
1688         return -1;
1689     } elsif ($rc eq "0 but true") {
1690         my $alloc = unpack("x4L", $packed);
1691         my @ids = unpack("x8L32", $packed);
1692         my $i;
1693
1694         print "Got $alloc objects: ";
1695         foreach $i (@ids) {
1696             print $i . " ";
1697         }
1698         print "\nFinished (success)\n";
1699         return 0;
1700     } else {
1701         print "ioctl returned error code $rc.\n";
1702         return -1;
1703     }
1704 }
1705
1706 sub Decusecount {
1707     if (! defined $::dev_obd) {
1708         print "No current device.\n";
1709         return -1;
1710     }
1711     my $rc = ioctl($::dev_obd, &OBD_IOC_DEC_USE_COUNT, 0);
1712
1713     if (!defined $rc) {
1714         print STDERR "ioctl failed: $!\n";
1715         return -1;
1716     } elsif ($rc eq "0 but true") {
1717         print "Finished (success)\n";
1718         return 0;
1719     } else {
1720         print "ioctl returned error code $rc.\n";
1721         return -1;
1722     }
1723 }
1724
1725 sub Statfs {
1726     if (!defined($::client_id)) {
1727         print "You must first ``connect''.\n";
1728         return -1;
1729     }
1730
1731     # struct statfs {
1732     #         long f_type;
1733     #         long f_bsize;
1734     #         long f_blocks;
1735     #         long f_bfree;
1736     #         long f_bavail;
1737     #         long f_files;
1738     #         long f_ffree;
1739     #         __kernel_fsid_t f_fsid; (64 bits)
1740     #         long f_namelen;
1741     #         long f_spare[6];
1742     # };
1743
1744     my $packed = pack("LLLLLLLIILL6", $::client_id, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1745                       0, 0, 0, 0, 0, 0);
1746
1747     if (! defined $::dev_obd) {
1748         print "No current device.\n";
1749         return -1;
1750     }
1751     my $rc = ioctl($::dev_obd, &OBD_IOC_STATFS, $packed);
1752
1753     if (!defined $rc) {
1754         print STDERR "ioctl failed: $!\n";
1755         return -1;
1756     } elsif ($rc eq "0 but true") {
1757         # skip both the conn_id and the fs_type in the buffer
1758         my ($bsize, $blocks, $bfree, $bavail, $files, $ffree) =
1759             unpack("x4x4LLLLLL", $packed);
1760         print("$bsize byte blocks: $blocks, " . ($blocks - $bfree) . " used, " .
1761               "$bfree free ($bavail available).\n");
1762         print "$files files, " . ($files - $ffree) . " used, $ffree free.\n";
1763         print "Finished (success)\n";
1764         return 0;
1765     } else {
1766         print "ioctl returned error code $rc.\n";
1767         return -1;
1768     }
1769 }
1770
1771 sub Help {
1772     my $cmd = shift;
1773
1774     if ( !$cmd || !$commands{$cmd} ) {
1775         print "Comands: ", join( ' ', @jcm_cmd_list), "\n";
1776     } else {
1777         print "Usage: " .  $commands{$cmd}->{doc} . "\n";
1778     }
1779     return 0;
1780 }
1781
1782 sub Quit {
1783     if ($::client_id) {
1784         print "Disconnecting active session ($::client_id)...";
1785         Disconnect($::client_id);
1786     }
1787     exit;
1788 }