Blob Blame History Raw
#! @PERL@
# Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
# Copyright (c) 2013-2016 Carbonite, Inc.  All Rights Reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
#
# Contact information: Carbonite Inc., 756 N Pastoria Ave
# Sunnyvale, CA 94086, USA, or: http://www.zmanda.com

use strict;
use Data::Dumper;
use File::Path;

# this script is always run as path/to/script -f <statefile> <commands>, and
# mutates its statefile while giving expected output to the caller.

# the statefile is input via "eval", and re-written via Data::Dumper.  It is a
# hashref with, at a minimum, 'config'.  This, in turn, is a hashref with keys
#  - 'num_drives' -- number of drives
#  - 'first_drive' -- first data transfer element number
#  - 'num_slots' -- number of data storage slots
#  - 'first_slot' -- first data storage element number
#  - 'num_ie' -- number of import/export slots
#  - 'first_ie' -- first i/e slot number
#  - 'barcodes' -- does the changer have a barcode reader
#  - 'track_orig' -- does the changer track orig_slot? (-1 = "guess" like IBM 3573-TL)
#  - 'loaded_slots' -- hash: { slot : barcode }
#  - 'vtape_root' -- root directory for vfs devices

# the 'state' key is for internal use only, and has keys:
#  - 'slots' -- hash: { slot => barcode }
#  - 'drives' -- hash: { slot => [ barcode, orig_slot ] }
#	    (if orig_slot is -1, prints "Unkown")

# if 'vtape_root' is specified, it should be an empty directory in which this
# script will create a 'driveN' subdirectory for each drive and a 'slotN'
# subdirectory for each loaded slot.  All loaded vtapes will be "blank".

my $STATE;
my $CONFIG;
my $S;

my $statefile = $ENV{'CHANGER'};
if ($ARGV[0] eq '-f') {
    $statefile = $ARGV[1];
    shift @ARGV;
    shift @ARGV;
}

sub load_statefile {
    die("'$statefile' doesn't exist") unless (-f $statefile);

    open(my $fh, "<", $statefile);
    my $state = do { local $/; <$fh> };
    eval $state;
    die $@ if $@;
    close $fh;

    die("no state") unless defined($STATE);

    die("no config") unless defined($STATE->{'config'});
    $CONFIG = $STATE->{'config'};

    if (!defined($STATE->{'state'})) {
	$S = $STATE->{'state'} = {};
	$S->{'slots'} = { %{$CONFIG->{'loaded_slots'}} };
	$S->{'drives'} = {};
	setup_vtape_root($CONFIG->{'vtape_root'}) if $CONFIG->{'vtape_root'};
    } else {
	$S = $STATE->{'state'};
    }

    # make sure some things are zero if they're not defined
    for my $k (qw(num_drives num_slots num_ie first_drive first_slot first_ie)) {
	$CONFIG->{$k} = 0 unless defined $CONFIG->{$k};
    }
}

sub write_statefile {
    open(my $fh, ">", $statefile);
    print $fh (Data::Dumper->Dump([$STATE], ["STATE"]));
    close($fh);
}

sub setup_vtape_root {
    my ($vtape_root) = @_;

    # just mkdir slotN/data for each *loaded* slot; these become the "volumes"
    # that we subsequently shuffle around
    for my $slot (keys %{$CONFIG->{'loaded_slots'}}) {
	mkpath("$vtape_root/slot$slot/data");
    }
}

sub lowest_unoccupied_slot {
    my @except = @_;

    for (my $i = 0; $i < $CONFIG->{'num_slots'}; $i++) {
	my $sl = $i + $CONFIG->{'first_slot'};
	if (!defined $S->{'slots'}->{$sl}) {
	    return $sl
		unless grep { "$_" eq "$sl" } @except;
	}
    }

    return undef;
}

sub inquiry {
    # some random data
    print <<EOF
Product Type: Medium Changer
Vendor ID: 'COMPAQ  '
Product ID: 'SSL2000 Series  '
Revision: '0416'
Attached Changer: No
EOF
}

sub status {
    printf "  Storage Changer $statefile:%s Drives, %s Slots ( %s Import/Export )\n",
	$CONFIG->{'num_drives'},
	$CONFIG->{'num_slots'} + $CONFIG->{'num_ie'},
	$CONFIG->{'num_ie'};

    # this is more complicated than you'd think!

    my @made_up_orig_slots;
    for (my $i = 0; $i < $CONFIG->{'num_drives'}; $i++) {
	my $sl = $i + $CONFIG->{'first_drive'};
	my $contents = $S->{'drives'}->{$sl};
	if (defined $contents) {
	    my ($barcode, $orig_slot) = @$contents;
	    $barcode = ($CONFIG->{'barcodes'})? ":VolumeTag=$barcode" : "";
	    # if keeping track of orig_slot ...
	    if ($CONFIG->{'track_orig'}) {
		# implement "guessing"
		if ($CONFIG->{'track_orig'} == -1) {
		    $orig_slot = lowest_unoccupied_slot(@made_up_orig_slots);
		    if (defined $orig_slot) {
			push @made_up_orig_slots, $orig_slot;
		    }
		}

		if (!defined $orig_slot) {
		    $orig_slot = "";
		} elsif ($orig_slot eq -1) {
		    $orig_slot = "(Unknown Storage Element Loaded)";
		} else {
		    $orig_slot = "(Storage Element $orig_slot Loaded)";
		}
	    } else {
		$orig_slot = "";
	    }
	    my $sp = ($barcode or $orig_slot)? " " : "";
	    $contents = "Full$sp$orig_slot$barcode";
	} else {
	    $contents = "Empty";
	}
	print "Data Transfer Element $sl:$contents\n",
    }

    # determine range of slots to print info about
    my $start_sl = $CONFIG->{'first_slot'};
    $start_sl = $CONFIG->{'first_ie'}
	if ($CONFIG->{'num_ie'} and $CONFIG->{'first_ie'} < $start_sl);

    my $stop_sl = $CONFIG->{'first_slot'} + $CONFIG->{'num_slots'};
    $stop_sl = $CONFIG->{'first_ie'} + $CONFIG->{'num_ie'}
	if ($CONFIG->{'first_ie'} + $CONFIG->{'num_ie'} > $stop_sl);

    # print the i/e and storage slots in the right order
    for (my $sl = $start_sl; $sl < $stop_sl; $sl++) {
	my $barcode = $S->{'slots'}->{$sl};
	my $contents = defined($barcode)? "Full" : "Empty";
	if (defined $barcode and $CONFIG->{'barcodes'}) {
	    $contents .= " :VolumeTag=$barcode";
	}
	my $ie = "";
	if ($sl >= $CONFIG->{'first_ie'} and $sl - $CONFIG->{'first_ie'} < $CONFIG->{'num_ie'}) {
	    $ie = " IMPORT/EXPORT";
	}
	print "      Storage Element $sl$ie:$contents\n",
    }
}

sub load {
    my ($src, $dst) = @_;

    # check for a full drive
    if (defined $S->{'drives'}->{$dst}) {
	my ($barcode, $orig_slot) = @{$S->{'drives'}->{$dst}};
	print STDERR "Drive $dst Full";
	if (defined $orig_slot and $CONFIG->{'track_orig'}) {
	    if ($CONFIG->{'track_orig'} == -1) {
		$orig_slot = lowest_unoccupied_slot();
	    }
	    print STDERR " (Storage Element $orig_slot Loaded)";
	}
	print STDERR "\n";
	exit 1;
    }

    # check for an empty slot
    if (!defined $S->{'slots'}->{$src}) {
	print STDERR "source Element Address $src is Empty\n";
	exit 1;
    }

    # ok, good to go
    $S->{'drives'}->{$dst} = [ $S->{'slots'}->{$src}, $src ];
    $S->{'slots'}->{$src} = undef;

    if (my $vr = $CONFIG->{'vtape_root'}) {
	rename("$vr/slot$src", "$vr/drive$dst") or die("renaming slot to drive: $!");
    }
}

sub unload {
    my ($dst, $src) = @_;

    # check for a full slot
    if (defined $S->{'slots'}->{$dst}) {
	print STDERR "Storage Element $dst is Already Full\n";
	exit 1;
    }

    # check for an empty drive
    if (!defined $S->{'drives'}->{$src}) {
	# this is the Linux mtx's output...
	print STDERR "Unloading Data Transfer Element into Storage Element $dst..." .
		"source Element Address 225 is Empty\n";
	exit 1;
    }


    # ok, good to go
    $S->{'slots'}->{$dst} = $S->{'drives'}->{$src}->[0];
    $S->{'drives'}->{$src} = undef;

    if (my $vr = $CONFIG->{'vtape_root'}) {
	rename("$vr/drive$src", "$vr/slot$dst") or die("renaming drive to slot: $!");
    }
}

sub transfer {
    my ($src, $dst) = @_;

    # check for an empty slot
    if (!defined $S->{'slots'}->{$src}) {
	print STDERR "source Element Address $src is Empty\n";
	exit 1;
    }

    # check for a full slot
    if (defined $S->{'slots'}->{$dst}) {
	print STDERR "destination Element Address $dst is Already Full\n";
	exit 1;
    }

    # ok, good to go
    $S->{'slots'}->{$dst} = $S->{'slots'}->{$src};
    $S->{'slots'}->{$src} = undef;

    if (my $vr = $CONFIG->{'vtape_root'}) {
	rename("$vr/slot$src", "$vr/slot$dst") or die("renaming slot to slot: $!");
    }
}

load_statefile();
my $op = $ARGV[0];

# override the config when given 'nobarcode'
if ($op eq 'nobarcode') {
    $CONFIG->{'barcodes'} = 0;
    shift @ARGV;
    $op = $ARGV[0];
}

if ($op eq 'inquiry') {
    inquiry();
} elsif ($op eq 'status') {
    status();
} elsif ($op eq 'load') {
    load($ARGV[1], $ARGV[2]);
} elsif ($op eq 'unload') {
    unload($ARGV[1], $ARGV[2]);
} elsif ($op eq 'transfer') {
    transfer($ARGV[1], $ARGV[2]);
} else {
    if (defined $op) {
	die "Unknown operation: $op";
    } else {
	die "No operation given";
    }
}
write_statefile();