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 $tgtid = shift;
 652     my $data = pack("III", $::client_id, $srcid, $tgtid);
 653     my $datalen = 12;
 654
 655     my $packed = pack("ip", $datalen, $data);
 656     my $rc = ioctl(DEV_OBD, &OBD_IOC_COPY, $packed);
 657
 658     if (!defined $rc) {
 659         print STDERR "ioctl failed: $!\n";
 660     } elsif ($rc eq "0 but true") {
 661         print "Finished (success)\n";
 662     } else {
 663         print "ioctl returned error code $rc.\n";
 664     }
 665 }
 666
 667 sub Migrate {
 668     my $err = 0;
 669     my $srcid = shift;
 670     my $tgtid = shift;
 671     my $data = pack("III", $::client_id, $srcid, $tgtid);
 672     my $datalen = 12;
 673
 674     my $packed = pack("ip", $datalen, $data);
 675     my $rc = ioctl(DEV_OBD, &OBD_IOC_MIGR, $packed);
 676
 677     if (!defined $rc) {
 678         print STDERR "ioctl failed: $!\n";
 679     } elsif ($rc eq "0 but true") {
 680         print "Finished (success)\n";
 681     } else {
 682         print "ioctl returned error code $rc.\n";
 683     }
 684 }
 685
 686
 687 sub Format {
 688     my $err = 0;
 689     my $size = shift;
 690     my $data = pack("i", $size);
 691     my $datalen = 4;
 692
 693     my $packed = pack("ip", $datalen, $data);
 694     my $rc = ioctl(DEV_OBD, &OBD_IOC_FORMATOBD, $packed);
 695
 696     if (!defined $rc) {
 697         print STDERR "ioctl failed: $!\n";
 698     } elsif ($rc eq "0 but true") {
 699         print "Finished (success)\n";
 700     } else {
 701         print "ioctl returned error code $rc.\n";
 702     }
 703 }
 704
 705 sub Partition {
 706     my $err = 0;
 707     my $partno = shift;
 708     my $size = shift;
 709     my $data = pack("ii", $partno, $size);
 710     my $datalen = 2 * 4;
 711
 712     my $packed = pack("ip", $datalen, $data);
 713     my $rc = ioctl(DEV_OBD, &OBD_IOC_PARTITION, $packed);
 714
 715     if (!defined $rc) {
 716         print STDERR "ioctl failed: $!\n";
 717     } elsif ($rc eq "0 but true") {
 718         print "Finished (success)\n";
 719     } else {
 720         print "ioctl returned error code $rc.\n";
 721     }
 722 }
 723
 724 sub Setup {
 725     my $err = 0;
 726     my $arg = shift;
 727     my $data;
 728     my $datalen = 0;
 729
 730     # XXX we need a getinfo ioctl to validate parameters
 731     # by type here
 732
 733     if ($arg  && !defined($::st = stat($arg))) {
 734             print "$arg is not a valid device\n";
 735             return;
 736     }
 737
 738     if ( $arg ) {
 739         $dev = $::st->rdev() unless $dev;
 740         $data = pack("i", $dev);
 741         $datalen = 4;
 742     }
 743
 744     my $packed = pack("ip", $datalen, $data);
 745     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETUP, $packed);
 746
 747     if (!defined $rc) {
 748         print STDERR "ioctl failed: $!\n";
 749     } elsif ($rc eq "0 but true") {
 750         print "Finished (success)\n";
 751     } else {
 752         print "ioctl returned error code $rc.\n";
 753     }
 754 }
 755
 756 sub Cleanup {
 757     my $err = "0";
 758     my $rc = ioctl(DEV_OBD, &OBD_IOC_CLEANUP, $err);
 759
 760     if (!defined $rc) {
 761         print STDERR "ioctl failed: $!\n";
 762     } elsif ($rc eq "0 but true") {
 763         print "Finished (success)\n";
 764         $::client_id = 0;
 765     } else {
 766         print "ioctl returned error code $rc.\n";
 767     }
 768 }
 769
 770
 771 sub Connect {
 772     my $rc;
 773
 774     my $packed = "";
 775     $rc = ioctl(DEV_OBD, &OBD_IOC_CONNECT, $packed);
 776     $id = unpack("I", $packed);
 777
 778     if (!defined $rc) {
 779         print STDERR "ioctl failed: $!\n";
 780     } elsif ($rc eq "0 but true") {
 781         $::client_id = $id;
 782         print "Client ID     : $id\n";
 783         print "Finished (success)\n";
 784     } else {
 785         print "ioctl returned error code $rc.\n";
 786     }
 787 }
 788
 789 sub Disconnect {
 790     my $id = shift;
 791
 792     if (!defined($id)) {
 793         $id = $::client_id;
 794     }
 795
 796     if (!defined($id)) {
 797         print "syntax: disconnect [client ID]\n";
 798         print "When client ID is not given, the last valid client ID to be returned by a\n";
 799         print "connect command this session is used; there is no such ID.\n";
 800         return;
 801     }
 802
 803     my $packed = pack("L", $id);
 804     my $rc = ioctl(DEV_OBD, &OBD_IOC_DISCONNECT, $packed);
 805
 806     if (!defined $rc) {
 807         print STDERR "ioctl failed: $!\n";
 808     } elsif ($rc eq "0 but true") {
 809         $::client_id = undef;
 810         print "Finished (success)\n";
 811     } else {
 812         print "ioctl returned error code $rc.\n";
 813     }
 814 }
 815
 816 sub Create {
 817     my $arg = shift;
 818     my $quiet = shift;
 819     my $rc;
 820     my $prealloc = 0;
 821
 822     if (defined($quiet) && $quiet ne "quiet") {
 823         print "syntax: create [number of objects [quiet]]\n";
 824         return;
 825     }
 826
 827     my $packed = pack("IL", $::client_id, $prealloc);
 828     if (!defined($arg) || scalar($arg) < 2) {
 829         print "Creating 1 object...\n";
 830         $rc = ioctl(DEV_OBD, &OBD_IOC_CREATE, $packed);
 831         if (!defined($quiet)) {
 832             my $ino = unpack("L", $packed);
 833             print "Created object #$ino.\n";
 834         }
 835     } else {
 836         my $i;
 837
 838         print "Creating " . scalar($arg) . " objects...\n";
 839         for ($i = 0; $i < scalar($arg); $i++) {
 840             $rc = ioctl(DEV_OBD, &OBD_IOC_CREATE, $packed);
 841             my $ino = unpack("L", $packed);
 842             if ($rc ne "0 but true") {
 843                 last;
 844                 $packed = pack("IL", $::client_id, $prealloc);
 845             } elsif (!defined($quiet)) {
 846                 $packed = pack("IL", $::client_id, $prealloc);
 847                 print "Created object #$ino.\n";
 848             }
 849         }
 850     }
 851
 852     if (!defined $rc) {
 853         print STDERR "ioctl failed: $!\n";
 854     } elsif ($rc eq "0 but true") {
 855         print "Finished (success)\n";
 856     } else {
 857         print "ioctl returned error code $rc.\n";
 858     }
 859 }
 860
 861 sub Sync {
 862     my $err = "0";
 863     my $rc = ioctl(DEV_OBD, &OBD_IOC_SYNC, $err);
 864
 865     if (!defined $rc) {
 866         print STDERR "ioctl failed: $!\n";
 867     } elsif ($rc eq "0 but true") {
 868         print "Finished (success)\n";
 869     } else {
 870         print "ioctl returned error code $rc.\n";
 871     }
 872 }
 873
 874 sub Destroy {
 875     if (!defined($::client_id)) {
 876         print "You must first ``connect''.\n";
 877         return;
 878     }
 879
 880     my $arg = shift;
 881
 882     if (!defined($arg) || scalar($arg) < 1) {
 883         print "destroy requires the object number to destroy.\n";
 884         return;
 885     }
 886
 887     print "Destroying object $arg...\n";
 888     my $packed = pack("IL", $::client_id, $arg);
 889     my $rc = ioctl(DEV_OBD, &OBD_IOC_DESTROY, $packed);
 890
 891     if (!defined $rc) {
 892         print STDERR "ioctl failed: $!\n";
 893     } elsif ($rc eq "0 but true") {
 894         print "Finished (success)\n";
 895     } else {
 896         print "ioctl returned error code $rc.\n";
 897     }
 898 }
 899
 900 sub Getattr {
 901     if (!defined($::client_id)) {
 902         print "You must first ``connect''.\n";
 903         return;
 904     }
 905
 906     my $inode = shift;
 907
 908     if (!defined($inode) || scalar($inode) < 1) {
 909         print "invalid arguments; type \"help getattr\" for a synopsis\n";
 910         return;
 911     }
 912
 913     # see Setattr
 914     my $packed = pack("ILsx2lLLLI", $::client_id, $inode, 0, 0, 0, 0, 0, 0, 0,
 915                       0);
 916     my $rc = ioctl(DEV_OBD, &OBD_IOC_GETATTR, $packed);
 917
 918     if (!defined $rc) {
 919         print STDERR "ioctl failed: $!\n";
 920     } elsif ($rc eq "0 but true") {
 921         my ($valid, $mode, $uid, $gid, $size, $atime, $mtime, $ctime, $flags);
 922         ($valid, $mode, $uid, $gid, $size, $atime, $mtime, $ctime, $flags) =
 923           unpack("ISssx2lLLLI", $packed);
 924
 925         printf("Inode: %d  Mode:  %o\n", $inode, $mode);
 926         printf("User: %6d   Group: %6d   Size: %d\n", $uid, $gid, $size);
 927         printf("ctime: %08lx -- %s\n", $ctime, scalar(gmtime($ctime)));
 928         printf("atime: %08lx -- %s\n", $atime, scalar(gmtime($atime)));
 929         printf("mtime: %08lx -- %s\n", $mtime, scalar(gmtime($mtime)));
 930         printf("flags: %08x\n", $flags);
 931         print "Finished (success)\n";
 932     } else {
 933         print "ioctl returned error code $rc.\n";
 934     }
 935 }
 936
 937 sub Setattr {
 938     if (!defined($::client_id)) {
 939         print "You must first ``connect''.\n";
 940         return;
 941     }
 942
 943     my $inode = shift;
 944     my $valid = 0;
 945     my $mode = oct(shift);
 946     my $uid = shift;
 947     my $gid = shift;
 948     my $size = shift;
 949     my $atime = shift;
 950     my $mtime = shift;
 951     my $ctime = shift;
 952
 953     if (defined($uid)) {
 954         $valid |= &ATTR_UID;
 955     }
 956     if (defined($gid)) {
 957         $valid |= &ATTR_GID;
 958     }
 959     if (defined($size)) {
 960         $valid |= &ATTR_SIZE;
 961     }
 962     if (defined($atime)) {
 963         $valid |= &ATTR_ATIME;
 964     }
 965     if (defined($mtime)) {
 966         $valid |= &ATTR_MTIME;
 967     }
 968     if (defined($ctime)) {
 969         $valid |= &ATTR_CTIME;
 970     }
 971     if (defined($mode)) {
 972         $valid |= &ATTR_MODE;
 973     }
 974
 975     if (!defined($inode) || scalar($inode) < 1) {
 976         print "invalid arguments; type \"help setattr\" for a synopsis\n";
 977         return;
 978     }
 979
 980     #struct iattr {
 981     #        unsigned int    ia_valid; (32)
 982     #        umode_t         ia_mode; (16)
 983     #        uid_t           ia_uid; (16)
 984     #        gid_t           ia_gid; (16)
 985     # -- 16 bit alignment here! --
 986     #        off_t           ia_size; (32)
 987     #        time_t          ia_atime; (32)
 988     #        time_t          ia_mtime; (32)
 989     #        time_t          ia_ctime; (32)
 990     #        unsigned int    ia_attr_flags; (32)
 991     #};
 992
 993     printf "valid is %x, mode is %o\n", $valid, $mode;
 994     my $packed = pack("ILLSssx2ILLLL", $::client_id, $inode, $valid, $mode,
 995                       $uid, $gid, $size, $atime, $mtime, $ctime, 0);
 996     my $rc = ioctl(DEV_OBD, &OBD_IOC_SETATTR, $packed);
 997
 998     if (!defined $rc) {
 999         print STDERR "ioctl failed: $!\n";
1000     } elsif ($rc eq "0 but true") {
1001         print "Finished (success)\n";
1002     } else {
1003         print "ioctl returned error code $rc.\n";
1004     }
1005 }
1006
1007 sub Read {
1008     if (!defined($::client_id)) {
1009         print "You must first ``connect''.\n";
1010         return;
1011     }
1012
1013     my $inode = shift;
1014     my $count = shift;
1015     my $offset = shift;
1016
1017     if (!defined($inode) || scalar($inode) < 1 || !defined($count) ||
1018         $count < 1 || (defined($offset) && $offset < 0)) {
1019         print "invalid arguments; type \"help read\" for a synopsis\n";
1020         return;
1021     }
1022
1023     if (!defined($offset)) {
1024         $offset = 0;
1025     }
1026
1027     print("Reading $count bytes starting at byte $offset from object " .
1028           "$inode...\n");
1029
1030     # "allocate" a large enough buffer
1031     my $buf = sprintf("%${count}s", " ");
1032     die "suck" if (length($buf) != $count);
1033
1034     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1035     my $packed = pack("ILpLLL", $::client_id, $inode, $buf, $count, $offset, 0);
1036
1037     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ, $packed);
1038
1039     $retval = unpack("l", $packed);
1040
1041     if (!defined $rc) {
1042         print STDERR "ioctl failed: $!\n";
1043     } elsif ($rc eq "0 but true") {
1044         if ($retval >= 0) {
1045                 print substr($buf, 0, $retval);
1046                 print "\nRead $retval of an attempted $count bytes.\n";
1047                 print "Finished (success)\n";
1048         } else {
1049                 print "Finished (error $retval)\n";
1050         }
1051     } else {
1052         print "ioctl returned error code $rc.\n";
1053     }
1054 }
1055
1056 sub Read2 {
1057     if (!defined($::client_id)) {
1058         print "You must first ``connect''.\n";
1059         return;
1060     }
1061
1062     my $inode = shift;
1063     my $count = shift;
1064     my $offset = shift;
1065
1066     if (!defined($inode) || scalar($inode) < 1 || !defined($count) ||
1067         $count < 1 || (defined($offset) && $offset < 0)) {
1068         print "invalid arguments; type \"help read\" for a synopsis\n";
1069         return;
1070     }
1071
1072     if (!defined($offset)) {
1073         $offset = 0;
1074     }
1075
1076     print("Reading $count bytes starting at byte $offset from object " .
1077           "$inode...\n");
1078
1079     # "allocate" a large enough buffer
1080     my $buf = sprintf("%${count}s", " ");
1081     die "suck" if (length($buf) != $count);
1082
1083     # the perl we're using doesn't support pack type Q, and offset is 64 bits
1084     my $packed = pack("ILpLLL", $::client_id, $inode, $buf, $count, $offset, 0);
1085
1086     my $rc = ioctl(DEV_OBD, &OBD_IOC_READ2, $packed);
1087
1088     $retval = unpack("l", $packed);
1089
1090     if (!defined $rc) {
1091         print STDERR "ioctl failed: $!\n";
1092     } elsif ($rc eq "0 but true") {
1093         if ($retval >= 0) {
1094                 print substr($buf, 0, $retval);
1095                 print "\nRead $retval of an attempted $count bytes.\n";
1096                 print "Finished (success)\n";
1097         } else {
1098                 print "Finished (error $retval)\n";
1099         }
1100     } else {
1101         print "ioctl returned error code $rc.\n";
1102     }
1103 }
1104
1105 sub Write {
1106     if (!defined($::client_id)) {
1107         print "You must first ``connect''.\n";
1108         return;
1109     }
1110
1111     my $inode = shift;
1112     my $offset = shift;
1113     my $text = join(' ', @_);
1114     my $count = length($text);
1115
1116     if (!defined($inode) || scalar($inode) < 1 || !defined($offset) ||
1117         scalar($offset) < 0) {
1118         print "invalid arguments; type \"help write\" for a synopsis\n";
1119         return;
1120     }
1121
1122     if (!defined($text)) {
1123         $text = "";
1124         $count = 0;
1125     }
1126
1127     print("Writing $count bytes starting at byte $offset to object " .
1128           "$inode...\n");
1129
1130     # the perl we're using doesn't support pack type Q
1131     my $packed = pack("ILpLLL", $::client_id, $inode, $text, $count, $offset, 0);
1132     my $rc = ioctl(DEV_OBD, &OBD_IOC_WRITE, $packed);
1133
1134     $retval = unpack("l", $packed);
1135
1136     if (!defined $rc) {
1137         print STDERR "ioctl failed: $!\n";
1138     } elsif ($rc eq "0 but true") {
1139         if ($retval >= 0) {
1140                 print "\nWrote $retval of an attempted $count bytes.\n";
1141                 print "Finished (success)\n";
1142         } else {
1143                 print "Finished (error $retval)\n";
1144         }
1145     } else {
1146         print "ioctl returned error code $rc.\n";
1147     }
1148 }
1149
1150 sub Preallocate {
1151     my $arg = shift;
1152
1153     if (!defined($::client_id)) {
1154         print "You must first ``connect''.\n";
1155         return;
1156     }
1157
1158     if (!defined($arg) || scalar($arg) < 1 || scalar($arg) > 32) {
1159         $arg = 32;
1160     }
1161
1162     print "Preallocating $arg inodes...\n";
1163     my $packed = pack("LLx128", $::client_id, $arg);
1164     # client id, alloc, inodes[32]
1165
1166     my $rc = ioctl(DEV_OBD, &OBD_IOC_PREALLOCATE, $packed);
1167
1168     if (!defined $rc) {
1169         print STDERR "ioctl failed: $!\n";
1170     } elsif ($rc eq "0 but true") {
1171         my $alloc = unpack("x4L", $packed);
1172         my @inodes = unpack("x8L32", $packed);
1173         my $i;
1174
1175         print "Got $alloc inodes: ";
1176         foreach $i (@inodes) {
1177             print $i . " ";
1178         }
1179         print "\nFinished (success)\n";
1180     } else {
1181         print "ioctl returned error code $rc.\n";
1182     }
1183 }
1184
1185 sub Decusecount {
1186     my $rc = ioctl(DEV_OBD, &OBD_IOC_DEC_USE_COUNT, 0);
1187
1188     if (!defined $rc) {
1189         print STDERR "ioctl failed: $!\n";
1190     } elsif ($rc eq "0 but true") {
1191         print "Finished (success)\n";
1192     } else {
1193         print "ioctl returned error code $rc.\n";
1194     }
1195 }
1196
1197 sub Statfs {
1198     if (!defined($::client_id)) {
1199         print "You must first ``connect''.\n";
1200         return;
1201     }
1202
1203     # struct statfs {
1204     #         long f_type;
1205     #         long f_bsize;
1206     #         long f_blocks;
1207     #         long f_bfree;
1208     #         long f_bavail;
1209     #         long f_files;
1210     #         long f_ffree;
1211     #         __kernel_fsid_t f_fsid; (64 bits)
1212     #         long f_namelen;
1213     #         long f_spare[6];
1214     # };
1215
1216     my $packed = pack("LLLLLLLIILL6", $::client_id, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1217                       0, 0, 0, 0, 0, 0);
1218
1219     my $rc = ioctl(DEV_OBD, &OBD_IOC_STATFS, $packed);
1220
1221     if (!defined $rc) {
1222         print STDERR "ioctl failed: $!\n";
1223     } elsif ($rc eq "0 but true") {
1224         # skip both the conn_id and the fs_type in the buffer
1225         my ($bsize, $blocks, $bfree, $bavail, $files, $ffree) =
1226             unpack("x4x4LLLLLL", $packed);
1227         print("$bsize byte blocks: $blocks, " . ($blocks - $bfree) . " used, " .
1228               "$bfree free ($bavail available).\n");
1229         print "$files files, " . ($files - $ffree) . " used, $ffree free.\n";
1230         print "Finished (success)\n";
1231     } else {
1232         print "ioctl returned error code $rc.\n";
1233     }
1234 }
1235
1236 sub Help {
1237     my $arg = shift;
1238
1239     if ( !$arg || !$commands{$arg} ) {
1240         print "Comands: ", join( ' ', @jcm_cmd_list), "\n";
1241     } else {
1242         print "Usage: " .  $commands{$arg}->{doc} . "\n";
1243     }
1244 }
1245
1246 sub Quit {
1247     if ($::client_id) {
1248         print "Disconnecting active session ($::client_id)...";
1249         Disconnect($::client_id);
1250     }
1251     exit;
1252 }