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