git.gag.com Git - debian/amanda/blob - installcheck/mock/mtx.pl

   1 #! @PERL@
   2 # Copyright (c) 2009 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License version 2 as published
   6 # by the Free Software Foundation.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 use strict;
  21 use Data::Dumper;
  22 use File::Path;
  23
  24 # this script is always run as path/to/script -f <statefile> <commands>, and
  25 # mutates its statefile while giving expected output to the caller.
  26
  27 # the statefile is input via "eval", and re-written via Data::Dumper.  It is a
  28 # hashref with, at a minimum, 'config'.  This, in turn, is a hashref with keys
  29 #  - 'num_drives' -- number of drives
  30 #  - 'first_drive' -- first data transfer element number
  31 #  - 'num_slots' -- number of data storage slots
  32 #  - 'first_slot' -- first data storage element number
  33 #  - 'num_ie' -- number of import/export slots
  34 #  - 'first_ie' -- first i/e slot number
  35 #  - 'barcodes' -- does the changer have a barcode reader
  36 #  - 'track_orig' -- does the changer track orig_slot? (-1 = "guess" like IBM 3573-TL)
  37 #  - 'loaded_slots' -- hash: { slot : barcode }
  38 #  - 'vtape_root' -- root directory for vfs devices
  39
  40 # the 'state' key is for internal use only, and has keys:
  41 #  - 'slots' -- hash: { slot => barcode }
  42 #  - 'drives' -- hash: { slot => [ barcode, orig_slot ] }
  43 #           (if orig_slot is -1, prints "Unkown")
  44
  45 # if 'vtape_root' is specified, it should be an empty directory in which this
  46 # script will create a 'driveN' subdirectory for each drive and a 'slotN'
  47 # subdirectory for each loaded slot.  All loaded vtapes will be "blank".
  48
  49 my $STATE;
  50 my $CONFIG;
  51 my $S;
  52
  53 my $statefile = $ENV{'CHANGER'};
  54 if ($ARGV[0] eq '-f') {
  55     $statefile = $ARGV[1];
  56     shift @ARGV;
  57     shift @ARGV;
  58 }
  59
  60 sub load_statefile {
  61     die("'$statefile' doesn't exist") unless (-f $statefile);
  62
  63     open(my $fh, "<", $statefile);
  64     my $state = do { local $/; <$fh> };
  65     eval $state;
  66     die $@ if $@;
  67     close $fh;
  68
  69     die("no state") unless defined($STATE);
  70
  71     die("no config") unless defined($STATE->{'config'});
  72     $CONFIG = $STATE->{'config'};
  73
  74     if (!defined($STATE->{'state'})) {
  75         $S = $STATE->{'state'} = {};
  76         $S->{'slots'} = { %{$CONFIG->{'loaded_slots'}} };
  77         $S->{'drives'} = {};
  78         setup_vtape_root($CONFIG->{'vtape_root'}) if $CONFIG->{'vtape_root'};
  79     } else {
  80         $S = $STATE->{'state'};
  81     }
  82
  83     # make sure some things are zero if they're not defined
  84     for my $k (qw(num_drives num_slots num_ie first_drive first_slot first_ie)) {
  85         $CONFIG->{$k} = 0 unless defined $CONFIG->{$k};
  86     }
  87 }
  88
  89 sub write_statefile {
  90     open(my $fh, ">", $statefile);
  91     print $fh (Data::Dumper->Dump([$STATE], ["STATE"]));
  92     close($fh);
  93 }
  94
  95 sub setup_vtape_root {
  96     my ($vtape_root) = @_;
  97
  98     # just mkdir slotN/data for each *loaded* slot; these become the "volumes"
  99     # that we subsequently shuffle around
 100     for my $slot (keys %{$CONFIG->{'loaded_slots'}}) {
 101         mkpath("$vtape_root/slot$slot/data");
 102     }
 103 }
 104
 105 sub lowest_unoccupied_slot {
 106     my @except = @_;
 107
 108     for (my $i = 0; $i < $CONFIG->{'num_slots'}; $i++) {
 109         my $sl = $i + $CONFIG->{'first_slot'};
 110         if (!defined $S->{'slots'}->{$sl}) {
 111             return $sl
 112                 unless grep { "$_" eq "$sl" } @except;
 113         }
 114     }
 115
 116     return undef;
 117 }
 118
 119 sub inquiry {
 120     # some random data
 121     print <<EOF
 122 Product Type: Medium Changer
 123 Vendor ID: 'COMPAQ  '
 124 Product ID: 'SSL2000 Series  '
 125 Revision: '0416'
 126 Attached Changer: No
 127 EOF
 128 }
 129
 130 sub status {
 131     printf "  Storage Changer $statefile:%s Drives, %s Slots ( %s Import/Export )\n",
 132         $CONFIG->{'num_drives'},
 133         $CONFIG->{'num_slots'} + $CONFIG->{'num_ie'},
 134         $CONFIG->{'num_ie'};
 135
 136     # this is more complicated than you'd think!
 137
 138     my @made_up_orig_slots;
 139     for (my $i = 0; $i < $CONFIG->{'num_drives'}; $i++) {
 140         my $sl = $i + $CONFIG->{'first_drive'};
 141         my $contents = $S->{'drives'}->{$sl};
 142         if (defined $contents) {
 143             my ($barcode, $orig_slot) = @$contents;
 144             $barcode = ($CONFIG->{'barcodes'})? ":VolumeTag=$barcode" : "";
 145             # if keeping track of orig_slot ...
 146             if ($CONFIG->{'track_orig'}) {
 147                 # implement "guessing"
 148                 if ($CONFIG->{'track_orig'} == -1) {
 149                     $orig_slot = lowest_unoccupied_slot(@made_up_orig_slots);
 150                     if (defined $orig_slot) {
 151                         push @made_up_orig_slots, $orig_slot;
 152                     }
 153                 }
 154
 155                 if (!defined $orig_slot) {
 156                     $orig_slot = "";
 157                 } elsif ($orig_slot eq -1) {
 158                     $orig_slot = "(Unknown Storage Element Loaded)";
 159                 } else {
 160                     $orig_slot = "(Storage Element $orig_slot Loaded)";
 161                 }
 162             } else {
 163                 $orig_slot = "";
 164             }
 165             my $sp = ($barcode or $orig_slot)? " " : "";
 166             $contents = "Full$sp$orig_slot$barcode";
 167         } else {
 168             $contents = "Empty";
 169         }
 170         print "Data Transfer Element $sl:$contents\n",
 171     }
 172
 173     # determine range of slots to print info about
 174     my $start_sl = $CONFIG->{'first_slot'};
 175     $start_sl = $CONFIG->{'first_ie'}
 176         if ($CONFIG->{'num_ie'} and $CONFIG->{'first_ie'} < $start_sl);
 177
 178     my $stop_sl = $CONFIG->{'first_slot'} + $CONFIG->{'num_slots'};
 179     $stop_sl = $CONFIG->{'first_ie'} + $CONFIG->{'num_ie'}
 180         if ($CONFIG->{'first_ie'} + $CONFIG->{'num_ie'} > $stop_sl);
 181
 182     # print the i/e and storage slots in the right order
 183     for (my $sl = $start_sl; $sl < $stop_sl; $sl++) {
 184         my $barcode = $S->{'slots'}->{$sl};
 185         my $contents = defined($barcode)? "Full" : "Empty";
 186         if (defined $barcode and $CONFIG->{'barcodes'}) {
 187             $contents .= " :VolumeTag=$barcode";
 188         }
 189         my $ie = "";
 190         if ($sl >= $CONFIG->{'first_ie'} and $sl - $CONFIG->{'first_ie'} < $CONFIG->{'num_ie'}) {
 191             $ie = " IMPORT/EXPORT";
 192         }
 193         print "      Storage Element $sl$ie:$contents\n",
 194     }
 195 }
 196
 197 sub load {
 198     my ($src, $dst) = @_;
 199
 200     # check for a full drive
 201     if (defined $S->{'drives'}->{$dst}) {
 202         my ($barcode, $orig_slot) = @{$S->{'drives'}->{$dst}};
 203         print STDERR "Drive $dst Full";
 204         if (defined $orig_slot and $CONFIG->{'track_orig'}) {
 205             if ($CONFIG->{'track_orig'} == -1) {
 206                 $orig_slot = lowest_unoccupied_slot();
 207             }
 208             print STDERR " (Storage Element $orig_slot Loaded)";
 209         }
 210         print STDERR "\n";
 211         exit 1;
 212     }
 213
 214     # check for an empty slot
 215     if (!defined $S->{'slots'}->{$src}) {
 216         print STDERR "source Element Address $src is Empty\n";
 217         exit 1;
 218     }
 219
 220     # ok, good to go
 221     $S->{'drives'}->{$dst} = [ $S->{'slots'}->{$src}, $src ];
 222     $S->{'slots'}->{$src} = undef;
 223
 224     if (my $vr = $CONFIG->{'vtape_root'}) {
 225         rename("$vr/slot$src", "$vr/drive$dst") or die("renaming slot to drive: $!");
 226     }
 227 }
 228
 229 sub unload {
 230     my ($dst, $src) = @_;
 231
 232     # check for a full slot
 233     if (defined $S->{'slots'}->{$dst}) {
 234         print STDERR "Storage Element $dst is Already Full\n";
 235         exit 1;
 236     }
 237
 238     # check for an empty drive
 239     if (!defined $S->{'drives'}->{$src}) {
 240         # this is the Linux mtx's output...
 241         print STDERR "Unloading Data Transfer Element into Storage Element $dst..." .
 242                 "source Element Address 225 is Empty\n";
 243         exit 1;
 244     }
 245
 246
 247     # ok, good to go
 248     $S->{'slots'}->{$dst} = $S->{'drives'}->{$src}->[0];
 249     $S->{'drives'}->{$src} = undef;
 250
 251     if (my $vr = $CONFIG->{'vtape_root'}) {
 252         rename("$vr/drive$src", "$vr/slot$dst") or die("renaming drive to slot: $!");
 253     }
 254 }
 255
 256 sub transfer {
 257     my ($src, $dst) = @_;
 258
 259     # check for an empty slot
 260     if (!defined $S->{'slots'}->{$src}) {
 261         print STDERR "source Element Address $src is Empty\n";
 262         exit 1;
 263     }
 264
 265     # check for a full slot
 266     if (defined $S->{'slots'}->{$dst}) {
 267         print STDERR "destination Element Address $dst is Already Full\n";
 268         exit 1;
 269     }
 270
 271     # ok, good to go
 272     $S->{'slots'}->{$dst} = $S->{'slots'}->{$src};
 273     $S->{'slots'}->{$src} = undef;
 274
 275     if (my $vr = $CONFIG->{'vtape_root'}) {
 276         rename("$vr/slot$src", "$vr/slot$dst") or die("renaming slot to slot: $!");
 277     }
 278 }
 279
 280 load_statefile();
 281 my $op = $ARGV[0];
 282
 283 # override the config when given 'nobarcode'
 284 if ($op eq 'nobarcode') {
 285     $CONFIG->{'barcodes'} = 0;
 286     shift @ARGV;
 287     $op = $ARGV[0];
 288 }
 289
 290 if ($op eq 'inquiry') {
 291     inquiry();
 292 } elsif ($op eq 'status') {
 293     status();
 294 } elsif ($op eq 'load') {
 295     load($ARGV[1], $ARGV[2]);
 296 } elsif ($op eq 'unload') {
 297     unload($ARGV[1], $ARGV[2]);
 298 } elsif ($op eq 'transfer') {
 299     transfer($ARGV[1], $ARGV[2]);
 300 } else {
 301     if (defined $op) {
 302         die "Unknown operation: $op";
 303     } else {
 304         die "No operation given";
 305     }
 306 }
 307 write_statefile();