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

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