1 # Copyright (c) 2007,2008,2009,2010 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU General Public License version 2 as published
5 # by the Free Software Foundation.
7 # This program is distributed in the hope that it will be useful, but
8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
9 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 # You should have received a copy of the GNU General Public License along
13 # with this program; if not, write to the Free Software Foundation, Inc.,
14 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
19 package Amanda::Changer;
23 use Carp qw( confess cluck );
25 use Fcntl qw( O_RDWR O_CREAT LOCK_EX LOCK_NB );
31 use Amanda::Config qw( :getconf string_to_boolean );
32 use Amanda::Device qw( :constants );
33 use Amanda::Debug qw( debug );
38 Amanda::Changer -- interface to changer scripts
44 my $chg = Amanda::Changer->new(); # loads the default changer; OR
45 $chg = Amanda::Changer->new("somechanger"); # references a defined changer in amanda.conf
51 my ($err, $reservation) = @_;
55 $dev = $reservation->{'device'};
60 $reservation->release(finished_cb => $start_next_volume);
64 All operations in the module return immediately, and take as an argument a
65 callback function which will indicate completion of the changer operation -- a
66 kind of continuation. The caller should run a main loop (see
67 L<Amanda::MainLoop>) to allow the interactions with the changer script to
70 A new object is created with the C<new> function as follows:
72 my $chg = Amanda::Changer->new($changer_name);
74 to create a named changer (a name provided by the user, either specifying a
75 changer directly or specifying a changer definition), or
77 my $chg = Amanda::Changer->new();
79 to run the default changer. This function handles the many ways a user can
82 If there is a problem creating the new object, then the resulting object will
83 be a fatal C<Error> object (described below). Thus the usual recipe for
84 creating a new changer is
86 my $chg = Amanda::Changer->new($changer_name);
87 if ($chg->isa("Amanda::Changer::Error")) {
88 die("Error creating changer $changer_name: $chg");
91 =head2 MEMBER VARIABLES
93 Note that these variables are not set until after the subclass constructor is
98 =item C<< $chg->{'chg_name'} >>
100 Gives the name of the changer. This name will make sense to the user, but will
101 not necessarily form a valid changer specification. It should be used to
102 describe the changer in messages to the user.
108 All changer callbacks take an error object as the first parameter. If no error
109 occurred, then this parameter is C<undef> and the remaining parameters are
112 A res_cb C<$cb> is called back as:
114 $cb->($error, undef);
116 in the event of an error, or
118 $cb->(undef, $reservation);
120 with a successful reservation. res_cb must always be specified. A finished_cb
121 C<$cb> is called back as
125 in the event of an error, or
129 on success. A finished_cb may be omitted if no notification of completion is
132 Other callback types are defined below.
136 When a callback is made with an error, it is an object of type
137 C<Amanda::Changer::Error>. When interpolated into a string, this object turns
138 into a simple error message. However, it has some additional methods that can
139 be used to determine how to respond to the error. First, the error message is
140 available explicitly as C<< $err->message >>. The error type is available as
141 C<< $err->{'type'} >>, although checks for particular error types should use
142 the C<TYPE> methods instead, as perl is better able to detect typos with this
145 if ($err->failed) { ... }
149 fatal Changer is no longer useable
150 failed Operation failed, but the changer is OK
152 The API may add other error types in the future (for example, to indicate
153 that a required resource is already reserved).
155 Errors of the type C<fatal> indicate that the changer should not be used any
156 longer, and in most cases the caller should terminate abnormally. For example,
157 configuration or hardware errors are generally fatal.
159 If an operation fails, but the changer remains viable, then the error type is
160 C<failed>. The reason for the failure is usually clear to the user from the
161 message, but for callers who may need to distinguish, C<< $err->{'reason'} >>
162 has one of the following values:
164 notfound The requested volume was not found
165 invalid The caller's request was invalid (e.g., bad slot)
166 notimpl The requested operation is not supported
167 volinuse The requested volume or slot is already in use
168 driveinuse All drives are in use
169 unknown Unknown reason
171 Like types, checks for particular reasons should use the methods, to avoid
174 if ($err->failed and $err->notimpl) { ... }
176 Other reasons may be added in the future, so a caller should check for the
177 reasons it expects, and treat any other failures as of unknown cause.
179 When the desired slot cannot be loaded because it is already in use, the
180 C<volinuse> error comes with an extra parameter, C<slot>, giving the slot in
181 question. This parameter is not defined for other cases.
185 Changers maintain a global concept of a "current" slot, for compatibility with
186 Amanda algorithms such as the taperscan. However, it is not compatible with
187 concurrent use of the same changer, and may be inefficient for some changers,
188 so new algorithms should avoid using it, preferring instead to load the correct
189 tape immediately (with C<load>), and to progress from tape to tape using the
190 C<relative_slot> parameter to C<load>.
192 =head2 CHANGER OBJECTS
196 The most common operation with a tape changer is to load a volume. The C<load>
197 method is heavily overloaded to support a number of different ways to specify a
200 In general, the method takes a C<res_cb> giving a callback that will receive
201 the reservation. If set_current is specified and true, then the changer's
202 current slot should be updated to correspond to C<$slot>. If not, then the changer
203 should not update its current slot (but some changers will anyway -
204 specifically, chg-compat).
206 The load method always read the label if it succeed to load a volume.
208 The optional C<mode> describes the intended use of the volume by the caller,
209 and should be one of C<"read"> (the default) or C<"write">. Changers managing
210 WORM media may use this parameter to provide a fresh volume for writing, but to
211 search for already-written volumes when reading.
213 The load method has a number of permutations:
215 $chg->load(res_cb => $cb,
220 Load and reserve a volume with the given label. This may leverage any barcodes
221 or other indices that the changer has available.
223 Note that the changer I<tries> to load the requested volume, but it's a mean
224 world out there, and you may not get what you want, so check the label on the
225 loaded volume before getting started.
227 $chg->load(res_cb => $cb,
232 Load and reserve the volume in the given slot. C<$slot> is a string specifying the slot
233 to load, provided by the user or from some other invocation of this changer.
234 Note that slots are not necessarily numeric, so performing arithmetic on this
237 If the slot does not exist, C<res_cb> will be called with a C<notfound> error.
238 Empty slots are considered empty.
240 $chg->load(res_cb => $cb,
241 relative_slot => "current",
244 Reserve the volume in the "current" slot. This is used by the traditional
245 taperscan algorithm to begin its search.
247 $chg->load(res_cb => $cb,
248 relative_slot => "next",
250 except_slots => { %except_slots },
254 Reserve the volume that follows the given slot or, if C<slot> is omitted, the
255 volume that follows the current slot. This will skip empty slots as if they
256 were not present in the changer.
258 The optional C<except_slots> argument specifies a hash of slots that should
259 I<not> be loaded. Keys are slot names, and the hash values are ignored. This
260 is useful as a termination condition when scanning all of the slots in a
261 changer: keep a hash of all slots already loaded, and pass that hash in
262 C<except_slots>. When the load operation returns a C<notfound> error, the scan
267 $chg->info(info_cb => $cb,
268 info => [ $key1, $key2, .. ])
270 Query the changer for miscellaneous information. Any number of keys may be
271 specified. The C<info_cb> is called with C<$error> as the first argument,
272 much like a C<res_cb>, but the remaining arguments form a hash giving values
273 for all of the requested keys that are supported by the changer. The preamble
274 to such a callback is usually
277 my ($error, %results) = @_;
287 The total number of slots in the changer device. If this key is not present or
288 -1, then the device cannot determine its slot count (for example, an archival
289 device that names slots by timestamp could potentially run until the heat-death
294 A string describing the name and model of the changer device.
298 If true, then this changer implements searching (loading by label) with
299 something more efficient than a sequential scan through the volumes. This
300 information affects some taperscan algorithms and recovery programs, which may
301 choose to do their own manual scan instead of invoking many potentially slow
308 $chg->reset(finished_cb => $cb)
310 Reset the changer to a "base" state. This will generally reset the "current"
311 slot to something the user would think of as the "first" tape, unload any
312 loaded drives, etc. It is an error to call this while any reservations are
317 $chg->clean(finished_cb => $cb,
320 Clean a drive, if the changer supports it. Drivename can be omitted for devices
321 with only one drive, or can be an arbitrary string from the user (e.g., an
322 amtape argument). Note that some changers cannot detect the completion of a
323 cleaning cycle; in this case, the user will just need to delay further Amanda
324 activities until the cleaning is complete.
328 $chg->eject(finished_cb => $cb,
331 Eject the volume in a drive, if the changer supports it. Drivename is as
332 specified to C<clean>. If possible, applications should prefer to eject a
333 reserved volume when finished with it (C<< $res->release(eject => 1) >>), to
334 ensure that the correct volume is ejected from a multi-drive changer.
338 $chg->update(finished_cb => $cb,
342 The user has changed something -- loading or unloading tapes, reconfiguring the
343 changer, etc. -- that may have invalidated the database. C<$changed> is a
344 changer-specific string indicating what has changed; if it is omitted, the
345 changer will check everything.
347 Since updates can take a long time, and users often want to know what's going
348 on, the update method will call C<user_msg_fn>, if specified, with
349 user-oriented messages appropriate to the changer.
353 $chg->inventory(inventory_cb => $cb)
355 The C<inventory_cb> is called with an error object as the first parameter, or
356 C<undef> if no error occurs. The second parameter is an arrayref containing an
357 ordered list of information about the slots in the changer. The order never
358 change, but some entries can be added or removed.
360 Each slot is represented by a hash with the following keys:
370 Set to C<1> if it is the current slot.
374 Set to C<SLOT_FULL> if the slot is full, C<SLOT_EMPTY> if the slot is empty (no
375 volume in slot), C<SLOT_UNKNOWN> if the changer doesn't know if the slot is full
376 or not (but it can know), or undef if the changer can't know if the slot is full or not.
377 A changer that doesn't keep state must set it to undef, like chg-single.
378 These constants are available in the C<:constants> export tag.
380 A blank or erased volume is not the same as an empty slot.
384 The device status after the open or read_label, undef if device status is unknown.
388 The file header type as returned by read_label, only if device_status is DEVICE_STATUS_SUCCESS.
392 The label on the volume in this slot, can be set by barcode or by read_label if f_type is Amanda::Header::F_TAPESTART.
394 =item barcode (optional)
396 The barcode for the volume in this slot, if barcodes are available.
400 Set to C<1> if this slot is reserved, either by this process or another
401 process. This is only set for I<exclusive> reservations, meaning that loading
402 the slot would result in an C<volinuse> error. Devices which can support
403 concurrent access will never set this flag.
405 =item loaded_in (optional)
407 For changers which have distinct user-visible drives, this gives the drive
408 currently accessing the volume in this slot.
410 =item import_export (optional)
412 Set to C<1> if this is an import-export slot -- a slot in which the user can
413 easily add or remove volumes. This information may be useful for operations to
414 bulk-import newly-inserted tapes or bulk-export a set of tapes.
420 $chg->move(finished_cb => $cb,
424 Move a volume between two slots in the changer. These slots are provided by the
425 user, and have meaning for the changer.
427 =head2 RESERVATION OBJECTS
429 =head3 $res->{'device'}
431 This is the fully configured device for the reserved volume. The device is not
434 =head3 $res->{'this_slot'}
436 This is the name of this slot. It is an arbitrary string which will
437 have some meaning to the changer's C<load()> method. It is safe to
438 access this field after the reservation has been released.
440 =head3 $res->{'barcode'}
442 If this changer supports barcodes, then this is the barcode of the reserved
443 volume. This can be helpful for labeling tapes using their barcode.
445 =head3 $res->release(finished_cb => $cb, eject => $eject)
447 This is how an Amanda application indicates that it no longer needs the
448 reserved volume. The callback is called after any related operations are
449 complete -- possibly immediately. Some drives and changers have a notion of
450 "ejecting" a volume, and some don't. In particular, a manual changer can cause
451 the tape drive to eject the tape, while a tape robot can move a tape back to
452 storage, leaving the drive empty. If the eject parameter is given and true, it
453 indicates that Amanda is done with the volume and has reason to believe the
454 user is done with the volume, too -- for example, when a tape has been written
457 A reservation will be released automatically when the object is destroyed, but
458 in this case no finished_cb is given, so the release operation may not complete
459 before the process exits. Wherever possible, reservations should be explicitly
462 =head3 $res->set_label(finished_cb => $cb, label => $label)
464 This is how Amanda indicates to the changer that the volume in the device has
465 been (re-)labeled. Changers can keep a database of volume labels by slot or by
466 barcode, or just ignore this function and call $cb immediately. Note that the
467 reservation must still be held when this function is called.
469 =head1 SUBCLASS HELPERS
471 C<Amanda::Changer> implements some methods and attributes to help subclass
476 Implementing the C<info> method can be tricky, because it can potentially request
477 a number of keys that require asynchronous access. The C<info> implementation in
478 this class may make the process a bit easier.
480 First, if the method C<info_setup> is defined, C<info> calls it, passing it a
481 C<finished_cb> and the list of desired keys, C<info>. This method is useful to
482 gather information that is useful for several info keys.
484 Next, for each requested key, C<info> calls
486 $self->info_key($key, %params)
488 including a regular C<info_cb> callback. The C<info> method will wait for
489 all C<info_key> invocations to finish, then collect the results or errors that
492 =head2 PROPERTY PARSING
494 Many properties are boolean, and Amanda has a habit of accepting a number of
495 different ways of writing boolean values. The method
496 C<< $self->get_boolean_property($config, $prop, $default) >> will parse such a
497 property, returning 0 or 1 if the property is specified, C<$default> if it is
498 not specified, or C<undef> if the property cannot be parsed.
500 =head2 ERROR HANDLING
502 To create a new error object, use C<< $self->make_error($type, $cb, %args) >>.
503 This method will create a new C<Amanda::Changer::Error> object and optionally
504 invoke a callback with it. If C<$type> is C<fatal>, then
505 C<< $chg->{'fatal_error'} >> is made a reference to the new error object. The
506 callback C<$cb> (which should be made using C<make_cb()> from
507 C<Amanda::MainLoop>) is called with the new error object. The C<%args> are
508 added to the new error object. In use, this looks something like:
511 return $self->make_error("failed", $params{'res_cb'},
512 reason => "notfound",
513 message => "Volume '$label' not found");
516 This method can also be called as a class method, e.g., from a constructor.
517 In this case, it returns the resulting error object, which should be fatal.
520 return Amanda::Changer->make_error("fatal", undef,
521 message => "config error");
524 For cases where a number of errors have occurred, it is helpful to make a
525 "combined" error. The method C<make_combined_error> takes care of this
526 operation, given a callback and an array of tuples C<[ $description, $err ]>
527 for each error. This method uses some heuristics to figure out the
528 appropriate type and reason for the combined error.
530 if ($left_err and $right_err) {
531 return $self->make_combined_error($params{'finished_cb'},
532 [ [ "from the left", $left_err ],
533 [ "from the right", $right_err ] ]);
536 Any additional keyword arguments to C<make_combined_error> are put into the
537 combined error; this is useful to set the C<slot> attribute.
539 The method C<< $self->check_error($cb) >> is a useful method for subclasses to
540 avoid doing anything after a fatal error. This method checks
541 C<< $self->{'fatal_error'} >>. If the error is defined, the method calls C<$cb>
542 and returns true. The usual recipe is
548 return if $self->check_error($params{'res_cb'});
554 C<Amanda::Changer->new> calls subclass constructors with two parameters: a
555 configuration object and a changer specification. The changer specification is
556 the string that led to creation of this changer device. The configuration
557 object is of type C<Amanda::Changer::Config>, and can be treated as a hashref
558 with the following keys:
560 name -- name of the changer section (or "default")
561 is_global -- true if this changer is the default changer
562 tapedev -- tapedev parameter
563 tpchanger -- tpchanger parameter
564 changerdev -- changerdev parameter
565 changerfile -- changerfile parameter
566 properties -- all properties for this changer
567 device_properties -- device properties from this changer
569 The four parameters are just as supplied by the user, either in the global
570 config or in a changer section. Changer authors are cautioned not to try to
571 override any of these parameters as previous changers have done (e.g.,
572 C<changerfile> specifying both configuration and state files). Use properties
575 The C<properties> and C<device_properties> parameters are in the format
576 provided by C<Amanda::Config>. If C<is_global> is true, then
577 C<device_properties> will include any device properties specified globally, as
578 well as properties culled from the global tapetype.
580 The C<configure_device> method generally takes care of the intricacies of
581 handling device properties. Pass it a newly opened device and it will apply
582 the relevant properties, returning undef on success or an error message on
585 The C<get_property> method is a shortcut method to get the value of a changer
586 property, ignoring its the priority and other attributes. In a list context,
587 it returns all values for the property; in a scalar context, it returns the
588 first value specified.
590 =head2 PERSISTENT STATE AND LOCKING
592 Many changer subclasses need to track state across invocations and between
593 different processes, and to ensure that the state is read and written
594 atomically. The C<with_locked_state> provides this functionality by
595 locking a statefile, only unlocking it after any changes have been written back
596 to it. Subclasses can use this method both for mutual exclusion (ensuring that
597 only one changer operation is in progress at any time) and for atomic state
600 The C<with_locked_state> method works like C<synchronized> (in
601 L<Amanda::MainLoop>), but with some extra arguments:
603 $self->with_locked_state($filename, $some_cb, sub {
604 # note: $some_cb shadows outer $some_cb; see Amanda::MainLoop::synchronized
605 my ($state, $some_cb) = @_;
606 # ... and eventually:
610 The callback C<$some_cb> is assumed to take a changer error as its first
611 argument, and if there are any errors locking the statefile, they will be
612 reported directly to this callback. Otherwise, a wrapped version of
613 C<$some_cb> is passed to the inner C<sub>. When this wrapper is invoked, the
614 state will be written to disk and unlocked before the original callback is
617 The state itself begins as an empty hashref, but subclasses can add arbitrary
618 keys to the hash. Serialization is currently handled with L<Data::Dumper>.
620 =head2 PARAMETER VALIDATION
622 The C<validate_params> method is useful to make sure that the proper parameters
623 are present for a particular method, dying if not. Call it like this:
625 $self->validate_params("load", \%params);
627 The method currently only supports the "load" method, but can be expanded to
632 The Amanda Wiki (http://wiki.zmanda.com) has a higher-level description of the
633 changer model implemented by this package.
635 See amanda-changers(7) for user-level documentation of the changer implementations.
639 # constants for the states that slots may be in; note that these states still
640 # apply even if the tape is actually loaded in a drive
642 # slot is known to contain a volume
643 use constant SLOT_FULL => 1;
645 # slot is known to contain no volume
646 use constant SLOT_EMPTY => 2;
648 # don't known if slot contains a volume
649 use constant SLOT_UNKNOWN => 3;
651 our @EXPORT_OK = qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN );
653 constants => [ qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN ) ],
656 # this is a "virtual" constructor which instantiates objects of different
657 # classes based on its argument. Subclasses should not try to chain up!
659 shift eq 'Amanda::Changer'
660 or die("Do not call the Amanda::Changer constructor from subclasses");
664 # creating a named changer is a bit easier
665 if (defined($name)) {
666 # first, is it a changer alias?
667 if (($uri,$cc) = _changer_alias_to_uri($name)) {
668 return _new_from_uri($uri, $cc, $name);
671 # maybe a straight-up changer URI?
672 if (_uri_to_pkgname($name)) {
673 return _new_from_uri($name, undef, $name);
676 # assume it's a device name or alias, and invoke the single-changer
677 return _new_from_uri("chg-single:$name", undef, $name);
678 } else { # !defined($name)
679 if ((getconf_linenum($CNF_TPCHANGER) == -2 ||
680 (getconf_seen($CNF_TPCHANGER) &&
681 getconf_linenum($CNF_TAPEDEV) != -2)) &&
682 getconf($CNF_TPCHANGER) ne '') {
683 my $tpchanger = getconf($CNF_TPCHANGER);
685 # first, is it an old changer script?
686 if ($uri = _old_script_to_uri($tpchanger)) {
687 return _new_from_uri($uri, undef, $tpchanger);
690 # if not, then there had better be no tapdev
691 if (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '' and
692 ((getconf_linenum($CNF_TAPEDEV) > 0 and
693 getconf_linenum($CNF_TPCHANGER) > 0) ||
694 (getconf_linenum($CNF_TAPEDEV) == -2))) {
695 return Amanda::Changer::Error->new('fatal',
696 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
697 "unless using an old-style changer script");
700 # maybe a changer alias?
701 if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
702 return _new_from_uri($uri, $cc, $tpchanger);
705 # maybe a straight-up changer URI?
706 if (_uri_to_pkgname($tpchanger)) {
707 return _new_from_uri($tpchanger, undef, $tpchanger);
710 # assume it's a device name or alias, and invoke the single-changer
711 return _new_from_uri("chg-single:$tpchanger", undef, $tpchanger);
712 } elsif (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '') {
713 my $tapedev = getconf($CNF_TAPEDEV);
715 # first, is it a changer alias?
716 if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
717 return _new_from_uri($uri, $cc, $tapedev);
720 # maybe a straight-up changer URI?
721 if (_uri_to_pkgname($tapedev)) {
722 return _new_from_uri($tapedev, undef, $tapedev);
725 # assume it's a device name or alias, and invoke chg-single.
726 # chg-single will check the device immediately and error out
727 # if the device name is invalid.
728 return _new_from_uri("chg-single:$tapedev", undef, $tapedev);
730 return Amanda::Changer::Error->new('fatal',
731 message => "You must specify one of 'tapedev' or 'tpchanger'");
736 # helper functions for new
738 sub _changer_alias_to_uri {
741 my $cc = Amanda::Config::lookup_changer_config($name);
743 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
745 if (my $uri = _old_script_to_uri($tpchanger)) {
750 my $seen_tpchanger = changer_config_seen($cc, $CHANGER_CONFIG_TPCHANGER);
751 my $seen_tapedev = changer_config_seen($cc, $CHANGER_CONFIG_TAPEDEV);
752 if ($seen_tpchanger and $seen_tapedev) {
753 return Amanda::Changer::Error->new('fatal',
754 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
755 "**unless using an old-style changer script");
757 if (!$seen_tpchanger and !$seen_tapedev) {
758 return Amanda::Changer::Error->new('fatal',
759 message => "You must specify one of 'tapedev' or 'tpchanger'");
761 $tpchanger ||= changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
763 if (_uri_to_pkgname($tpchanger)) {
764 return ($tpchanger, $cc);
766 die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
774 sub _old_script_to_uri {
777 die("empty changer script name") unless $name;
779 if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
780 return "chg-compat:$name"
787 # try to load the package for the given URI. $@ is set properly
788 # if this function returns a false value.
789 sub _uri_to_pkgname {
792 my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
793 if (!defined $type) {
794 $@ = "'$name' is not a changer URI";
798 $type =~ tr/A-Z-/a-z_/;
800 # create a package name to see if it's already imported
801 my $pkgname = "Amanda::Changer::$type";
802 my $filename = $pkgname;
803 $filename =~ s|::|/|g;
805 return $pkgname if (exists $INC{$filename});
808 eval "use $pkgname;";
812 # determine whether the module doesn't exist at all, or if there was an
813 # error loading it; die if we found a syntax error
814 if (exists $INC{$filename} or $err =~ /did not return a true value/) {
824 # already-instantiated changer objects (using 'our' so that the installcheck
825 # and reset this list as necessary)
826 our %changers_by_uri_cc = ();
828 sub _new_from_uri { # (note: this sub is patched by the installcheck)
829 my ($uri, $cc, $name) = @_;
831 # as a special case, if the URI came back as an error, just pass
832 # that along. This lets the _xxx_to_uri methods return errors more
834 if (ref $uri and $uri->isa("Amanda::Changer::Error")) {
838 # make up a key for our hash of already-instantiated objects,
839 # using a newline as a separator, since perl can't use tuples
841 my $uri_cc = "$uri\n";
843 $uri_cc = $uri_cc . changer_config_name($cc);
846 # return a pre-existing changer, if possible
848 if (exists($changers_by_uri_cc{$uri_cc})) {
849 return $changers_by_uri_cc{$uri_cc};
852 # look up the type and load the class
853 my $pkgname = _uri_to_pkgname($uri);
858 my $rv = $pkgname->new(Amanda::Changer::Config->new($cc), $uri);
859 die "$pkgname->new did not return an Amanda::Changer object or an Amanda::Changer::Error"
860 unless ($rv->isa("Amanda::Changer") or $rv->isa("Amanda::Changer::Error"));
862 if ($rv->isa("Amanda::Changer::Error")) {
866 if ($rv->isa("Amanda::Changer")) {
867 # add an instance variable or two
868 $rv->{'fatal_error'} = undef;
870 # store this in our cache for next time
871 $changers_by_uri_cc{$uri_cc} = $rv;
874 $rv->{'chg_name'} = $name;
878 # method stubs that return a "notimpl" error
881 my ($op, $cbname, $self, %params) = @_;
882 return if $self->check_error($params{$cbname});
884 my $class = ref($self);
885 my $chg_foo = "chg-" . ($class =~ /Amanda::Changer::(.*)/)[0];
886 return $self->make_error("failed", $params{$cbname},
888 message => "'$chg_foo:' does not support $op");
891 sub load { _stubop("loading volumes", "res_cb", @_); }
892 sub reset { _stubop("reset", "finished_cb", @_); }
893 sub clean { _stubop("clean", "finished_cb", @_); }
894 sub eject { _stubop("eject", "finished_cb", @_); }
895 sub update { _stubop("update", "finished_cb", @_); }
896 sub inventory { _stubop("inventory", "inventory_cb", @_); }
897 sub move { _stubop("move", "finished_cb", @_); }
899 # info calls out to info_setup and info_key; see POD above
904 if (!$self->can('info_key')) {
905 my $class = ref($self);
906 $params{'info_cb'}->("$class does not support info()");
910 my ($do_setup, $start_keys, $all_done);
913 if ($self->can('info_setup')) {
914 $self->info_setup(info => $params{'info'},
918 $params{'info_cb'}->($err);
929 my $remaining_keys = 1;
932 my $maybe_done = sub {
933 return if (--$remaining_keys);
934 $all_done->(%key_results);
937 for my $key (@{$params{'info'}}) {
939 $self->info_key($key, info_cb => sub {
940 $key_results{$key} = [ @_ ];
945 # we started with $remaining_keys = 1, so decrement it now
950 my %key_results = @_;
952 # if there are *any* errors, handle them
954 map { [ sprintf("While getting info key '%s'", $_), $key_results{$_}->[0] ] }
955 grep { defined($key_results{$_}->[0]) }
958 if (@annotated_errs) {
959 return $self->make_combined_error(
960 $params{'info_cb'}, [ @annotated_errs ]);
963 # no errors, so combine the results and return them
965 while (my ($key, $result) = each(%key_results)) {
966 my ($err, %key_info) = @$result;
967 if (exists $key_info{$key}) {
968 $info{$key} = $key_info{$key};
970 warn("No value available for $key");
974 $params{'info_cb'}->(undef, %info);
982 sub get_boolean_property {
984 my ($config, $propname, $default) = @_;
987 unless (exists $config->{'properties'}->{$propname});
989 my $propinfo = $config->{'properties'}->{$propname};
990 return undef unless @{$propinfo->{'values'}} == 1;
991 return string_to_boolean($propinfo->{'values'}->[0]);
996 my ($type, $cb, %args) = @_;
998 my $classmeth = $self eq "Amanda::Changer";
1000 if ($classmeth and $type ne 'fatal') {
1001 cluck("type must be fatal when calling make_error as a class method");
1005 my $err = Amanda::Changer::Error->new($type, %args);
1008 $self->{'fatal_error'} = $err
1017 sub make_combined_error {
1019 my ($cb, $suberrors, %extra_args) = @_;
1022 if (@$suberrors == 0) {
1023 die("make_combined_error called with no errors");
1026 my $classmeth = $self eq "Amanda::Changer";
1028 # if there's only one suberror, just use it directly
1029 if (@$suberrors == 1) {
1030 $err = $suberrors->[0][1];
1031 die("$err is not an Error object")
1032 unless defined($err) and $err->isa("Amanda::Changer::Error");
1034 $err = Amanda::Changer::Error->new(
1036 reason => $err->{'reason'},
1037 message => $suberrors->[0][0] . ": " . $err->{'message'});
1039 my $fatal = $classmeth or grep { $_->[1]{'fatal'} } @$suberrors;
1044 map { ($_->[1]{'reason'}, undef) }
1045 grep { $_->[1]{'reason'} }
1047 if ((keys %reasons) == 1) {
1048 $reason = (keys %reasons)[0];
1050 $reason = 'unknown'; # multiple or 0 "source" reasons
1054 my $message = join("; ",
1055 map { sprintf("%s: %s", @$_) }
1058 my %errargs = ( message => $message, %extra_args );
1059 $errargs{'reason'} = $reason unless ($fatal);
1060 $err = Amanda::Changer::Error->new(
1061 $fatal? "fatal" : "failed",
1066 $self->{'fatal_error'} = $err
1079 if (defined $self->{'fatal_error'}) {
1080 $cb->($self->{'fatal_error'}) if $cb;
1085 sub lock_statefile {
1089 my $statefile = $params{'statefile_filename'};
1090 my $lock_cb = $params{'lock_cb'};
1091 Amanda::Changer::StateFile->new($statefile, $lock_cb);
1094 sub with_locked_state {
1096 my ($statefile, $cb, $sub) = @_;
1097 my ($filelock, $STATE);
1098 my $poll = 0; # first delay will be 0.1s; see below
1100 my $steps = define_steps
1104 $filelock = Amanda::Util::file_lock->new($statefile);
1106 $steps->{'lock'}->();
1110 my $rv = $filelock->lock();
1112 # loop until we get the lock, increasing $poll to 10s
1113 $poll += 100 unless $poll >= 10000;
1114 return Amanda::MainLoop::call_after($poll, $steps->{'lock'});
1115 } elsif ($rv == -1) {
1116 return $self->make_error("fatal", $cb,
1117 message => "Error locking '$statefile'");
1120 $steps->{'read'}->();
1124 my $contents = $filelock->data();
1128 # $fh goes out of scope here, and is thus automatically
1130 return $cb->("error reading '$statefile': $@", undef);
1132 if (!defined $STATE or ref($STATE) ne 'HASH') {
1133 return $cb->("'$statefile' did not define \$STATE properly", undef);
1136 # initial state (blank file)
1140 $sub->($STATE, $steps->{'cb_wrap'});
1143 step cb_wrap => sub {
1146 my $dumper = Data::Dumper->new([ $STATE ], ["STATE"]);
1148 $filelock->write($dumper->Dump);
1149 $filelock->unlock();
1151 # call through to the original callback with the original
1157 sub validate_params {
1158 my ($self, $op, $params) = @_;
1160 if ($op eq 'load') {
1161 unless(exists $params->{'label'} || exists $params->{'slot'} ||
1162 exists $params->{'relative_slot'}) {
1163 confess "Invalid parameters to 'load'";
1166 confess "don't know how to validate '$op'";
1170 package Amanda::Changer::Error;
1171 use Amanda::Debug qw( :logging );
1172 use Carp qw( cluck );
1175 '""' => sub { $_[0]->{'message'}; },
1176 'cmp' => sub { $_[0]->{'message'} cmp $_[1]; };
1178 my %known_err_types = map { ($_, 1) } qw( fatal failed );
1179 my %known_err_reasons = map { ($_, 1) } qw( notfound invalid notimpl driveinuse volinuse unknown device );
1182 my $class = shift; # ignore class
1183 my ($type, %info) = @_;
1186 $reason = ", reason='$info{reason}'" if $type eq "failed";
1187 debug("new Amanda::Changer::Error: type='$type'$reason, message='$info{message}'");
1189 $info{'type'} = $type;
1191 # do some sanity checks. Note that these sanity checks issue a warning
1192 # with cluck, but add default values to the error. This is in the hope
1193 # that an unusual Amanda error is not obscured by a problem in the
1194 # make_error invocation. The stack trace produced by cluck should help to
1195 # track down the bad make_error invocation.
1197 if (!exists $info{'message'}) {
1198 cluck("no message given to A::C::make_error");
1199 $info{'message'} = "unknown error";
1202 if (!exists $known_err_types{$type}) {
1203 cluck("invalid Amanda::Changer::Error type '$type'");
1207 if ($type eq 'failed' and !exists $info{'reason'}) {
1208 cluck("no reason given to A::C::make_error");
1209 $info{'reason'} = "unknown";
1212 if ($type eq 'failed' and !exists $known_err_reasons{$info{'reason'}}) {
1213 cluck("invalid Amanda::Changer::Error reason '$info{reason}'");
1214 $info{'reason'} = 'unknown';
1217 return bless (\%info, $class);
1221 sub fatal { $_[0]->{'type'} eq 'fatal'; }
1222 sub failed { $_[0]->{'type'} eq 'failed'; }
1225 sub notfound { $_[0]->failed && $_[0]->{'reason'} eq 'notfound'; }
1226 sub invalid { $_[0]->failed && $_[0]->{'reason'} eq 'invalid'; }
1227 sub notimpl { $_[0]->failed && $_[0]->{'reason'} eq 'notimpl'; }
1228 sub driveinuse { $_[0]->failed && $_[0]->{'reason'} eq 'driveinuse'; }
1229 sub volinuse { $_[0]->failed && $_[0]->{'reason'} eq 'volinuse'; }
1230 sub unknown { $_[0]->failed && $_[0]->{'reason'} eq 'unknown'; }
1233 sub slot { $_[0]->{'slot'}; }
1235 package Amanda::Changer::Reservation;
1236 # this is a simple base class with stub method or two.
1243 return bless ($self, $class)
1248 if (!$self->{'released'}) {
1249 if (defined $self->{this_slot}) {
1250 Amanda::Debug::warning("Changer reservation for slot '$self->{this_slot}' has " .
1251 "gone out of scope without release");
1253 Amanda::Debug::warning("Changer reservation for unknown slot has " .
1254 "gone out of scope without release");
1263 # nothing to do by default: just call the finished callback
1264 if (exists $params{'finished_cb'}) {
1265 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1273 return if $self->{'released'};
1275 # always finish the device on release; it's illegal for anything
1276 # else to use the device after this point, anyway, so we want to
1277 # release the device's resources immediately
1278 if (defined $self->{'device'}) {
1279 $self->{'device'}->finish();
1282 $self->{'released'} = 1;
1283 $self->do_release(%params);
1290 # this is the one subclasses should override
1292 if (exists $params{'finished_cb'}) {
1293 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1297 package Amanda::Changer::Config;
1298 use Amanda::Config qw( :getconf );
1305 my $self = bless {}, $class;
1308 $self->{'name'} = changer_config_name($cc);
1309 $self->{'is_global'} = 0;
1311 $self->{'tapedev'} = changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
1312 $self->{'tpchanger'} = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
1313 $self->{'changerdev'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERDEV);
1314 $self->{'changerfile'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERFILE);
1316 $self->{'properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_PROPERTY);
1317 $self->{'device_properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_DEVICE_PROPERTY);
1319 $self->{'name'} = "default";
1320 $self->{'is_global'} = 1;
1322 $self->{'tapedev'} = getconf($CNF_TAPEDEV);
1323 $self->{'tpchanger'} = getconf($CNF_TPCHANGER);
1324 $self->{'changerdev'} = getconf($CNF_CHANGERDEV);
1325 $self->{'changerfile'} = getconf($CNF_CHANGERFILE);
1327 # no changer or device properties, since there's no changer definition to use
1328 $self->{'properties'} = {};
1329 $self->{'device_properties'} = {};
1334 sub configure_device {
1338 # we'll accumulate properties in this hash *overwriting* previous properties
1339 # instead of appending to them
1342 # always use implicit properties
1343 %properties = ( %properties, %{ $self->_get_implicit_properties() } );
1345 # always use global properties
1346 %properties = ( %properties, %{ getconf($CNF_DEVICE_PROPERTY) } );
1348 # if this is a device alias, add properties from its device definition
1349 if (my $dc = lookup_device_config($device->device_name)) {
1350 %properties = ( %properties,
1351 %{ device_config_getconf($dc, $DEVICE_CONFIG_DEVICE_PROPERTY); } );
1354 # finally, add any props from the changer config
1355 %properties = ( %properties, %{ $self->{'device_properties'} } );
1357 while (my ($propname, $propinfo) = each(%properties)) {
1358 for my $value (@{$propinfo->{'values'}}) {
1359 if (!$device->property_set($propname, $value)) {
1360 my $msg = "Error setting '$propname' on device '".$device->device_name."'";
1361 if (exists $propinfo->{'optional'}) {
1362 if ($propinfo->{'optional'} eq 'warn') {
1363 warn("$msg (ignored)");
1377 my ($property) = @_;
1379 my $prophash = $self->{'properties'}->{$property};
1380 return undef unless defined($prophash);
1382 return wantarray? @{$prophash->{'values'}} : $prophash->{'values'}->[0];
1385 sub _get_implicit_properties {
1389 my $tapetype_name = getconf($CNF_TAPETYPE);
1390 return unless defined($tapetype_name);
1392 my $tapetype = lookup_tapetype($tapetype_name);
1393 return unless defined($tapetype);
1395 # The property hashes used here add the 'optional' key, which indicates
1396 # that the property is implicit and that a failure to set it is not fatal.
1397 # The flag is used by configure_device.
1398 if (tapetype_seen($tapetype, $TAPETYPE_LENGTH)) {
1399 $props->{'max_volume_usage'} = {
1404 tapetype_getconf($tapetype, $TAPETYPE_LENGTH) * 1024,
1408 if (tapetype_seen($tapetype, $TAPETYPE_READBLOCKSIZE)) {
1409 $props->{'read_block_size'} = {
1410 optional => "warn", # optional, but give a warning
1414 tapetype_getconf($tapetype, $TAPETYPE_READBLOCKSIZE) * 1024,
1418 if (tapetype_seen($tapetype, $TAPETYPE_BLOCKSIZE)) {
1419 $props->{'block_size'} = {
1424 # convert the length from kb to bytes here
1425 tapetype_getconf($tapetype, $TAPETYPE_BLOCKSIZE) * 1024,