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