X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=perl%2FAmanda%2FChanger.pm;h=a0126508a416a5d2dac86c97db3a6f4345e6c50a;hb=2627875b7d18858bc1f9f7652811e4d8c15a23eb;hp=bfad1bff77fa642ef4ab349060c4f3dfbe78bc84;hpb=fb2bd066c2f8b34addafe48d62550e3033a59431;p=debian%2Famanda diff --git a/perl/Amanda/Changer.pm b/perl/Amanda/Changer.pm index bfad1bf..a012650 100644 --- a/perl/Amanda/Changer.pm +++ b/perl/Amanda/Changer.pm @@ -1,8 +1,8 @@ -# Copyright (c) 2006 Zmanda Inc. All Rights Reserved. +# Copyright (c) 2005-2008 Zmanda 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 version 2 as published -# by the Free Software Foundation. +# This library is free software; you can redistribute it and/or modify it +# under the terms of the GNU Lesser General Public License version 2.1 as +# published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY @@ -13,25 +13,21 @@ # with this program; if not, write to the Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # -# Contact information: Zmanda Inc, 505 N Mathlida Ave, Suite 120 -# Sunnyvale, CA 94085, USA, or: http://www.zmanda.com +# Contact information: Zmanda Inc, 465 S Mathlida Ave, Suite 300 +# Sunnyvale, CA 94086, USA, or: http://www.zmanda.com package Amanda::Changer; +use strict; +use warnings; use Carp; use POSIX (); -use Exporter; -@ISA = qw( Exporter ); - -@EXPORT_OK = qw( - reset clean eject label - query loadslot find scan -); +use vars qw( @ISA ); use Amanda::Paths; use Amanda::Util; -use Amanda::Device qw( :constants ); use Amanda::Config qw( :getconf ); +use Amanda::Device qw( :constants ); =head1 NAME @@ -39,311 +35,554 @@ Amanda::Changer -- interface to changer scripts =head1 SYNOPSIS - use Amanda::Changer; + use Amanda::Changer; - my ($error, $slot) = Amanda::Changer::reset(); + my $chg = Amanda::Changer->new(); # loads the default changer; OR + $chg = Amanda::Changer->new("somechanger"); # references a defined changer in amanda.conf - my ($nslots, $curslot, $backwards, $searchable) = Amanda::Changer::query(); + $chg->load( + label => "TAPE-012", + res_cb => sub { + my ($err, $reservation) = @_; + if ($err) { + die $err->{message}; + } + $dev = Amanda::Device->new($reservation->{device_name}); + # use device.. + }); - my ($tpslot, $tpdevice) = Amanda::Changer::find("TAPE018"); - - sub slot_callback { - my ($slot, $device, $error) = @_; - if (!$error) print "Slot $slot: $device\n"; - return 0; - } - Amanda::Changer::scan(\&slot_callback); + # later.. + $reservation->release(finished_cb => $start_next_volume); =head1 API STATUS -Stable +This interface will change before the next release. + +=head1 INTERFACE + +All operations in the module return immediately, and take as an argument a +callback function which will indicate completion of the changer operation -- a +kind of continuation. The caller should run a main loop (see +L) to allow the interactions with the changer script to +continue. + +A new object is created with the C function as follows: + + my $chg = Amanda::Changer->new($changer); + +to create a named changer (a name provided by the user, either specifying a +changer directly or specifying a changer definition), or + + my $chg = Amanda::Changer->new(); + +to run the default changer. This function handles the many ways a user can +configure a changer. -=head1 FUNCTIONS +=head2 CALLBACKS -All of these functions return an array of values, beginning with -C<$error>, and containing any other results appropriate to the -operation. +A res_cb C<$cb> is called back as: -The functions C in the event of a serious error (problems -running the changer script, or an exit status of 2 or higher). -"Benign" errors, corresponding to an exit status of 1 or a slot named -"", result in the return of a single-element array containing -the error message. Error-handling for calls can be written + $cb->($error, undef); -C<$error> and C<$slot>. The first is false unless a "benign" -error, such as a positioning error, has occurred, in which case it -contains the message from the changer script, and the other results -are undefined. C<$slot> is the first word returned from the changer -script, and is usually a number, but occasionally a string such as -"". +in the event of an error, or -=over + $cb->(undef, $reservation); -=item reset +with a successful reservation. res_cb must always be specified. A finished_cb +C<$cb> is called back as - my ($error, $slot) = reset(); + $cb->($error); -Resets the tape changer, if supported, by calling +in the event of an error, or - $tpchanger -reset + $cb->(undef); -=item clean +on success. A finished_cb may be omitted if no notification of completion is +required. - my ($error, $slot) = clean(); +=head2 CURRENT SLOT -Triggers a cleaning cycle, if supported, by calling +Changers maintain a global concept of a "current" slot, for +compatibility with Amanda algorithms such as the taperscan. However, it +is not compatible with concurrent use of the same changer, and may be +inefficient for some changers, so new algorithms should avoid using it, +preferring instead to load the correct tape immediately (with C), +and to progress from tape to tape using the reservation objects' +C attribute. - $tpchanger -clean +=head2 CHANGER OBJECTS -=item eject +=head3 $chg->load(res_cb => $cb, label => $label, set_current => $sc) - my ($error, $slot) = eject(); +Load a volume with the given label. This may leverage any barcodes or other +indices that the changer has created, or may resort to a sequential scan of +media. If set_current is specified and true, then the changer's current slot +should be updated to correspond to $slot. If not, then the changer should not +update its current slot (but some changers will anyway - specifically, +chg-compat). -Ejects the tape in the current slot, if supported, by calling +Note that the changer I to load the requested volume, but it's a mean +world out there, and you may not get what you want, so check the label on the +loaded volume before getting started. - $tpchanger -eject +=head3 $chg->load(res_cb => $cb, slot => "current") -=item label +Reserve the volume in the "current" slot. This is used by the sequential +taperscan algorithm to begin its search. - my ($error) = label($label); +=head3 $chg->load(res_cb => $cb, slot => "next") -Inform the changer that the tape in the current slot is labeled C<$label>. Calls +Reserve the volume that follows the current slot. This may not be a +very efficient operation on all devices. - $tpchanger -label $label +=head3 $chg->load(res_cb => $cb, slot => $slot, set_current => $sc) -=item query +Reserve the volume in the given slot. $slot must be a string that appeared in a +reservation's 'next_slot' field at some point, or a string from the user (e.g., +an argument to amtape). + +=head3 $chg->info(info_cb => $cb, info => [ $key1, $key2, .. ]) + +Query the changer for miscellaneous information. Any number of keys may be +specified. The C is called with C<$error> as the first argument, +much like a C, but the remaining arguments form a hash giving values +for all of the requested keys that are supported by the changer. The preamble +to such a callback is usually + + info_cb => sub { + my $error = shift; + my %results = @_; + # .. + } + +Supported keys are: + +=over 2 + +=item num_slots + +The total number of slots in the changer device. If this key is not +present, then the device cannot determine its slot count (for example, +an archival device that names slots by timestamp could potentially run +until the heat-death of the universe). + +=item vendor_string + +A string describing the name and model of the changer device. + +=back - my ($error, $slot, $nslots, $backwards, $searchable) = query(); +=head3 $chg->reset(finished_cb => $cb) -Query the changer to determine the current slot (C<$slot>), the -number of slots (C<$nslots>), whether it can move backward through tapes -(C<$backwards>), and whether it is searchable (that is, has a barcode -reader; C<$searchable>). A changer which cannot move backward through -tapes is also known as a gravity feeder. +Reset the changer to a "base" state. This will generally reset the "current" +slot to something the user would think of as the "first" tape, unload any +loaded drives, etc. It is an error to call this while any reservations are +outstanding. -This function runs +=head3 $chg->clean(finished_cb => $cb, drive => $drivename) - $tpchanger -info +Clean a drive, if the changer supports it. Drivename can be an empty string for +devices with only one drive, or can be an arbitrary string from the user (e.g., +an amtape argument). Note that some changers cannot detect the completion of a +cleaning cycle; in this case, the user will just need to delay further Amanda +activities until the cleaning is complete. -=item loadslot +=head3 $chg->update(finished_cb => $cb, changed => $changed) - my ($error, $slot, $device) = loadslot($desired_slot); +The user has changed something -- loading or unloading tapes, +reconfiguring the changer, etc. -- that may have invalidated the +database. C<$changed> is a changer-specific string indicating what has +changed; if it is omitted, the changer will check everything. -Load the tape in the given slot, returning its slot and device. -C<$desired_slot> can be a numeric slot number or one of the symbolic -names defined by the changer API, e.g., "next", "current", or "first". +=head3 $chg->import(finished_cb => $cb, slots => $slots) - $tpchanger -slot $slot +The user has placed volumes in the import/export slots, and would like the +changer to place them in storage slots. This is a very changer-specific +operation, and $slots should be supplied by the user for verbatim transmission +to the changer, and may specify which import/export slots, for example, contain +the new volumes. -=item find +=head3 $chg->export(finished_cb => $cb, slot => $slot) - my ($error, $tpslot, $tpdevice) = Amanda::Changer::find($label); +=head3 $chg->export(finished_cb => $cb, label => $label) -Search the changer for a tape with the given label, returning with -C<$tpslot = ""> if the given label is not found. +Place the indicated volume (by $label, or in $slot) into an available +import/export slot. This, too, is a very changer-specific operation. -If the changer is searchable, this function calls +=head3 $chg->move(finished_cb => $cb, from_slot => $from, to_slot => $to) - $tpchanger -search $label +Move a volume between two slots in the changer. These slots are provided by the +user, and have meaning for the changer. -Otherwise it scans all slots in order, beginning with the current slot, -until it finds one with a label equal to C<$label> or exhausts all -slots. Note that it is considered a fatal error if the label is not -found. +=head2 RESERVATION OBJECTS -=item scan +=head3 $res->{'device_name'} - my ($error) = Amanda::Changer::scan(\&slot_callback); +This is the name of the device reserved by a reservation object. -Call C for all slots, beginning with the current slot, -until C returns a nonzero value or all slots are -exhausted. C gets three arguments: a slot number, a -device name for that slot, and a boolean value which is true if the -changer successfully loaded the slot. +=head3 $res->{'this_slot'} + +This is the name of this slot. It is an arbitrary string which will +have some meaning to the changer's C method. It is safe to +access this field after the reservation has been released. + +=head3 $res->{'next_slot'} + +This is the "next" slot after this one. It is safe to access this field, +too, after the reservation has been released (and, in changers with only +one "drive", this is the only way you will get to the next volume!) + +=head3 $res->release(finished_cb => $cb, eject => $eject) + +This is how an Amanda application indicates that it no longer needs the +reserved volume. The callback is called after any related operations are +complete -- possibly immediately. Some drives and changers have a notion of +"ejecting" a volume, and some don't. In particular, a manual changer can cause +the tape drive to eject the tape, while a tape robot can move a tape back to +storage, leaving the drive empty. If the eject parameter is given and true, it +indicates that Amanda is done with the volume and has reason to believe the +user is done with the volume, too -- for example, when a tape has been written +completely. + +A reservation will be released automatically when the object is destroyed, but +in this case no finished_cb is given, so the release operation may not complete +before the process exits. Wherever possible, reservations should be explicitly +released. + +=head3 $res->set_label(finished_cb => $cb, label => $label) + +This is how Amanda indicates to the changer that the volume in the device has +been (re-)labeled. Changers can keep a database of volume labels by slot or by +barcode, or just ignore this function and call $cb immediately. Note that the +reservation must still be held when this function is called. + +=head1 SEE ALSO + +See the other changer packages, including: + +=over 2 + +=item L + +=item L + +=item L =back -=cut +=head1 TODO -sub reset { - my ($error, $slot, $rest) = run_tpchanger("-reset"); - return ($error) if $error; + - support loading by barcode, showing barcodes in reservations + - support deadlock avoidance by returning more information in load errors + - Amanda::Changer::Single + +=cut - return (0, $slot); +# this is a "virtual" constructor which instantiates objects of different +# classes based on its argument. Subclasses should not try to chain up! +sub new { + shift eq 'Amanda::Changer' + or die("Do not call the Amanda::Changer constructor from subclasses"); + my ($name) = @_; + my ($uri, $cc); + + # creating a named changer is a bit easier + if (defined($name)) { + # first, is it a changer alias? + if (($uri,$cc) = _changer_alias_to_uri($name)) { + return _new_from_uri($uri, $cc, $name); + } + + # maybe a straight-up changer URI? + if (_uri_to_pkgname($name)) { + return _new_from_uri($name, undef, $name); + } + + # assume it's a device name or alias, and invoke the single-changer + return _new_from_uri("chg-single:$name", undef, $name); + } else { # !defined($name) + if (getconf_seen($CNF_TPCHANGER)) { + my $tpchanger = getconf($CNF_TPCHANGER); + + # first, is it an old changer script? + if ($uri = _old_script_to_uri($tpchanger)) { + return _new_from_uri($uri, undef, $name); + } + + # if not, then there had better be no tapdev + if (getconf_seen($CNF_TAPEDEV)) { + die "Cannot specify both 'tapedev' and 'tpchanger' unless using an old-style changer script"; + } + + # maybe a changer alias? + if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) { + return _new_from_uri($uri, $cc, $name); + } + + # maybe a straight-up changer URI? + if (_uri_to_pkgname($tpchanger)) { + return _new_from_uri($tpchanger, undef, $name); + } + + # assume it's a device name or alias, and invoke the single-changer + return _new_from_uri("chg-single:$tpchanger", undef, $name); + } elsif (getconf_seen($CNF_TAPEDEV)) { + my $tapedev = getconf($CNF_TAPEDEV); + + # first, is it a changer alias? + if (($uri,$cc) = _changer_alias_to_uri($tapedev)) { + return _new_from_uri($uri, $cc, $name); + } + + # maybe a straight-up changer URI? + if (_uri_to_pkgname($tapedev)) { + return _new_from_uri($tapedev, undef, $name); + } + + # assume it's a device name or alias, and invoke the single-changer + return _new_from_uri("chg-single:$tapedev", undef, $name); + } else { + die "Must specify one of 'tapedev' or 'tpchanger'"; + } + } } -sub clean { - my ($error, $slot, $rest) = run_tpchanger("-clean"); - return ($error) if $error; +# helper functions for new + +sub _changer_alias_to_uri { + my ($name) = @_; + + my $cc = Amanda::Config::lookup_changer_config($name); + if ($cc) { + my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER); + if (my $uri = _old_script_to_uri($tpchanger)) { + return ($uri, $cc); + } elsif (_uri_to_pkgname($tpchanger)) { + return ($tpchanger, $cc); + } else { + die "Changer '$name' specifies invalid tpchanger '$tpchanger'"; + } + } - return (0, $slot); + # not an alias + return; } -sub eject { - my ($error, $slot, $rest) = run_tpchanger("-eject"); - return ($error) if $error; +sub _old_script_to_uri { + my ($name) = @_; + + if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) { + return "chg-compat:$name" + } - return (0, $slot); + # not an old script + return; } -sub label { - my ($label) = @_; +# try to load the package for the given URI. $@ is set properly +# if this function returns a false value. +sub _uri_to_pkgname { + my ($name) = @_; - my ($error, $slot, $rest) = run_tpchanger("-label", $label); - return ($error) if $error; + my ($type) = ($name =~ /^chg-([A-Za-z_]+):/); + if (!defined $type) { + $@ = "'$name' is not a changer URI"; + return 0; + } + + $type =~ tr/A-Z-/a-z_/; + + # create a package name to see if it's already imported + my $pkgname = "Amanda::Changer::$type"; + my $filename = $pkgname; + $filename =~ s|::|/|g; + $filename .= '.pm'; + return $pkgname if (exists $INC{$filename}); + + # try loading it + eval "use $pkgname;"; + if ($@) { + my $err = $@; + + # determine whether the module doesn't exist at all, or if there was an + # error loading it; die if we found a syntax error + if (exists $INC{$filename}) { + die($err); + } - return (0); + return 0; + } + + return $pkgname; } -sub query { - my ($error, $slot, $rest) = run_tpchanger("-info"); - return ($error) if $error; +# already-instsantiated changer objects (using 'our' so that the installcheck +# and reset this list as necessary) +our %changers_by_uri_cc = (); + +sub _new_from_uri { # (note: this sub is patched by the installcheck) + my ($uri, $cc, $name) = @_; - # old, unsearchable changers don't return the third result, so it's optional in the regex - $rest =~ /(\d+) (\d+) ?(\d+)?/ or croak("Malformed response from changer -seek: $rest"); + # make up a key for our hash of already-instantiated objects, + # using a newline as a separator, since perl can't use tuples + # as keys + my $uri_cc = "$uri\n"; + if (defined $cc) { + $uri_cc = $uri_cc . changer_config_name($cc); + } + + # return a pre-existing changer, if possible - # return array: error, nslots, curslot, backwards, searchable - return (0, $slot, $1, $2, $3?1:0); + if (exists($changers_by_uri_cc{$uri_cc})) { + return $changers_by_uri_cc{$uri_cc}; + } + + # look up the type and load the class + my $pkgname = _uri_to_pkgname($uri); + if (!$pkgname) { + die $@; + } + + my $rv = $pkgname->new($cc, $uri); + die "$pkgname->new did not return an Amanda::Changer object" + unless ($rv->isa("Amanda::Changer")); + + # store this in our cache for next time + $changers_by_uri_cc{$uri_cc} = $rv; + + return $rv; } -sub loadslot { - my ($desired_slot) = @_; +# parent-class methods; mostly "unimplemented method" - my ($error, $slot, $rest) = run_tpchanger("-slot", $desired_slot); - return ($error) if $error; +sub load { + my $self = shift; + my %params = @_; - return (0, $slot, $rest); + my $class = ref($self); + $params{'res_cb'}->("$class does not support load()", undef); } -sub find { - my ($label) = @_; - - my ($error, $curslot, $nslots, $backwards, $searchable) = query(); - return ($error) if $error; - - if ($searchable) { - # search using the barcode reader, etc. - my ($error, $slot, $rest) = run_tpchanger("-search", $label); - return ($error) if $error; - return ($error, $slot, $rest); - } else { - # search manually, starting with "current" - my $slotstr = "current"; - for (my $checked = 0; $checked < $nslots; $checked++) { - my ($error, $slot, $rest) = run_tpchanger("-slot", $slotstr); - $slotstr = "next"; - - # ignore "benign" errors - next if $error; - - my $device = Amanda::Device->new($rest); - next if (!$device); - next if ($device->read_label() != $READ_LABEL_STATUS_SUCESS); - - # we found it! - if ($device->{'volume_label'} eq $label) { - return (0, $slot, $rest); - } - } +sub reset { + my $self = shift; + my %params = @_; - croak("Label $label not found in any slot"); + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support reset()"); } } -sub scan { - my ($slot_callback) = @_; +sub info { + my $self = shift; + my %params = @_; - my ($error, $curslot, $nslots, $backwards, $searchable) = query(); - return ($error) if $error; + my $class = ref($self); + if (exists $params{'info_cb'}) { + $params{'info_cb'}->("$class does not support info()"); + } +} - my $slotstr = "current"; - my $done = 0; - for (my $checked = 0; $checked < $nslots; $checked++) { - my ($error, $slot, $rest) = run_tpchanger("-slot", $slotstr); - $slotstr = "next"; +sub clean { + my $self = shift; + my %params = @_; - if ($error) { - $done = $slot_callback->(undef, undef, $error); - } else { - $done = $slot_callback->($slot, $rest, 0); - } + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support clean()"); + } +} + +sub update { + my $self = shift; + my %params = @_; - last if $done; + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support update()"); } - - return (0); } -# Internal-use function to actually invoke a changer script and parse -# its output. If the script's exit status is neither 0 nor 1, or if an error -# occurs running the script, then run_tpchanger croaks with the error message. -# -# @params @args: command-line arguments to follow the name of the changer -# @returns: array ($error, $slot, $rest), where $error is an error message if -# a benign error occurred, or 0 if no error occurred -sub run_tpchanger { - my @args = @_; - - # get the tape changer and extend it to a full path - my $tapechanger = getconf($CNF_TPCHANGER); - if ($tapechanger !~ qr(^/)) { - $tapechanger = "$amlibexecdir/$tapechanger"; +sub import { + my $self = shift; + my %params = @_; + + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support import()"); } +} - my $pid = open(my $child, "-|"); - if (!defined($pid)) { - croak("Can't fork to run changer script: $!"); +sub export { + my $self = shift; + my %params = @_; + + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support export()"); } +} - if (!$pid) { - # child - - # cd into the config dir, if one exists - # TODO: construct a "fake" config dir including any "-o" overrides - my $config_dir = Amanda::Config::get_config_dir(); - if ($config_dir) { - if (!chdir($config_dir)) { - print " Could not chdir to '$config_dir'\n"; - exit(2); - } - } +sub move { + my $self = shift; + my %params = @_; + + my $class = ref($self); + if (exists $params{'finished_cb'}) { + $params{'finished_cb'}->("$class does not support move()"); + } +} - %ENV = Amanda::Util::safe_env(); +package Amanda::Changer::Reservation; - exec { $tapechanger } $tapechanger, @args or - print " Could not exec $tapechanger: $!\n"; - exit 2; +# this is a simple base class with stub method or two. + +sub new { + my $class = shift; + my $self = { + released => 0, + }; + return bless ($self, $class) +} + +sub DESTROY { + my ($self) = @_; + if (!$self->{'released'}) { + $self->release(finished_cb => sub { + my ($err) = @_; + if (defined $err) { + warn "While releasing reservation: $err"; + } + }); } +} - # parent - my @child_output = <$child>; +sub set_label { + my $self = shift; + my %params = @_; - # close the child and get its exit status - my $child_exit = 0; - if (!close($child)) { - if ($!) { - croak("Error running changer script: $!"); - } else { - $child_exit = $?; - } + # nothing to do: just call the finished callback + if (exists $params{'finished_cb'}) { + Amanda::MainLoop::call_later($params{'finished_cb'}, undef); } +} - # parse the response - croak("Malformed output from changer script -- no output") - if (@child_output < 1); - croak("Malformed output from changer script -- too many lines") - if (@child_output > 1); - croak("Malformed output from changer script: '$child_output[0]'") - if ($child_output[0] !~ /\s*([^\s]+)\s+(.+)?/); - my ($slot, $rest) = ($1, $2); - - if ($child_exit == 0) { - return (0, $slot, $rest); - } elsif (POSIX::WIFEXITED($child_exit) && POSIX::WEXITSTATUS($child_exit) == 1) { - return ($rest); # non-fatal error - } else { - croak("Fatal error from changer script: $rest"); +sub release { + my $self = shift; + my %params = @_; + + return if $self->{'released'}; + + $self->{'released'} = 1; + $self->do_release(%params); + + if (exists $params{'finished_cb'}) { + Amanda::MainLoop::call_later($params{'finished_cb'}, undef); } } +sub do_release { + # this is the one subclasses should override +} + 1;