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