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