1#! @PERL@ 2# Copyright (c) 2009-2013 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 21use strict; 22use Data::Dumper; 23use 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 50my $STATE; 51my $CONFIG; 52my $S; 53 54my $statefile = $ENV{'CHANGER'}; 55if ($ARGV[0] eq '-f') { 56 $statefile = $ARGV[1]; 57 shift @ARGV; 58 shift @ARGV; 59} 60 61sub 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 90sub write_statefile { 91 open(my $fh, ">", $statefile); 92 print $fh (Data::Dumper->Dump([$STATE], ["STATE"])); 93 close($fh); 94} 95 96sub 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 106sub 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 120sub inquiry { 121 # some random data 122 print <<EOF 123Product Type: Medium Changer 124Vendor ID: 'COMPAQ ' 125Product ID: 'SSL2000 Series ' 126Revision: '0416' 127Attached Changer: No 128EOF 129} 130 131sub 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 198sub 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 230sub 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 257sub 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 281load_statefile(); 282my $op = $ARGV[0]; 283 284# override the config when given 'nobarcode' 285if ($op eq 'nobarcode') { 286 $CONFIG->{'barcodes'} = 0; 287 shift @ARGV; 288 $op = $ARGV[0]; 289} 290 291if ($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} 308write_statefile(); 309