+++ /dev/null
-#!/usr/bin/perl
-
-#
-# This code is issued under the GNU General Public License.
-# See the file COPYING in this distribution
-#
-# Copyright (C) 1998, Stelias Computing
-#
-# Modified for InterMezzo from Gordian's HSM bcache device/jcm module
-# Copyright (C) 1999, Carnegie Mellon University
-#
-# Derived from InterMezzo's incontrol, modified for OBD's
-# Copyright (C) 1999, Stelias Computing
-#
-#
-
-#use strict;
-BEGIN { require "asm/errno.ph" };
-BEGIN { require "asm/ioctl.ph" };
-
-# p2ph generated invalid macros for ioctl stuff, so I override some of it here
-eval 'sub OBD_IOC_CREATE () { &_IOC(2, ord(\'f\'), 3, 4);}' unless
- defined(&OBD_IOC_CREATE);
-eval 'sub OBD_IOC_SETUP () { &_IOC(1, ord(\'f\'), 4, 4);}' unless
- defined(&OBD_IOC_SETUP);
-eval 'sub OBD_IOC_CLEANUP () { &_IOC(0, ord(\'f\'), 5, 0);}' unless
- defined(&OBD_IOC_CLEANUP);
-eval 'sub OBD_IOC_DESTROY () { &_IOC(1, ord(\'f\'), 6, 4);}' unless
- defined(&OBD_IOC_DESTROY);
-eval 'sub OBD_IOC_PREALLOCATE () { &_IOC(3, ord(\'f\'), 7, 4);}' unless
- defined(&OBD_IOC_PREALLOCATE);
-# FIXME: obsolete?
-eval 'sub OBD_IOC_DEC_USE_COUNT () { &_IOC(0, ord(\'f\'), 8, 0);}' unless
- defined(&OBD_IOC_DEC_USE_COUNT);
-eval 'sub OBD_IOC_SETATTR () { &_IOC(1, ord(\'f\'), 9, 4);}' unless
- defined(&OBD_IOC_SETATTR);
-eval 'sub OBD_IOC_GETATTR () { &_IOC(2, ord(\'f\'), 10, 4);}' unless
- defined(&OBD_IOC_GETATTR);
-eval 'sub OBD_IOC_READ () { &_IOC(3, ord(\'f\'), 11, 4);}' unless
- defined(&OBD_IOC_READ);
-eval 'sub OBD_IOC_WRITE () { &_IOC(3, ord(\'f\'), 12, 4);}' unless
- defined(&OBD_IOC_WRITE);
-eval 'sub OBD_IOC_CONNECT () { &_IOC(2, ord(\'f\'), 13, 4);}' unless
- defined(&OBD_IOC_CONNECT);
-eval 'sub OBD_IOC_DISCONNECT () { &_IOC(1, ord(\'f\'), 14, 4);}' unless
- defined(&OBD_IOC_DISCONNECT);
-eval 'sub OBD_IOC_STATFS () { &_IOC(3, ord(\'f\'), 15, 4);}' unless
- defined(&OBD_IOC_STATFS);
-eval 'sub OBD_IOC_SYNC () { &_IOC(2, ord(\'f\'), 16, 4);}' unless
- defined(&OBD_IOC_SYNC);
-# FIXME: obsolete?
-eval 'sub OBD_IOC_READ2 () { &_IOC(3, ord(\'f\'), 17, 4);}' unless
- defined(&OBD_IOC_READ2);
-# FIXME: obsolete?
-eval 'sub OBD_IOC_FORMATOBD () { &_IOC(3, ord(\'f\'), 18, 4);}' unless
- defined(&OBD_IOC_FORMATOBD);
-# FIXME: obsolete?
-eval 'sub OBD_IOC_PARTITION () { &_IOC(3, ord(\'f\'), 19, 4);}' unless
- defined(&OBD_IOC_PARTITION);
-eval 'sub OBD_IOC_ATTACH () { &_IOC(3, ord(\'f\'), 20, 4);}' unless
- defined(&OBD_IOC_ATTACH);
-eval 'sub OBD_IOC_DETACH () { &_IOC(3, ord(\'f\'), 21, 4);}' unless
- defined(&OBD_IOC_DETACH);
-eval 'sub OBD_IOC_COPY () { &_IOC(3, ord(\'f\'), 22, 4);}' unless
- defined(&OBD_IOC_COPY);
-eval 'sub OBD_IOC_MIGR () { &_IOC(3, ord(\'f\'), 23, 4);}' unless
- defined(&OBD_IOC_MIGR);
-eval 'sub OBD_IOC_PUNCH () { &_IOC(3, ord(\'f\'), 24, 4);}' unless
- defined(&OBD_IOC_PUNCH);
-eval 'sub OBD_SNAP_SETTABLE () { &_IOC(3, ord(\'f\'), 40, 4);}' unless
- defined(&OBD_SNAP_SETTABLE);
-eval 'sub OBD_SNAP_PRINTTABLE () { &_IOC(3, ord(\'f\'), 41, 4);}' unless
- defined(&OBD_SNAP_PRINTTABLE);
-eval 'sub OBD_SNAP_DELETE() { &_IOC(3, ord(\'f\'), 42, 4);}' unless
- defined(&OBD_SNAP_DELETE);
-eval 'sub OBD_SNAP_RESTORE() { &_IOC(3, ord(\'f\'), 43, 4);}' unless
- defined(&OBD_SNAP_RESTORE);
-
-eval 'sub OBD_EXT2_RUNIT () { &_IOC(3, ord(\'f\'), 61, 4);}' unless
- defined(&OBD_EXT2_RUNIT);
-
-eval 'sub OBD_MD_FLALL () {~0;}' unless defined(&OBD_MD_FLALL);
-eval 'sub OBD_MD_FLATIME () {1<<1;}' unless defined(&OBD_MD_FLATIME);
-eval 'sub OBD_MD_FLMTIME () {1<<2;}' unless defined(&OBD_MD_FLMTIME);
-eval 'sub OBD_MD_FLCTIME () {1<<3;}' unless defined(&OBD_MD_FLCTIME);
-eval 'sub OBD_MD_FLSIZE () {1<<4;}' unless defined(&OBD_MD_FLSIZE);
-eval 'sub OBD_MD_FLMODE () {1<<7;}' unless defined(&OBD_MD_FLMODE);
-eval 'sub OBD_MD_FLUID () {1<<8;}' unless defined(&OBD_MD_FLUID);
-eval 'sub OBD_MD_FLGID () {1<<9;}' unless defined(&OBD_MD_FLGID);
-
-use Getopt::Long;
-use File::stat;
-use Storable;
-use Carp;
-use Term::ReadLine;
-use IO::Handle;
-use Pack;
-
-
-# NOTE long long are layed out in ia32 memory as follows:
-# u = 0xaaaabbbbccccdddd has ccccdddd at &u and aaaabbbb 4 bytes on
-# this may be different on other architectures
-
-# we use 32-bit integers for all 64-bit quantities in this program
-# #define OBD_INLINESZ 60
-# #define OBD_OBDMDSZ 60
-# /* Note: 64-bit types are 64-bit aligned in structure */
-# struct obdo {
-# obd_id o_id;
-# obd_gr o_gr;
-# obd_time o_atime;
-# obd_time o_mtime;
-# obd_time o_ctime;
-# obd_size o_size;
-# obd_blocks o_blocks;
-# obd_blksize o_blksize;
-# obd_mode o_mode;
-# obd_uid o_uid;
-# obd_gid o_gid;
-# obd_flag o_flags;
-# obd_flag o_obdflags;
-# obd_count o_nlink;
-# obd_count o_generation;
-# obd_flag o_valid; /* hot fields in this obdo */
-# char o_inline[60];
-# char o_obdmd[60];
-# struct list_head o_list;
-# struct obd_ops *o_op;
-# };
-
-sub obdo_pack {
- my $obdo = shift;
- pack "LL LL LL LL LL LL LL L L L L L L L L L a60 a60 L L L",
- $obdo->{id}, 0,
- $obdo->{gr}, 0,
- $obdo->{atime}, 0,
- $obdo->{mtime}, 0 ,
- $obdo->{ctime}, 0,
- $obdo->{size}, 0,
- $obdo->{blocks}, 0,
- $obdo->{blksize},
- $obdo->{mode},
- $obdo->{uid},
- $obdo->{gid},
- $obdo->{flags},
- $obdo->{obdflags},
- $obdo->{nlink},
- $obdo->{generation},
- $obdo->{valid},
- $obdo->{inline},
- $obdo->{obdmd},
- 0, 0, # struct list_head
- 0; # struct obd_ops
-}
-
-sub obdo_unpack {
- my $buf = shift;
- my $offset = shift;
- my $obdo;
- ($obdo->{id},
- $obdo->{gr},
- $obdo->{atime},
- $obdo->{mtime},
- $obdo->{ctime},
- $obdo->{size},
- $obdo->{blocks},
- $obdo->{blksize},
- $obdo->{mode},
- $obdo->{uid},
- $obdo->{gid},
- $obdo->{flags},
- $obdo->{obdflags},
- $obdo->{nlink},
- $obdo->{generation},
- $obdo->{valid},
- $obdo->{inline},
- $obdo->{obdmd}) = unpack "x${offset}Lx4 Lx4 Lx4 Lx4 Lx4 Lx4 Lx4 L L L L L L L L L a60 a60", $buf;
- $obdo;
-}
-
-sub obdo_print {
-
- my $obdo = shift;
-
- printf "id: %d\ngrp: %d\natime: %s\nmtime: %s\nctime: %s\nsize: %d\nblocks: %d\nblksize: %d\nmode: %o\nuid: %d\ngid: %d\nflags: %x\nobdflags: %x\nnlink: %d\nvalid: %x\ninline: %s\nobdmd: %s\n",
- $obdo->{id},
- $obdo->{gr},
- $obdo->{atime},
- $obdo->{mtime},
- $obdo->{ctime},
- $obdo->{size},
- $obdo->{blocks},
- $obdo->{blksize},
- $obdo->{mode},
- $obdo->{uid},
- $obdo->{gid},
- $obdo->{flags},
- $obdo->{obdflags},
- $obdo->{nlink},
- $obdo->{valid},
- $obdo->{inline},
- $obdo->{obdmd};
-}
-
-
-my ($file);
-
-GetOptions("f!" => \$file, "device=s" => \$::device, ) || die "Getoptions";
-
-
-# get a console for the app
-
-my $line;
-my $command;
-my $arg;
-
-my @procsysobd_objects = ('debug', 'index', 'reset', 'trace', 'vars');
-
-my %commands =
- ('status' => {func => "Status", doc => "status: show obd device status"},
- 'procsys' => {func => "Procsys", doc => "procsys <file> <value> (set /proc/sys/obd configuration)"},
- 'shell' => {func => "Shell", doc => "shell <shell-command>: execute shell-commands"},
- 'script' => {func => "Script", doc => "script <filename>: read and execute commands from a file"},
- 'insmod' => {func => "Insmod", doc => "insmod <module>: insert kernel module"},
- 'rmmod' => {func => "Rmmod", doc => "rmmod <module>: insert kernel module"},
- 'lsmod' => {func => "Lsmod", doc => "lsmod <module>: list kernel modules"},
- 'device' => {func => "Device", doc => "device <dev>: open another OBD device"},
- 'close' => {func => "Close", doc => "close <dev>: close OBD device"},
- 'create' => {func => "Create", doc => "create [<num> [<mode> [quiet]]]: create new object(s) (files, unless mode is given)"},
- 'attach' => {func => "Attach", doc => "attach { obdext2 | obdsnap snapdev snapidx tableno | obdscsi adapter bus tid lun }: attach this minor device to the specified driver" },
- 'detach' => {func => "Detach", doc => "detach this minor device"},
- 'testext2iterator' => {func => "TestExt2Iterator", doc => "test ext2 iterator function"},
- 'snapset' => {func => "SnapSetTable", doc => "snapset <tableno> <file>: set the table (created with snaptable) as table #tableno" },
- 'snapprint' => {func => "SnapPrint", doc => "snapprint <tableno>: output the contents of table #tableno to the syslog"},
- 'snapdelete' => {func => "SnapDelete", doc => "snapdelete: delete connected snap obd objects from disk"},
- 'snaprestore' => {func => "SnapRestore", doc => "snaprestore : restore connected old snap objects to be current"},
- 'snaptable' => {func => "SnapShotTable", doc => "snaptable: build a snapshot table (interactive)"},
- 'copy' => {func => "Copy", doc => "copy <srcid> <tgtid>: copy objects"},
- 'migrate' => {func => "Migrate", doc => "migrate <srcid> <tgtid>: migrate data from one object to another"},
-# FIXME: obsolete?
- 'partition' => {func => "Partition", doc => "partition <type> <adapter> <bus> <tid> <lun> <partition> <size>: create a partition"},
-# FIXME: obsolete?
- 'format' => {func => "Format", doc => "format <type> <adapter> <bus> <tid> <lun> <size>: format a partition"},
- 'setup' => {func => "Setup", doc => "setup [type]: link this OBD device to the underlying device (default type obdext2)"},
- 'connect' => {func => "Connect", doc => "connect: allocates client ID for this session"},
- 'disconnect' => {func => "Disconnect", doc => "disconnect [id]: frees client resources"},
- 'sync' => {func => "Sync", doc => "sync: flushes buffers to disk"},
- 'destroy' => {func => "Destroy", doc => "destroy <id>: destroys an object"},
- 'cleanup' => {func => "Cleanup", doc => "cleanup the minor obd device"},
-# FIXME: obsolete?
- 'dec_use_count' => {func => "Decusecount", doc => "decreases the module use count so that the module can be removed following an oops"},
- 'read' => {func => "Read", doc => "read <id> <count> [offset]: read data from object"},
-# FIXME: obsolete?
- 'fsread' => {func => "Read2", doc => "read <id> <count> [offset]: read data from object"},
- 'write' => {func => "Write", doc => "write <id> <offset> <text>: write data to object"},
- 'punch' => {func => "Punch", doc => "punch <id> <start> <count>: punch a hole in object"},
- 'setattr' => {func => "Setattr", doc => "setattr <id> [mode [uid [gid [size [atime [mtime [ctime]]]]]]]: sets object attributes"},
- 'getattr' => {func => "Getattr", doc => "getattr <id>: displays object attributes"},
- 'preallocate' => {func => "Preallocate", doc => "preallocate [num]: requests preallocation of num objects."},
- 'statfs' => {func => "Statfs", doc => "statfs: filesystem status information"},
- 'help' => {func => \&Help, doc => "help: this message"},
- 'quit' => {func => \&Quit, doc => "see \"exit\""},
- 'exit' => {func => \&Quit, doc => "see \"quit\""}
- );
-
-#
-# setup completion function
-#
-my @jcm_cmd_list = keys %commands;
-
-my $term, $attribs;
-
-
-# Get going....
-
-Device($::device);
-
-sub readl {
- if ( $file ) {
- my $str = <STDIN>;
- chop($str);
- return $str;
- } else {
- return $term->readline(@_);
- }
-}
-
-
-
-if ( $file ) {
- while ( <STDIN> ) {
- print $_;
- my $rc = execute_line($_);
- if ($rc != 0) { last; }
- }
- exit 0;
-} else {
- $term = new Term::ReadLine 'obdcontrol ';
- $attribs = $term->Attribs;
- $attribs->{attempted_completion_function} = \&completeme;
- $term->ornaments('md,me,,'); # bold face prompt
-
- # make sure stdout is not buffered
- STDOUT->autoflush(1);
-
-
- # Get on with the show
- process_line();
-}
-
-#------------------------------------------------------------------------------
-sub completeme {
- my ($text, $line, $start, $end) = @_;
- if (substr($line, 0, $start) =~ /^\s*$/) {
- if ($] < 5.6) { # PErl version is less than 5.6.0
- return (exists $commands{$text}) ? $text : 0;
-#Above line doesn't perform command completion, but
-#perl5.005 Term-ReadLine lacks support for completion matching
-#and perl5.6.0 requires glibc2.2.2 that won't run under Redhat6.2......sigh.
- }
- else {
- $attribs->{completion_word} = \@jcm_cmd_list;
- return $term->completion_matches($text,
- $attribs->{'list_completion_function'});
- }
- }
-}
-
-sub find_command {
- my $given = shift;
- my $name;
- my @completions = completeme($given, $given, 0, length($given));
- if ($#completions == 0) {
- $name = shift @completions;
- }
-
- return $name;
-}
-
-# start making requests
-sub process_line {
- foo:
- $line = $term->readline("obdcontrol > ");
- execute_line($line);
- goto foo;
-}
-
-sub execute_line {
- my $line = shift;
-
- my @cmdline = split(' ', $line);
- my $word = shift @cmdline;
-
- return 0 unless ($word);
-
- my $cmd;
- if ( $file ) {
- $cmd = $word;
- } else {
- $cmd = find_command($word);
- }
- unless ($cmd) {
- printf STDERR "$word: No such command, or not unique.\n";
- return (-1);
- }
-
- # Call the function.
- return (&{$commands{$cmd}->{func}}(@cmdline));
-}
-
-my %opendevfds = ();
-
-# select the OBD device we talk to
-sub Device {
- my $device = shift;
-
- if ( ! $device && ! $::device ) { # first time ever
- $device = '/dev/obd0';
- }
-
- if (($device) && ($::device ne $device)) {
- local *NEW_OBD;
- my $newfd;
-
- if ($::client_id) {
- print "Disconnecting active session ($::client_id)...";
- Disconnect($::client_id);
- }
-
- if ($opendevfds{$device}) {
- $::dev_obd = $opendevfds{$device};
- }
- else {
- # Open the device, as we need an FD for the ioctl
- if (!sysopen(NEW_OBD, $device, 0)) {
- print "Cannot open $device. Did you insert the obdclass module ?\n";
- return -1;
- }
- print "Opened device $device\n";
- $opendevfds{$device} = *NEW_OBD;
- $::dev_obd = *NEW_OBD;
- }
- $::device = $device;
- }
- print "Current device is $::device\n";
- return 0;
-}
-
-sub Close {
- my $device = shift;
- my $fd2close;
-
- if ( ! $device && ! $::device ) { # first time ever
- print "Nothing to close\n";
- return -1;
- }
-
- if ( ! $device ) {
- $device = $::device;
- }
-
- if ($::device eq $device) {
- if ($::client_id) {
- print "Disconnecting active session ($::client_id)...";
- Disconnect($::client_id);
- }
- }
-
- $fd2close = $opendevfds{$device};
- if ($fd2close) { # XXXX something wrong in this if statement
- close ($fd2close);
- $opendevfds{$device} = undef;
- print "Closed device $device\n";
- }
- else {
- print "Device $device was not open\n";
- return -1;
- }
-
- if ($::device eq $device) {
- $::dev_obd = undef;
- $::device = undef;
- }
- print "No current device. You just closed the current device ($device).\n";
- return 0;
-}
-
-sub Script {
- my $cmdfilename = shift;
- my $rc = 0;
- if ( ! $cmdfilename ) {
- print "please specify a command file name\n";
- return -1;
- }
- if (! open(CMDF, $cmdfilename)) {
- print "Cannot open $cmdfilename: $!\n";
- return -1;
- }
- while (<CMDF>) {
- if (/^#/) {
- next;
- }
- print "execute> $_";
- $rc = execute_line($_);
- if ($rc != 0) {
- print "Something went wrong .......command exit status: $rc\n";
- last;
- }
- }
- close(CMDF);
- return $rc;
-}
-
-sub Shell {
- my $user_shell=$ENV{'SHELL'};
- print "% $user_shell -c '@_'\n";
- if ( ! @_ ) {
- print "please specify a shell command\n";
- return;
- }
- system("$user_shell -c '@_'");
- return ($? >> 8);
-}
-
-sub Status {
- my $oldfh = select(STDOUT);
- $| = 1;
-
- system('cat /proc/lustre/obd/*/status');
- my $rc = ($? >> 8);
-
- select($oldfh);
- $| = 0;
-
- return $rc;
-}
-
-sub Procsys {
- my $set_sysobd = shift;
- my $value = shift;
-
- foreach $i (0 .. $#procsysobd_objects) {
- my $sysobd = $procsysobd_objects[$i];
-
- if (defined $set_sysobd) {
- if ($sysobd ne $set_sysobd) { next; }
-
- if (defined $value) { # set this one
- system("echo \"$value\" > /proc/sys/obd/$sysobd");
- }
- system("echo \"/proc/sys/obd/$sysobd:\"; cat /proc/sys/obd/$sysobd");
- last;
- }
- else {
- system("echo \"/proc/sys/obd/$sysobd:\"; cat /proc/sys/obd/$sysobd");
- }
- }
- return ($? >> 8);
-}
-
-sub Insmod {
- my $module = shift;
- system("insmod $module");
- return ($? >> 8);
-}
-
-sub Rmmod {
- my $module = shift;
- system("rmmod $module");
- return ($? >> 8);
-}
-
-sub Lsmod {
- my $module = shift;
- system("lsmod $module");
- return ($? >> 8);
-}
-
-sub Attach {
- my $err = 0;
- my $type = shift;
- my $data;
- my $datalen = 0;
-
- if ( ! $type ) {
- print "error: missing type\n";
-usage:
- print "usage: attach {obdext2 | obdsnap | obdscsi | obdtrace }\n";
- return -1;
- }
-
- if ($type eq "obdscsi" ) {
- my $adapter = shift;
- my $bus = shift;
- my $tid = shift;
- my $lun = shift;
-
- $data = pack("iiii", $adapter, $bus, $tid, $lun);
- $datalen = 4 * 4;
- } elsif ($type eq "obdsnap" ) {
- my $snapdev = shift;
- my $snapidx = shift;
- my $tableno = shift;
-
- $data = pack("iii", $snapdev, $snapidx, $tableno);
- $datalen = 3 * 4;
- } elsif ($type eq "obdext2") {
- $data = pack("i", 4711); # bogus data
- $datalen = 4;
- } elsif ($type eq "obdtrace") {
- $data = pack("i", 4711); # bogus data
- $datalen = 4;
- } else {
- print "error: unknown attach type $type\n";
- goto usage;
- }
-
- my $len = length($type);
- my $cl = length($data);
-
- print "type $type (len $len), datalen $datalen ($cl)\n";
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_ATTACH, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub Detach {
- my $err = 0;
- my $data = "";
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_IOC_DETACH, $data);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub TestExt2Iterator {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return;
- }
-
- my $err = 0;
- my $type = "obdext2";
-
- $data = pack("i", 4711); # bogus data
- $datalen = 4;
-
- my $len = length($type);
- my $cl = length($data);
- print "type $type (len $len), datalen $datalen ($cl)\n";
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_EXT2_RUNIT, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub SnapDelete {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $err = 0;
- my $type = "obdsnap";
-
- $data = pack("i", 4711); # bogus data
- $datalen = 4;
-
- my $len = length($type);
- my $cl = length($data);
- print "type $type (len $len), datalen $datalen ($cl)\n";
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
-
- # XXX We need to fix this up so that after the objects in this snapshot
- # are deleted, the snapshot itself is also removed from the table.
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_SNAP_DELETE, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-# this routine does the whole job
-sub SnapRestore {
- my $restoreto = shift;
- my $snaptable = shift;
- my $tableno = shift;
- my $restoretime;
-
- # don't do anything until connected
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- if ( ! $snaptable || ! defined $restoreto ) {
- print "Usage: snaprestore \"restore to slot\" \"snaptable\" \"tableno\"\n";
- return -1;
- }
-
- if ( ! -f $snaptable ) {
- print "Table $snaptable doesn't exist\n";
- return -1;
- }
-
- my $table = ReadSnapShotTable($snaptable);
- $restoretime = FindSnapInTable($table, $restoreto);
- if ( ! defined $table->{0} || ! defined $restoretime ) {
- PrintSnapShotTable($table);
- print "No current or $restoreto slot in this table\n";
- return -1;
- }
-
- my $currentindex = $table->{0};
- if ( $table->{$restoretime} == $currentindex ) {
- print "You should not restore to the current snapshot\n";
- return -1;
- }
-
- # swap the entries for 0 and $restoreto
- my $tmp = $table->{$restoretime};
- $table->{$restoretime} = $table->{0};
- $table->{0} = $tmp;
- # PrintSnapShotTable($table);
-
- # write it back
- WriteSnapShotTable($snaptable, $table);
-
- # set it in the kernel
- SnapSetTable($tableno, $snaptable);
-
- # ready for the ioctl
- my $err = 0;
- my $type = "obdsnap";
- $data = pack("i", $currentindex); # slot of previous current snapshot
- $datalen = 4;
-
- my $len = length($type);
- my $cl = length($data);
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_SNAP_RESTORE, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Snaprestore finished (success)\n";
- delete $table->{$restoretime} if defined $restoretime;
- # write it back
- WriteSnapShotTable($snaptable, $table);
-
- # set it in the kernel
- SnapSetTable($tableno, $snaptable);
- # PrintSnapShotTable($table);
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub FindSnapInTable {
- my $table = shift;
- my $snapno =shift;
-
- foreach my $restoretime ( keys %{$table} ) {
- if ( $table->{$restoretime} == $snapno) {
- print "Found key $restoretime for snapno $snapno\n";
- return $restoretime;
- }
- }
- undef;
-}
-
-
-sub SnapPrint {
- my $err = 0;
- my $type = "obdsnap";
- my $snaptableno = shift;
-
- $data = pack("i", $snaptableno);
- $datalen = 4;
-
- my $len = length($type);
- my $cl = length($data);
- print "type $type (len $len), datalen $datalen ($cl)\n";
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_SNAP_PRINTTABLE, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub SnapSetTable {
- my $err = 0;
- my $type = "obdsnap";
- my $snaptableno = shift;
- my $file = shift;
- my $snapcount;
- my $table = {};
- my $data;
- my $datalen = 0;
-
- if ( ! -f $file ) {
- print "No such file $file\n";
- return -1;
- }
-
- $table = ReadSnapShotTable($file);
-
- $snapcount = keys %{$table};
- print "Snapcount $snapcount\n";
-
- if ( ! defined $table->{0} ) {
- print "No current snapshot in table! First make one\n";
- return -1;
- }
- $data = pack("ii", $snaptableno, $snapcount);
- $datalen = 2 * 4;
- foreach my $time (sort keys %{$table}) {
- # XXX we should change to pack LL instead of I for times
- $data .= pack("Ii", $time, $table->{$time});
- $datalen += 8;
- }
-
- my $len = length($type);
- my $cl = length($data);
- print "type $type (len $len), datalen $datalen ($cl)\n";
- my $packed = pack("Lipip", $::client_id, length($type), $type, $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_SNAP_SETTABLE, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub SnapShotTable {
-
- my $file = &readl("enter file name: ");
- if ( ! -f $file ) {
- `touch $file`;
- }
- my $table = ReadSnapShotTable($file);
-
- again:
- PrintSnapShotTable($table);
- my $action = &readl("Add, Delete or Quit [adq]: ");
- goto done if ($action =~ "^q.*" );
- goto add if ($action =~ "^a.*");
- goto del if ($action =~ "^d.*");
- goto again;
-
- add:
- my $idx = &readl("enter index where you want this snapshot: ");
- my $time = &readl("enter time or 'now' or 'current': ");
- my $oldtime = SnapFindTimeFromIdx($idx, $table);
- if (defined $oldtime) {
- print "This already exists, first clean up\n";
- goto again;
- }
-
- if ( $time eq 'now' ) {
- $time = time;
- } elsif ( $time eq 'current' ) {
- $time = 0;
- }
- $table->{$time} = $idx;
- goto again;
-
- del:
- $didx = &readl("Enter index to delete: ");
- my $deltime = SnapFindTimeFromIdx($didx, $table);
- delete $table->{$deltime} if defined $deltime;
- goto again;
-
- done:
- my $ok = &readl("OK with new table? [Yn]: ");
- unless ( $ok eq "n" ) {
- WriteSnapShotTable($file, $table);
- }
- return 0;
-}
-
-sub SnapFindTimeFromIdx {
- my $idx = shift;
- my $table = shift;
-
- foreach my $time ( keys %{$table} ) {
- if ( $table->{$time} == $idx ) {
- return $time;
- }
- }
- undef;
-}
-
-sub PrintSnapShotTable {
- my $table = shift;
- my $time;
-
- foreach $time ( sort keys %{$table} ) {
- my $stime = localtime($time);
- if ( ! $time ) {
- $stime = "current";
- }
- printf "Time: %s -- Index %d\n", $stime, $table->{$time};
- }
-}
-
-sub ReadSnapShotTable {
-
- my $file = shift;
- my $table = {};
-
- open FH, "<$file";
- while ( <FH> ) {
- my ($time, $index) = split ;
- $table->{$time} = $index;
- }
- close FH;
-
- PrintSnapShotTable($table);
-
- return $table;
-}
-
-sub WriteSnapShotTable {
- my $file = shift;
- my $table = shift;
-
- open FH, ">$file";
- foreach my $time ( sort keys %{$table} ) {
- print FH "$time $table->{$time}\n";
- }
- close FH;
-}
-
-sub Copy {
- my $err = 0;
- my $src_obdo;
- my $dst_obdo;
-
- # Note: _copy IOCTL takes parameters as dst, src.
- # Copy function takes parameters as src, dst.
- $src_obdo->{id} = shift;
- $dst_obdo->{id} = shift;
- $src_obdo->{valid} = &OBD_MD_FLALL;
-
- # XXX need to fix copy so we can have 2 client IDs here
- my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_IOC_COPY, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Migrate {
- my $err = 0;
-
- # Note: _migr IOCTL takes parameters as dst, src.
- # Migrate function takes parameters as src, dst.
- $src_obdo->{id} = shift;
- $dst_obdo->{id} = shift;
- $src_obdo->{valid} = &OBD_MD_FLALL;
-
- # We pack a dummy connection ID here
- my $packed = pack("L", $::client_id) . obdo_pack($dst_obdo) . pack("L", $::client_id) . obdo_pack($src_obdo);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
-
- my $rc = ioctl($::dev_obd, &OBD_IOC_MIGR, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub Format {
- my $err = 0;
- my $size = shift;
- my $data = pack("i", $size);
- my $datalen = 4;
-
- my $packed = pack("ip", $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_FORMATOBD, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Partition {
- my $err = 0;
- my $partno = shift;
- my $size = shift;
- my $data = pack("ii", $partno, $size);
- my $datalen = 2 * 4;
-
- my $packed = pack("ip", $datalen, $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_PARTITION, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Setup {
- my $err = 0;
- my $arg = shift;
- my $data;
- my $datalen = 0;
-
- # XXX we need a getinfo ioctl to validate parameters
- # by type here
-
- if ($arg && !defined($::st = stat($arg))) {
- print "$arg is not a valid device\n";
- return -1;
- }
-
- printf "setting up %s, device %x\n", $arg, $::st->rdev();
- if ( $arg ) {
- $data = $arg;
- $datalen = length($arg)+1; # need null character also
- }
-
- my $packed = pack("iip", $datalen, $::st->rdev(), $data);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_SETUP, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Cleanup {
- my $err = "0";
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_CLEANUP, $err);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- $::client_id = 0;
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-
-sub Connect {
- my $rc;
-
- my $packed = "";
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- $rc = ioctl($::dev_obd, &OBD_IOC_CONNECT, $packed);
- $id = unpack("I", $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- $::client_id = $id;
- print "Client ID : $id\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Disconnect {
- my $id = shift;
-
- if (!defined($id)) {
- $id = $::client_id;
- }
-
- if (!defined($id)) {
- print "syntax: disconnect [client ID]\n";
- print "When client ID is not given, the last valid client ID to be returned by a\n";
- print "connect command this session is used; there is no such ID.\n";
- return -1;
- }
-
- my $packed = pack("L", $id);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_DISCONNECT, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- $::client_id = undef;
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Create {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $num = shift;
- my $mode = shift;
- my $quiet = shift;
- my $rc;
- my $prealloc = 0;
-
- if (!defined($num)) {
- $num = 1;
- }
-
- if (!defined($mode)) {
- $mode = 0100644; # create a file (rw-r--r--) if not specified
- }
-
- if (scalar($num) < 1 || defined($quiet) && $quiet ne "quiet") {
- print "usage: create [<number of objects> [<mode> [quiet]]]\n";
- return -1;
- }
-
- my $i;
- my $id = 0; # can't currently request IDs
-
- print "Creating " . scalar($num) . " object";
- if (scalar($num) > 1) {
- print "s";
- }
- print "\n";
-
- for ($i = 0; $i < scalar($num); $i++) {
- my $obdo;
- $obdo->{id} = $id;
- $obdo->{mode} = scalar($mode);
- $obdo->{valid} = &OBD_MD_FLMODE;
-
- my $packed = pack("I", $::client_id) . obdo_pack($obdo);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- $rc = ioctl($::dev_obd, &OBD_IOC_CREATE, $packed);
- if ($rc ne "0 but true") {
- last;
- } elsif (!defined($quiet)) {
- $obdo = obdo_unpack($packed, 4);
- print "Created object #$obdo->{id}.\n";
- }
- }
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Sync {
- my $err = "0";
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_SYNC, $err);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Destroy {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
-
- if (!defined($id) || scalar($id) < 1) {
- print "usage: destroy <object number>\n";
- return -1;
- }
-
- print "Destroying object $id...\n";
- my $packed = pack("IL", $::client_id, $id);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_DESTROY, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Getattr {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
-
- if (!defined($id) || scalar($id) < 1) {
- print "invalid arguments; type \"help getattr\" for a synopsis\n";
- return -1;
- }
-
- # see Setattr
- my $obdo;
- $obdo->{id} = $id;
- $obdo->{valid} = &OBD_MD_FLALL;
- my $packed = pack("L", $::client_id) . obdo_pack($obdo);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_GETATTR, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- $obdo = obdo_unpack($packed, 4);
- obdo_print($obdo);
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Setattr {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
-
- if (!defined($id) || scalar($id) < 1) {
- print "invalid arguments; type \"help setattr\" for a synopsis\n";
- return -1;
- }
-
- # XXX we do not currently set all of the fields in the obdo
- my $obdo;
- $obdo->{id} = $id;
- $obdo->{mode} = oct(shift);
- $obdo->{uid} = shift;
- $obdo->{gid} = shift;
- $obdo->{size} = shift;
- $obdo->{atime} = shift;
- $obdo->{mtime} = shift;
- $obdo->{ctime} = shift;
- $obdo->{valid} = 0;
-
- if (defined($obdo->{atime})) {
- $obdo->{valid} |= &OBD_MD_FLATIME;
- }
- if (defined($obdo->{mtime})) {
- $obdo->{valid} |= &OBD_MD_FLMTIME;
- }
- if (defined($obdo->{ctime})) {
- $obdo->{valid} |= &OBD_MD_FLCTIME;
- }
- if (defined($obdo->{size})) {
- $obdo->{valid} |= &OBD_MD_FLSIZE;
- }
- if (defined($obdo->{mode})) {
- $obdo->{valid} |= &OBD_MD_FLMODE;
- }
- if (defined($obdo->{uid})) {
- $obdo->{valid} |= &OBD_MD_FLUID;
- }
- if (defined($obdo->{gid})) {
- $obdo->{valid} |= &OBD_MD_FLGID;
- }
-
- printf "valid is %x, mode is %o\n", $obdo->{valid}, $obdo->{mode};
- my $packed = pack("L", $::client_id) . obdo_pack($obdo);
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_SETATTR, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Read {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
- my $count = shift;
- my $offset = shift;
-
- if (!defined($id) || scalar($id) < 1 || !defined($count) ||
- $count < 1 || (defined($offset) && $offset < 0)) {
- print "invalid arguments; type \"help read\" for a synopsis\n";
- return -1;
- }
-
- if (!defined($offset)) {
- $offset = 0;
- }
-
- print("Reading $count bytes starting at byte $offset from object " .
- "$id...\n");
-
- # "allocate" a large enough buffer
- my $buf = sprintf("%${count}s", " ");
- die "suck" if (length($buf) != $count);
-
- my $obdo;
- $obdo->{id} = $id;
-
- # the perl we're using doesn't support pack type Q, and offset is 64 bits
- my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
- pack("p LL LL", $buf, $count, $offset);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_READ, $packed);
-
- $retval = unpack("l", $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- if ($retval >= 0) {
- print substr($buf, 0, $retval);
- print "\nRead $retval of an attempted $count bytes.\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "Finished (error $retval)\n";
- return $retval;
- }
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Read2 {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
- my $count = shift;
- my $offset = shift;
-
- if (!defined($id) || scalar($id) < 1 || !defined($count) ||
- $count < 1 || (defined($offset) && $offset < 0)) {
- print "invalid arguments; type \"help read\" for a synopsis\n";
- return -1;
- }
-
- if (!defined($offset)) {
- $offset = 0;
- }
-
- print("Reading $count bytes starting at byte $offset from object " .
- "$id...\n");
-
- # "allocate" a large enough buffer
- my $buf = sprintf("%${count}s", " ");
- die "suck" if (length($buf) != $count);
-
- my $obdo;
- $obdo->{id} = $id;
-
- # the perl we're using doesn't support pack type Q, and offset is 64 bits
- my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
- pack("p LL LL", $buf, $count, $offset);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_READ2, $packed);
-
- $retval = unpack("l", $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- if ($retval >= 0) {
- print substr($buf, 0, $retval);
- print "\nRead $retval of an attempted $count bytes.\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "Finished (error $retval)\n";
- return $retval;
- }
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Write {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
- my $offset = shift;
- my $text = join(' ', @_);
- my $count = length($text);
-
- if (!defined($id) || scalar($id) < 1 || !defined($offset) ||
- scalar($offset) < 0) {
- print "invalid arguments; type \"help write\" for a synopsis\n";
- return -1;
- }
-
- if (!defined($text)) {
- $text = "";
- $count = 0;
- }
-
- print("Writing $count bytes starting at byte $offset to object $id...\n");
-
- my $obdo;
- $obdo->{id} = $id;
-
- # the perl we're using doesn't support pack type Q
- my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
- pack("p LL LL", $text, $count, $offset);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_WRITE, $packed);
-
- $retval = unpack("l", $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- if ($retval >= 0) {
- print "\nWrote $retval of an attempted $count bytes.\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "Finished (error $retval)\n";
- return $retval;
- }
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Punch {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- my $id = shift;
- my $start = shift;
- my $count = shift;
-
- if (!defined($id) || scalar($id) < 1 || !defined($start) ||
- scalar($start) < 0 || !defined($count) || scalar($count) < 0) {
- print "invalid arguments; type \"help punch\" for a synopsis\n";
- return -1;
- }
-
- print("Punching $count bytes starting at byte $start from object $id...\n");
-
- my $obdo;
- $obdo->{id} = $id;
-
- # the perl we're using doesn't support pack type Q
- my $packed = pack("L", $::client_id) . obdo_pack($obdo) .
- pack("p LL LL", $buf, $start, $count);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_PUNCH, $packed);
-
- $retval = unpack("l", $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- } elsif ($rc eq "0 but true") {
- if ($retval >= 0) {
- print "\nPunched $retval of an attempted $count bytes.\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "Finished (error $retval)\n";
- return $retval;
- }
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Preallocate {
- my $num = shift;
-
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- if (!defined($num) || scalar($num) < 1 || scalar($num) > 32) {
- $num = 32;
- }
-
- print "Preallocating $num objects...\n";
- # client id, alloc, id[32]
- my $packed = pack("LLx128", $::client_id, $num);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_PREALLOCATE, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- my $alloc = unpack("x4L", $packed);
- my @ids = unpack("x8L32", $packed);
- my $i;
-
- print "Got $alloc objects: ";
- foreach $i (@ids) {
- print $i . " ";
- }
- print "\nFinished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Decusecount {
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_DEC_USE_COUNT, 0);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Statfs {
- if (!defined($::client_id)) {
- print "You must first ``connect''.\n";
- return -1;
- }
-
- # struct statfs {
- # long f_type;
- # long f_bsize;
- # long f_blocks;
- # long f_bfree;
- # long f_bavail;
- # long f_files;
- # long f_ffree;
- # __kernel_fsid_t f_fsid; (64 bits)
- # long f_namelen;
- # long f_spare[6];
- # };
-
- my $packed = pack("LLLLLLLIILL6", $::client_id, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0);
-
- if (! defined $::dev_obd) {
- print "No current device.\n";
- return -1;
- }
- my $rc = ioctl($::dev_obd, &OBD_IOC_STATFS, $packed);
-
- if (!defined $rc) {
- print STDERR "ioctl failed: $!\n";
- return -1;
- } elsif ($rc eq "0 but true") {
- # skip both the conn_id and the fs_type in the buffer
- my ($bsize, $blocks, $bfree, $bavail, $files, $ffree) =
- unpack("x4x4LLLLLL", $packed);
- print("$bsize byte blocks: $blocks, " . ($blocks - $bfree) . " used, " .
- "$bfree free ($bavail available).\n");
- print "$files files, " . ($files - $ffree) . " used, $ffree free.\n";
- print "Finished (success)\n";
- return 0;
- } else {
- print "ioctl returned error code $rc.\n";
- return -1;
- }
-}
-
-sub Help {
- my $cmd = shift;
-
- if ( !$cmd || !$commands{$cmd} ) {
- print "Comands: ", join( ' ', @jcm_cmd_list), "\n";
- } else {
- print "Usage: " . $commands{$cmd}->{doc} . "\n";
- }
- return 0;
-}
-
-sub Quit {
- if ($::client_id) {
- print "Disconnecting active session ($::client_id)...";
- Disconnect($::client_id);
- }
- exit;
-}