lustre/obdclass/obdcontrol

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