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 );
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);
67 All operations in the module return immediately, and take as an argument a
68 callback function which will indicate completion of the changer operation -- a
69 kind of continuation. The caller should run a main loop (see
70 L<Amanda::MainLoop>) to allow the interactions with the changer script to
73 A new object is created with the C<new> function as follows:
75 my $chg = Amanda::Changer->new($changer_name,
76 tapelist => $tapelist,
77 labelstr => $labelstr,
78 autolabel => $autolabel,
79 meta_autolabel => $meta_autolabel);
81 to create a named changer (a name provided by the user, either specifying a
82 changer directly or specifying a changer definition), or
84 my $chg = Amanda::Changer->new(undef,
85 tapelist => $tapelist,
86 labelstr => $labelstr,
87 autolabel => $autolabel,
88 meta_autolabel => $meta_autolabel);
90 to run the default changer. This function handles the many ways a user can
93 If there is a problem creating the new object, then the resulting object will
94 be a fatal C<Error> object (described below). Thus the usual recipe for
95 creating a new changer is
97 my $chg = Amanda::Changer->new($changer_name);
98 if ($chg->isa("Amanda::Changer::Error")) {
99 die("Error creating changer $changer_name: $chg");
102 C<tapelist> must be an Amanda::Tapelist object. It is required if you want to
103 use $chg->volume_is_labelable(), $chg->make_new_tape_label(),
104 $chg->make_new_meta_label(), $res->make_new_tape_label() or
105 $res->make_new_meta_label().
106 C<labelstr> must be like getconf($CNF_LABELSTR), that value is used if C<labelstr> is not set.
107 C<autolabel> must be like getconf($CNF_AUTOLABEL), that value is used if C<autolabel> is not set.
108 C<meta_autolabel> must be like getconf($CNF_META_AUTOLABEL), that value is used if C<meta_autolabel> is not set.
109 =head2 MEMBER VARIABLES
111 Note that these variables are not set until after the subclass constructor is
116 =item C<< $chg->{'chg_name'} >>
118 Gives the name of the changer. This name will make sense to the user, but will
119 not necessarily form a valid changer specification. It should be used to
120 describe the changer in messages to the user.
126 All changer callbacks take an error object as the first parameter. If no error
127 occurred, then this parameter is C<undef> and the remaining parameters are
130 A res_cb C<$cb> is called back as:
132 $cb->($error, undef);
134 in the event of an error, or
136 $cb->(undef, $reservation);
138 with a successful reservation. res_cb must always be specified. A finished_cb
139 C<$cb> is called back as
143 in the event of an error, or
147 on success. A finished_cb may be omitted if no notification of completion is
150 Other callback types are defined below.
154 When a callback is made with an error, it is an object of type
155 C<Amanda::Changer::Error>. When interpolated into a string, this object turns
156 into a simple error message. However, it has some additional methods that can
157 be used to determine how to respond to the error. First, the error message is
158 available explicitly as C<< $err->message >>. The error type is available as
159 C<< $err->{'type'} >>, although checks for particular error types should use
160 the C<TYPE> methods instead, as perl is better able to detect typos with this
163 if ($err->failed) { ... }
167 fatal Changer is no longer useable
168 failed Operation failed, but the changer is OK
170 The API may add other error types in the future (for example, to indicate
171 that a required resource is already reserved).
173 Errors of the type C<fatal> indicate that the changer should not be used any
174 longer, and in most cases the caller should terminate abnormally. For example,
175 configuration or hardware errors are generally fatal.
177 If an operation fails, but the changer remains viable, then the error type is
178 C<failed>. The reason for the failure is usually clear to the user from the
179 message, but for callers who may need to distinguish, C<< $err->{'reason'} >>
180 has one of the following values:
182 notfound The requested volume was not found
183 invalid The caller's request was invalid (e.g., bad slot)
184 notimpl The requested operation is not supported
185 volinuse The requested volume or slot is already in use
186 driveinuse All drives are in use
187 unknown Unknown reason
188 empty The slot is empty
190 Like types, checks for particular reasons should use the methods, to avoid
193 if ($err->failed and $err->notimpl) { ... }
195 Other reasons may be added in the future, so a caller should check for the
196 reasons it expects, and treat any other failures as of unknown cause.
198 When the desired slot cannot be loaded because it is already in use, the
199 C<volinuse> error comes with an extra parameter, C<slot>, giving the slot in
200 question. This parameter is not defined for other cases.
204 Changers maintain a global concept of a "current" slot, for compatibility with
205 Amanda algorithms such as the taperscan. However, it is not compatible with
206 concurrent use of the same changer, and may be inefficient for some changers,
207 so new algorithms should avoid using it, preferring instead to load the correct
208 tape immediately (with C<load>), and to progress from tape to tape using the
209 C<relative_slot> parameter to C<load>.
211 =head2 CHANGER OBJECTS
215 To terminate a changer object.
219 The most common operation with a tape changer is to load a volume. The C<load>
220 method is heavily overloaded to support a number of different ways to specify a
223 In general, the method takes a C<res_cb> giving a callback that will receive
224 the reservation. If set_current is specified and true, then the changer's
225 current slot should be updated to correspond to C<$slot>. If not, then the changer
226 should not update its current slot (but some changers will anyway -
227 specifically, chg-compat).
229 The load method always read the label if it succeed to load a volume.
231 The optional C<mode> describes the intended use of the volume by the caller,
232 and should be one of C<"read"> (the default) or C<"write">. Changers managing
233 WORM media may use this parameter to provide a fresh volume for writing, but to
234 search for already-written volumes when reading.
236 The load method has a number of permutations:
238 $chg->load(res_cb => $cb,
243 Load and reserve a volume with the given label. This may leverage any barcodes
244 or other indices that the changer has available.
246 Note that the changer I<tries> to load the requested volume, but it's a mean
247 world out there, and you may not get what you want, so check the label on the
248 loaded volume before getting started.
250 $chg->load(res_cb => $cb,
255 Load and reserve the volume in the given slot. C<$slot> is a string specifying the slot
256 to load, provided by the user or from some other invocation of this changer.
257 Note that slots are not necessarily numeric, so performing arithmetic on this
260 If the slot does not exist, C<res_cb> will be called with a C<notfound> error.
261 Empty slots are considered empty.
263 $chg->load(res_cb => $cb,
264 relative_slot => "current",
267 Reserve the volume in the "current" slot. This is used by the traditional
268 taperscan algorithm to begin its search.
270 $chg->load(res_cb => $cb,
271 relative_slot => "next",
273 except_slots => { %except_slots },
277 Reserve the volume that follows the given slot or, if C<slot> is omitted, the
278 volume that follows the current slot. This will skip empty slots as if they
279 were not present in the changer.
281 The optional C<except_slots> argument specifies a hash of slots that should
282 I<not> be loaded. Keys are slot names, and the hash values are ignored. This
283 is useful as a termination condition when scanning all of the slots in a
284 changer: keep a hash of all slots already loaded, and pass that hash in
285 C<except_slots>. When the load operation returns a C<notfound> error, the scan
290 $chg->info(info_cb => $cb,
291 info => [ $key1, $key2, .. ])
293 Query the changer for miscellaneous information. Any number of keys may be
294 specified. The C<info_cb> is called with C<$error> as the first argument,
295 much like a C<res_cb>, but the remaining arguments form a hash giving values
296 for all of the requested keys that are supported by the changer. The preamble
297 to such a callback is usually
300 my ($error, %results) = @_;
310 The total number of slots in the changer device. If this key is not present or
311 -1, then the device cannot determine its slot count (for example, an archival
312 device that names slots by timestamp could potentially run until the heat-death
317 A string describing the name and model of the changer device.
321 If true, then this changer implements searching (loading by label) with
322 something more efficient than a sequential scan through the volumes. This
323 information affects some taperscan algorithms and recovery programs, which may
324 choose to do their own manual scan instead of invoking many potentially slow
331 $chg->reset(finished_cb => $cb)
333 Reset the changer to a "base" state. This will generally reset the "current"
334 slot to something the user would think of as the "first" tape, unload any
335 loaded drives, etc. It is an error to call this while any reservations are
340 $chg->clean(finished_cb => $cb,
343 Clean a drive, if the changer supports it. Drivename can be omitted for devices
344 with only one drive, or can be an arbitrary string from the user (e.g., an
345 amtape argument). Note that some changers cannot detect the completion of a
346 cleaning cycle; in this case, the user will just need to delay further Amanda
347 activities until the cleaning is complete.
351 $chg->eject(finished_cb => $cb,
354 Eject the volume in a drive, if the changer supports it. Drivename is as
355 specified to C<clean>. If possible, applications should prefer to eject a
356 reserved volume when finished with it (C<< $res->release(eject => 1) >>), to
357 ensure that the correct volume is ejected from a multi-drive changer.
361 $chg->update(finished_cb => $cb,
365 The user has changed something -- loading or unloading tapes, reconfiguring the
366 changer, etc. -- that may have invalidated the database. C<$changed> is a
367 changer-specific string indicating what has changed; if it is omitted, the
368 changer will check everything.
370 Since updates can take a long time, and users often want to know what's going
371 on, the update method will call C<user_msg_fn>, if specified, with
372 user-oriented messages appropriate to the changer.
376 $chg->inventory(inventory_cb => $cb)
378 The C<inventory_cb> is called with an error object as the first parameter, or
379 C<undef> if no error occurs. The second parameter is an arrayref containing an
380 ordered list of information about the slots in the changer. The order never
381 change, but some entries can be added or removed.
383 Each slot is represented by a hash with the following keys:
385 =head3 make_new_tape_label
387 $chg->make_new_tape_label(barcode => $barcode,
391 To devise a new name for a volume using the C<barcode> and C<meta> arguments.
392 This will return C<undef> if no label could be created.
394 =head3 make_new_meta_label
396 $chg->make_new_meta_label();
398 To devise a new meta name for a meta volume.
399 This will return C<undef> if no label could be created.
401 =head3 have_inventory
403 $chg->have_inventory()
405 Return True if the changer have the inventory method.
407 =head3 volume_is_labelable
409 $chg->volume_is_labelable($device_status, $f_type, $label);
411 Return 1 if the volume is labelable acording to the autolabel setting.
421 Set to C<1> if it is the current slot.
425 Set to C<SLOT_FULL> if the slot is full, C<SLOT_EMPTY> if the slot is empty (no
426 volume in slot), C<SLOT_UNKNOWN> if the changer doesn't know if the slot is full
427 or not (but it can know), or undef if the changer can't know if the slot is full or not.
428 A changer that doesn't keep state must set it to undef, like chg-single.
429 These constants are available in the C<:constants> export tag.
431 A blank or erased volume is not the same as an empty slot.
435 The device status after the open or read_label, undef if device status is unknown.
439 The file header type as returned by read_label, only if device_status is DEVICE_STATUS_SUCCESS.
443 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.
445 =item barcode (optional)
447 The barcode for the volume in this slot, if barcodes are available.
451 Set to C<1> if this slot is reserved, either by this process or another
452 process. This is only set for I<exclusive> reservations, meaning that loading
453 the slot would result in an C<volinuse> error. Devices which can support
454 concurrent access will never set this flag.
456 =item loaded_in (optional)
458 For changers which have distinct user-visible drives, this gives the drive
459 currently accessing the volume in this slot.
461 =item import_export (optional)
463 Set to C<1> if this is an import-export slot -- a slot in which the user can
464 easily add or remove volumes. This information may be useful for operations to
465 bulk-import newly-inserted tapes or bulk-export a set of tapes.
471 $chg->move(finished_cb => $cb,
475 Move a volume between two slots in the changer. These slots are provided by the
476 user, and have meaning for the changer.
478 =head2 RESERVATION OBJECTS
484 This is the changer object.
486 =head3 $res->{'device'}
488 This is the fully configured device for the reserved volume. The device is not
491 =head3 $res->{'this_slot'}
493 This is the name of this slot. It is an arbitrary string which will
494 have some meaning to the changer's C<load()> method. It is safe to
495 access this field after the reservation has been released.
497 =head3 $res->{'barcode'}
499 If this changer supports barcodes, then this is the barcode of the reserved
500 volume. This can be helpful for labeling tapes using their barcode.
502 =head3 $label = $res->make_new_tape_label()
504 To devise a new name for a volume.
505 This will return C<undef> if no label could be created.
507 =head3 $meta = $res->make_new_meta_label()
509 To devise a new meta name for a meta volume.
510 This will return C<undef> if no label could be created.
512 =head3 $res->release(finished_cb => $cb, eject => $eject)
514 This is how an Amanda application indicates that it no longer needs the
515 reserved volume. The callback is called after any related operations are
516 complete -- possibly immediately. Some drives and changers have a notion of
517 "ejecting" a volume, and some don't. In particular, a manual changer can cause
518 the tape drive to eject the tape, while a tape robot can move a tape back to
519 storage, leaving the drive empty. If the eject parameter is given and true, it
520 indicates that Amanda is done with the volume and has reason to believe the
521 user is done with the volume, too -- for example, when a tape has been written
524 A reservation will be released automatically when the object is destroyed, but
525 in this case no finished_cb is given, so the release operation may not complete
526 before the process exits. Wherever possible, reservations should be explicitly
529 =head3 $res->set_label(finished_cb => $cb, label => $label)
531 This is how Amanda indicates to the changer that the volume in the device has
532 been (re-)labeled. Changers can keep a database of volume labels by slot or by
533 barcode, or just ignore this function and call $cb immediately. Note that the
534 reservation must still be held when this function is called.
536 =head1 SUBCLASS HELPERS
538 C<Amanda::Changer> implements some methods and attributes to help subclass
543 Implementing the C<info> method can be tricky, because it can potentially request
544 a number of keys that require asynchronous access. The C<info> implementation in
545 this class may make the process a bit easier.
547 First, if the method C<info_setup> is defined, C<info> calls it, passing it a
548 C<finished_cb> and the list of desired keys, C<info>. This method is useful to
549 gather information that is useful for several info keys.
551 Next, for each requested key, C<info> calls
553 $self->info_key($key, %params)
555 including a regular C<info_cb> callback. The C<info> method will wait for
556 all C<info_key> invocations to finish, then collect the results or errors that
559 =head2 ERROR HANDLING
561 To create a new error object, use C<< $self->make_error($type, $cb, %args) >>.
562 This method will create a new C<Amanda::Changer::Error> object and optionally
563 invoke a callback with it. If C<$type> is C<fatal>, then
564 C<< $chg->{'fatal_error'} >> is made a reference to the new error object. The
565 callback C<$cb> (which should be made using C<make_cb()> from
566 C<Amanda::MainLoop>) is called with the new error object. The C<%args> are
567 added to the new error object. In use, this looks something like:
570 return $self->make_error("failed", $params{'res_cb'},
571 reason => "notfound",
572 message => "Volume '$label' not found");
575 This method can also be called as a class method, e.g., from a constructor.
576 In this case, it returns the resulting error object, which should be fatal.
579 return Amanda::Changer->make_error("fatal", undef,
580 message => "config error");
583 For cases where a number of errors have occurred, it is helpful to make a
584 "combined" error. The method C<make_combined_error> takes care of this
585 operation, given a callback and an array of tuples C<[ $description, $err ]>
586 for each error. This method uses some heuristics to figure out the
587 appropriate type and reason for the combined error.
589 if ($left_err and $right_err) {
590 return $self->make_combined_error($params{'finished_cb'},
591 [ [ "from the left", $left_err ],
592 [ "from the right", $right_err ] ]);
595 Any additional keyword arguments to C<make_combined_error> are put into the
596 combined error; this is useful to set the C<slot> attribute.
598 The method C<< $self->check_error($cb) >> is a useful method for subclasses to
599 avoid doing anything after a fatal error. This method checks
600 C<< $self->{'fatal_error'} >>. If the error is defined, the method calls C<$cb>
601 and returns true. The usual recipe is
607 return if $self->check_error($params{'res_cb'});
613 C<Amanda::Changer->new> calls subclass constructors with two parameters: a
614 configuration object and a changer specification. The changer specification is
615 the string that led to creation of this changer device. The configuration
616 object is of type C<Amanda::Changer::Config>, and can be treated as a hashref
617 with the following keys:
619 name -- name of the changer section (or "default")
620 is_global -- true if this changer is the default changer
621 tapedev -- tapedev parameter
622 tpchanger -- tpchanger parameter
623 changerdev -- changerdev parameter
624 changerfile -- changerfile parameter
625 properties -- all properties for this changer
626 device_properties -- device properties from this changer
628 The four parameters are just as supplied by the user, either in the global
629 config or in a changer section. Changer authors are cautioned not to try to
630 override any of these parameters as previous changers have done (e.g.,
631 C<changerfile> specifying both configuration and state files). Use properties
634 The C<properties> and C<device_properties> parameters are in the format
635 provided by C<Amanda::Config>. If C<is_global> is true, then
636 C<device_properties> will include any device properties specified globally, as
637 well as properties culled from the global tapetype.
639 The C<configure_device> method generally takes care of the intricacies of
640 handling device properties. Pass it a newly opened device and it will apply
641 the relevant properties, returning undef on success or an error message on
644 The C<get_property> method is a shortcut method to get the value of a changer
645 property, ignoring its the priority and other attributes. In a list context,
646 it returns all values for the property; in a scalar context, it returns the
647 first value specified.
649 Many properties are boolean, and Amanda has a habit of accepting a number of
650 different ways of writing boolean values. The method
651 C<< $config->get_boolean_property($prop, $default) >> will parse such a
652 property, returning 0 or 1 if the property is specified, C<$default> if it is
653 not specified, or C<undef> if the property cannot be parsed.
655 =head2 PERSISTENT STATE AND LOCKING
657 Many changer subclasses need to track state across invocations and between
658 different processes, and to ensure that the state is read and written
659 atomically. The C<with_locked_state> provides this functionality by
660 locking a statefile, only unlocking it after any changes have been written back
661 to it. Subclasses can use this method both for mutual exclusion (ensuring that
662 only one changer operation is in progress at any time) and for atomic state
665 The C<with_locked_state> method works like C<synchronized> (in
666 L<Amanda::MainLoop>), but with some extra arguments:
668 $self->with_locked_state($filename, $some_cb, sub {
669 # note: $some_cb shadows outer $some_cb; see Amanda::MainLoop::synchronized
670 my ($state, $some_cb) = @_;
671 # ... and eventually:
675 The callback C<$some_cb> is assumed to take a changer error as its first
676 argument, and if there are any errors locking the statefile, they will be
677 reported directly to this callback. Otherwise, a wrapped version of
678 C<$some_cb> is passed to the inner C<sub>. When this wrapper is invoked, the
679 state will be written to disk and unlocked before the original callback is
682 The state itself begins as an empty hashref, but subclasses can add arbitrary
683 keys to the hash. Serialization is currently handled with L<Data::Dumper>.
685 =head2 PARAMETER VALIDATION
687 The C<validate_params> method is useful to make sure that the proper parameters
688 are present for a particular method, dying if not. Call it like this:
690 $self->validate_params("load", \%params);
692 The method currently only supports the "load" method, but can be expanded to
697 The Amanda Wiki (http://wiki.zmanda.com) has a higher-level description of the
698 changer model implemented by this package.
700 See amanda-changers(7) for user-level documentation of the changer implementations.
704 # constants for the states that slots may be in; note that these states still
705 # apply even if the tape is actually loaded in a drive
707 # slot is known to contain a volume
708 use constant SLOT_FULL => 1;
710 # slot is known to contain no volume
711 use constant SLOT_EMPTY => 2;
713 # don't known if slot contains a volume
714 use constant SLOT_UNKNOWN => 3;
716 our @EXPORT_OK = qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN );
718 constants => [ qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN ) ],
721 # this is a "virtual" constructor which instantiates objects of different
722 # classes based on its argument. Subclasses should not try to chain up!
724 shift eq 'Amanda::Changer'
725 or die("Do not call the Amanda::Changer constructor from subclasses");
730 # creating a named changer is a bit easier
731 if (defined($name)) {
732 # first, is it a changer alias?
733 if (($uri,$cc) = _changer_alias_to_uri($name)) {
734 return _new_from_uri($uri, $cc, $name, %params);
737 # maybe a straight-up changer URI?
738 if (_uri_to_pkgname($name)) {
739 return _new_from_uri($name, undef, $name, %params);
742 # assume it's a device name or alias, and invoke the single-changer
743 return _new_from_uri("chg-single:$name", undef, $name, %params);
744 } else { # !defined($name)
745 if ((getconf_linenum($CNF_TPCHANGER) == -2 ||
746 (getconf_seen($CNF_TPCHANGER) &&
747 getconf_linenum($CNF_TAPEDEV) != -2)) &&
748 getconf($CNF_TPCHANGER) ne '') {
749 my $tpchanger = getconf($CNF_TPCHANGER);
751 # first, is it an old changer script?
752 if ($uri = _old_script_to_uri($tpchanger)) {
753 return _new_from_uri($uri, undef, $tpchanger, %params);
756 # if not, then there had better be no tapdev
757 if (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '' and
758 ((getconf_linenum($CNF_TAPEDEV) > 0 and
759 getconf_linenum($CNF_TPCHANGER) > 0) ||
760 (getconf_linenum($CNF_TAPEDEV) == -2))) {
761 return Amanda::Changer::Error->new('fatal',
762 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
763 "unless using an old-style changer script");
766 # maybe a changer alias?
767 if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
768 return _new_from_uri($uri, $cc, $tpchanger, %params);
771 # maybe a straight-up changer URI?
772 if (_uri_to_pkgname($tpchanger)) {
773 return _new_from_uri($tpchanger, undef, $tpchanger, %params);
776 # assume it's a device name or alias, and invoke the single-changer
777 return _new_from_uri("chg-single:$tpchanger", undef, $tpchanger, %params);
778 } elsif (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '') {
779 my $tapedev = getconf($CNF_TAPEDEV);
781 # first, is it a changer alias?
782 if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
783 return _new_from_uri($uri, $cc, $tapedev, %params);
786 # maybe a straight-up changer URI?
787 if (_uri_to_pkgname($tapedev)) {
788 return _new_from_uri($tapedev, undef, $tapedev, %params);
791 # assume it's a device name or alias, and invoke chg-single.
792 # chg-single will check the device immediately and error out
793 # if the device name is invalid.
794 return _new_from_uri("chg-single:$tapedev", undef, $tapedev, %params);
796 return Amanda::Changer::Error->new('fatal',
797 message => "You must specify one of 'tapedev' or 'tpchanger'");
805 debug("Changer '$self->{'chg_name'}' not quit") if defined $self->{'chg_name'};
812 foreach (keys %$self) {
817 # helper functions for new
819 sub _changer_alias_to_uri {
822 my $cc = Amanda::Config::lookup_changer_config($name);
824 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
826 if (my $uri = _old_script_to_uri($tpchanger)) {
831 my $seen_tpchanger = changer_config_seen($cc, $CHANGER_CONFIG_TPCHANGER);
832 my $seen_tapedev = changer_config_seen($cc, $CHANGER_CONFIG_TAPEDEV);
833 if ($seen_tpchanger and $seen_tapedev) {
834 return Amanda::Changer::Error->new('fatal',
835 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
836 "**unless using an old-style changer script");
838 if (!$seen_tpchanger and !$seen_tapedev) {
839 return Amanda::Changer::Error->new('fatal',
840 message => "You must specify one of 'tapedev' or 'tpchanger'");
842 $tpchanger ||= changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
844 if (_uri_to_pkgname($tpchanger)) {
845 return ($tpchanger, $cc);
847 die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
855 sub _old_script_to_uri {
858 die("empty changer script name") unless $name;
860 if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
861 return "chg-compat:$name"
868 # try to load the package for the given URI. $@ is set properly
869 # if this function returns a false value.
870 sub _uri_to_pkgname {
873 my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
874 if (!defined $type) {
875 $@ = "'$name' is not a changer URI";
879 $type =~ tr/A-Z-/a-z_/;
881 # create a package name to see if it's already imported
882 my $pkgname = "Amanda::Changer::$type";
883 my $filename = $pkgname;
884 $filename =~ s|::|/|g;
886 return $pkgname if (exists $INC{$filename});
889 eval "use $pkgname;";
893 # determine whether the module doesn't exist at all, or if there was an
894 # error loading it; die if we found a syntax error
895 if (exists $INC{$filename} or $err =~ /did not return a true value/) {
905 sub _new_from_uri { # (note: this sub is patched by the installcheck)
911 # as a special case, if the URI came back as an error, just pass
912 # that along. This lets the _xxx_to_uri methods return errors more
914 if (ref $uri and $uri->isa("Amanda::Changer::Error")) {
918 # make up a key for our hash of already-instantiated objects,
919 # using a newline as a separator, since perl can't use tuples
921 my $uri_cc = "$uri\n";
923 $uri_cc = $uri_cc . changer_config_name($cc);
926 # return a pre-existing changer, if possible
928 # look up the type and load the class
929 my $pkgname = _uri_to_pkgname($uri);
934 my $rv = eval {$pkgname->new(Amanda::Changer::Config->new($cc), $uri);};
935 die "$pkgname->new return undef" if $@;
936 die "$pkgname->new did not return an Amanda::Changer object or an Amanda::Changer::Error"
937 unless ($rv->isa("Amanda::Changer") or $rv->isa("Amanda::Changer::Error"));
939 if ($rv->isa("Amanda::Changer::Error")) {
943 if ($rv->isa("Amanda::Changer")) {
944 # add an instance variable or two
945 $rv->{'fatal_error'} = undef;
948 $rv->{'tapelist'} = $params{'tapelist'};
949 $rv->{'autolabel'} = $params{'autolabel'};
950 $rv->{'autolabel'} = getconf($CNF_AUTOLABEL)
951 unless defined $rv->{'autolabel'};
952 $rv->{'labelstr'} = $params{'labelstr'};
953 $rv->{'labelstr'} = getconf($CNF_LABELSTR)
954 unless defined $rv->{'labelstr'};
955 $rv->{'meta_autolabel'} = $params{'meta_autolabel'};
956 $rv->{'meta_autolabel'} = getconf($CNF_META_AUTOLABEL)
957 unless defined $rv->{'meta_autolabel'};
958 $rv->{'chg_name'} = $name;
962 # method stubs that return a "notimpl" error
965 my ($op, $cbname, $self, %params) = @_;
966 return if $self->check_error($params{$cbname});
968 my $class = ref($self);
969 my $chg_foo = "chg-" . ($class =~ /Amanda::Changer::(.*)/)[0];
970 return $self->make_error("failed", $params{$cbname},
972 message => "'$chg_foo:' does not support $op");
975 sub load { _stubop("loading volumes", "res_cb", @_); }
976 sub reset { _stubop("reset", "finished_cb", @_); }
977 sub clean { _stubop("clean", "finished_cb", @_); }
978 sub eject { _stubop("eject", "finished_cb", @_); }
979 sub update { _stubop("update", "finished_cb", @_); }
980 sub inventory { _stubop("inventory", "inventory_cb", @_); }
981 sub move { _stubop("move", "finished_cb", @_); }
982 sub set_meta_label { _stubop("set_meta_label", "finished_cb", @_); }
983 sub get_meta_label { _stubop("get_meta_label", "finished_cb", @_); }
988 return $self->can("inventory") ne \&Amanda::Changer::inventory;
991 # info calls out to info_setup and info_key; see POD above
996 if (!$self->can('info_key')) {
997 my $class = ref($self);
998 $params{'info_cb'}->("$class does not support info()");
1002 my ($do_setup, $start_keys, $all_done);
1005 if ($self->can('info_setup')) {
1006 $self->info_setup(info => $params{'info'},
1007 finished_cb => sub {
1010 $params{'info_cb'}->($err);
1021 my $remaining_keys = 1;
1024 my $maybe_done = sub {
1025 return if (--$remaining_keys);
1026 $all_done->(%key_results);
1029 for my $key (@{$params{'info'}}) {
1031 $self->info_key($key, info_cb => sub {
1032 $key_results{$key} = [ @_ ];
1037 # we started with $remaining_keys = 1, so decrement it now
1042 my %key_results = @_;
1044 # if there are *any* errors, handle them
1045 my @annotated_errs =
1046 map { [ sprintf("While getting info key '%s'", $_), $key_results{$_}->[0] ] }
1047 grep { defined($key_results{$_}->[0]) }
1050 if (@annotated_errs) {
1051 return $self->make_combined_error(
1052 $params{'info_cb'}, [ @annotated_errs ]);
1055 # no errors, so combine the results and return them
1057 while (my ($key, $result) = each(%key_results)) {
1058 my ($err, %key_info) = @$result;
1059 if (exists $key_info{$key}) {
1060 $info{$key} = $key_info{$key};
1062 warn("No value available for $key");
1066 $params{'info_cb'}->(undef, %info);
1076 my ($type, $cb, %args) = @_;
1078 my $classmeth = $self eq "Amanda::Changer";
1080 if ($classmeth and $type ne 'fatal') {
1081 cluck("type must be fatal when calling make_error as a class method");
1085 my $err = Amanda::Changer::Error->new($type, %args);
1088 $self->{'fatal_error'} = $err
1097 sub make_combined_error {
1099 my ($cb, $suberrors, %extra_args) = @_;
1102 if (@$suberrors == 0) {
1103 die("make_combined_error called with no errors");
1106 my $classmeth = $self eq "Amanda::Changer";
1108 # if there's only one suberror, just use it directly
1109 if (@$suberrors == 1) {
1110 $err = $suberrors->[0][1];
1111 die("$err is not an Error object")
1112 unless defined($err) and $err->isa("Amanda::Changer::Error");
1114 $err = Amanda::Changer::Error->new(
1116 reason => $err->{'reason'},
1117 message => $suberrors->[0][0] . ": " . $err->{'message'});
1119 my $fatal = $classmeth or grep { $_->[1]{'fatal'} } @$suberrors;
1124 map { ($_->[1]{'reason'}, undef) }
1125 grep { $_->[1]{'reason'} }
1127 if ((keys %reasons) == 1) {
1128 $reason = (keys %reasons)[0];
1130 $reason = 'unknown'; # multiple or 0 "source" reasons
1134 my $message = join("; ",
1135 map { sprintf("%s: %s", @$_) }
1138 my %errargs = ( message => $message, %extra_args );
1139 $errargs{'reason'} = $reason unless ($fatal);
1140 $err = Amanda::Changer::Error->new(
1141 $fatal? "fatal" : "failed",
1146 $self->{'fatal_error'} = $err
1159 if (defined $self->{'fatal_error'}) {
1160 $cb->($self->{'fatal_error'}) if $cb;
1165 sub lock_statefile {
1169 my $statefile = $params{'statefile_filename'};
1170 my $lock_cb = $params{'lock_cb'};
1171 Amanda::Changer::StateFile->new($statefile, $lock_cb);
1174 sub with_locked_state {
1176 my ($statefile, $cb, $sub) = @_;
1177 my ($filelock, $STATE);
1178 my $poll = 0; # first delay will be 0.1s; see below
1180 my $steps = define_steps
1184 $filelock = Amanda::Util::file_lock->new($statefile);
1186 $steps->{'lock'}->();
1190 my $rv = $filelock->lock();
1192 # loop until we get the lock, increasing $poll to 10s
1193 $poll += 100 unless $poll >= 10000;
1194 return Amanda::MainLoop::call_after($poll, $steps->{'lock'});
1195 } elsif ($rv == -1) {
1196 return $self->make_error("fatal", $cb,
1197 message => "Error locking '$statefile'");
1200 $steps->{'read'}->();
1204 my $contents = $filelock->data();
1208 # $fh goes out of scope here, and is thus automatically
1210 return $cb->("error reading '$statefile': $@", undef);
1212 if (!defined $STATE or ref($STATE) ne 'HASH') {
1213 return $cb->("'$statefile' did not define \$STATE properly", undef);
1216 # initial state (blank file)
1220 $sub->($STATE, $steps->{'cb_wrap'});
1223 step cb_wrap => sub {
1226 my $dumper = Data::Dumper->new([ $STATE ], ["STATE"]);
1228 $filelock->write($dumper->Dump);
1229 $filelock->unlock();
1231 # call through to the original callback with the original
1237 sub validate_params {
1238 my ($self, $op, $params) = @_;
1240 if ($op eq 'load') {
1241 unless(exists $params->{'label'} || exists $params->{'slot'} ||
1242 exists $params->{'relative_slot'}) {
1243 confess "Invalid parameters to 'load'";
1246 confess "don't know how to validate '$op'";
1250 sub make_new_tape_label {
1254 my $tl = $self->{'tapelist'};
1255 die ("make_new_tape_label: no tapelist") if !$tl;
1256 return undef if !defined $self->{'autolabel'}->{'template'};
1257 return undef if !defined $self->{'labelstr'};
1258 my $template = $self->{'autolabel'}->{'template'};
1259 my $labelstr = $self->{'labelstr'};
1263 return (undef, "template is not set, you must set autolabel");
1265 $template =~ s/\$\$/SUBSTITUTE_DOLLAR/g;
1266 $template =~ s/\$b/SUBSTITUTE_BARCODE/g;
1267 $template =~ s/\$m/SUBSTITUTE_META/g;
1268 $template =~ s/\$o/SUBSTITUTE_ORG/g;
1269 $template =~ s/\$c/SUBSTITUTE_CONFIG/g;
1270 if ($template =~ /\$([0-9]*)s/) {
1272 $slot_digit = 1 if $slot_digit < 1;
1273 $template =~ s/\$[0-9]*s/SUBSTITUTE_SLOT/g;
1276 my $org = getconf($CNF_ORG);
1277 my $config = Amanda::Config::get_config_name();
1278 my $barcode = $params{'barcode'};
1279 $barcode = '' if !defined $barcode;
1280 my $meta = $params{'meta'};
1281 my $slot = $params{'slot'};
1282 $slot = '' if !defined $slot;
1283 $meta = $self->make_new_meta_label(%params) if !defined $meta;
1284 $meta = '' if !defined $meta;
1286 $template =~ s/SUBSTITUTE_DOLLAR/\$/g;
1287 $template =~ s/SUBSTITUTE_ORG/$org/g;
1288 $template =~ s/SUBSTITUTE_CONFIG/$config/g;
1289 $template =~ s/SUBSTITUTE_META/$meta/g;
1290 # Do not susbtitute the barcode and slot now
1293 $template) =~ s/[^%]*(%+)[^%]*/length($1)/e;
1294 $npercents = 0 if $npercents eq $template;
1297 if ($npercents == 0) {
1299 $label =~ s/SUBSTITUTE_BARCODE/$barcode/g;
1300 if ($template =~ /SUBSTITUTE_SLOT/) {
1301 my $slot_label = sprintf("%0*d", $slot_digit, $slot);
1302 $label =~ s/SUBSTITUTE_SLOT/$slot_label/g;
1304 if ($template =~ /SUBSTITUTE_BARCODE/ && !defined $barcode) {
1305 return (undef, "Can't generate new label because volume has no barcode");
1306 } elsif ($template =~ /SUBSTITUTE_SLOT/ && !defined $slot) {
1307 return (undef, "Can't generate new label because volume has no slot");
1308 } elsif ($label eq $template) {
1309 return (undef, "autolabel require at least one '%'");
1310 } elsif ($tl->lookup_tapelabel($label)) {
1311 return (undef, "Label '$label' already exists");
1314 # make up a sprintf pattern
1316 $template) =~ s/(%+)/"%0" . length($1) . "d"/e;
1318 my %existing_labels;
1319 for my $tle (@{$tl->{'tles'}}) {
1320 if (defined $tle && defined $tle->{'label'}) {
1321 my $tle_label = $tle->{'label'};
1322 my $tle_barcode = $tle->{'barcode'};
1323 if (defined $tle_barcode) {
1324 $tle_label =~ s/$tle_barcode/SUBSTITUTE_BARCODE/g;
1326 $existing_labels{$tle_label} = 1 if defined $tle_label;
1330 my $nlabels = 10 ** $npercents;
1332 for ($i = 1; $i < $nlabels; $i++) {
1333 $label = sprintf($sprintf_pat, $i);
1334 last unless (exists $existing_labels{$label});
1337 # susbtitute the barcode and slot
1338 $label =~ s/SUBSTITUTE_BARCODE/$barcode/g;
1339 if ($template =~ /SUBSTITUTE_SLOT/) {
1340 my $slot_label = sprintf("%0*d", $slot_digit, $slot);
1341 $label =~ s/SUBSTITUTE_SLOT/$slot_label/g;
1344 # bail out if we didn't find an unused label
1345 return (undef, "Can't label unlabeled volume: All label used")
1346 if ($i >= $nlabels);
1349 # verify $label matches $labelstr
1350 if ($label !~ /$labelstr/) {
1351 return (undef, "Newly-generated label '$label' does not match labelstr '$labelstr'");
1355 return (undef, "Generated label is empty");
1361 sub make_new_meta_label {
1365 my $tl = $self->{'tapelist'};
1366 die ("make_new_meta_label: no tapelist") if !$tl;
1367 return undef if !defined $self->{'meta_autolabel'};
1368 my $template = $self->{'meta_autolabel'};
1369 return if !defined $template;
1372 return (undef, "template is not set, you must set meta-autolabel");
1374 $template =~ s/\$\$/SUBSTITUTE_DOLLAR/g;
1375 $template =~ s/\$o/SUBSTITUTE_ORG/g;
1376 $template =~ s/\$c/SUBSTITUTE_CONFIG/g;
1378 my $org = getconf($CNF_ORG);
1379 my $config = Amanda::Config::get_config_name();
1381 $template =~ s/SUBSTITUTE_DOLLAR/\$/g;
1382 $template =~ s/SUBSTITUTE_ORG/$org/g;
1383 $template =~ s/SUBSTITUTE_CONFIG/$config/g;
1386 $template) =~ s/[^%]*(%+)[^%]*/length($1)/e;
1387 $npercents = 0 if $npercents eq $template;
1388 my $nlabels = 10 ** $npercents;
1390 # make up a sprintf pattern
1391 (my $sprintf_pat = $template) =~ s/(%+)/"%0" . length($1) . "d"/e;
1393 my %existing_meta_labels =
1394 map { $_->{'meta'} => 1 } @{$tl->{'tles'}};
1397 for ($i = 1; $i < $nlabels; $i++) {
1398 $meta = sprintf($sprintf_pat, $i);
1399 last unless (exists $existing_meta_labels{$meta});
1402 # bail out if we didn't find an unused label
1403 return (undef, "Can't label unlabeled meta volume: All meta label used")
1404 if ($i >= $nlabels);
1407 return (undef, "Generated meta-label is empty");
1413 sub volume_is_labelable {
1415 my $dev_status = shift;
1418 my $autolabel = $self->{'autolabel'};
1420 if (!defined $dev_status) {
1422 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_UNLABELED and
1424 $f_type == $Amanda::Header::F_EMPTY) {
1425 return 0 if (!$autolabel->{'empty'});
1426 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_UNLABELED and
1428 $f_type == $Amanda::Header::F_WEIRD) {
1429 return 0 if (!$autolabel->{'non_amanda'});
1430 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_ERROR) {
1431 return 0 if (!$autolabel->{'volume_error'});
1432 } elsif ($dev_status != $DEVICE_STATUS_SUCCESS) {
1434 } elsif ($dev_status & $DEVICE_STATUS_SUCCESS and
1435 $f_type == $Amanda::Header::F_TAPESTART and
1436 $label !~ /$self->{'labelstr'}/) {
1437 return 0 if (!$autolabel->{'other_config'});
1443 package Amanda::Changer::Error;
1444 use Amanda::Debug qw( :logging );
1445 use Carp qw( cluck );
1448 '""' => sub { $_[0]->{'message'}; },
1449 'cmp' => sub { $_[0]->{'message'} cmp $_[1]; };
1451 my %known_err_types = map { ($_, 1) } qw( fatal failed );
1452 my %known_err_reasons = map { ($_, 1) } qw( notfound invalid notimpl driveinuse volinuse unknown device empty );
1455 my $class = shift; # ignore class
1456 my ($type, %info) = @_;
1459 $reason = ", reason='$info{reason}'" if $type eq "failed";
1460 debug("new Amanda::Changer::Error: type='$type'$reason, message='$info{message}'");
1462 $info{'type'} = $type;
1464 # do some sanity checks. Note that these sanity checks issue a warning
1465 # with cluck, but add default values to the error. This is in the hope
1466 # that an unusual Amanda error is not obscured by a problem in the
1467 # make_error invocation. The stack trace produced by cluck should help to
1468 # track down the bad make_error invocation.
1470 if (!exists $info{'message'}) {
1471 cluck("no message given to A::C::make_error");
1472 $info{'message'} = "unknown error";
1475 if (!exists $known_err_types{$type}) {
1476 cluck("invalid Amanda::Changer::Error type '$type'");
1480 if ($type eq 'failed' and !exists $info{'reason'}) {
1481 cluck("no reason given to A::C::make_error");
1482 $info{'reason'} = "unknown";
1485 if ($type eq 'failed' and !exists $known_err_reasons{$info{'reason'}}) {
1486 cluck("invalid Amanda::Changer::Error reason '$info{reason}'");
1487 $info{'reason'} = 'unknown';
1490 return bless (\%info, $class);
1493 # do nothing in quit
1497 sub fatal { $_[0]->{'type'} eq 'fatal'; }
1498 sub failed { $_[0]->{'type'} eq 'failed'; }
1501 sub notfound { $_[0]->failed && $_[0]->{'reason'} eq 'notfound'; }
1502 sub invalid { $_[0]->failed && $_[0]->{'reason'} eq 'invalid'; }
1503 sub notimpl { $_[0]->failed && $_[0]->{'reason'} eq 'notimpl'; }
1504 sub driveinuse { $_[0]->failed && $_[0]->{'reason'} eq 'driveinuse'; }
1505 sub volinuse { $_[0]->failed && $_[0]->{'reason'} eq 'volinuse'; }
1506 sub unknown { $_[0]->failed && $_[0]->{'reason'} eq 'unknown'; }
1507 sub empty { $_[0]->failed && $_[0]->{'reason'} eq 'empty'; }
1510 sub slot { $_[0]->{'slot'}; }
1512 package Amanda::Changer::Reservation;
1513 # this is a simple base class with stub method or two.
1514 use Amanda::Config qw( :getconf );
1521 return bless ($self, $class)
1526 if (!$self->{'released'}) {
1527 if (defined $self->{this_slot}) {
1528 Amanda::Debug::warning("Changer reservation for slot '$self->{this_slot}' has " .
1529 "gone out of scope without release");
1531 Amanda::Debug::warning("Changer reservation for unknown slot has " .
1532 "gone out of scope without release");
1541 # nothing to do by default: just call the finished callback
1542 if (exists $params{'finished_cb'}) {
1543 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1551 if ($self->{'released'}) {
1552 $params{'finished_cb'}->(undef) if exists $params{'finished_cb'};
1556 # always finish the device on release; it's illegal for anything
1557 # else to use the device after this point, anyway, so we want to
1558 # release the device's resources immediately
1559 if (defined $self->{'device'}) {
1560 $self->{'device'}->finish();
1563 $self->{'released'} = 1;
1564 $self->do_release(%params);
1571 # this is the one subclasses should override
1573 if (exists $params{'finished_cb'}) {
1574 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1578 sub get_meta_label {
1582 # this is the one subclasses should override
1584 if (exists $params{'finished_cb'}) {
1585 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1589 sub set_meta_label {
1593 # this is the one subclasses should override
1595 if (exists $params{'finished_cb'}) {
1596 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1600 sub make_new_tape_label {
1604 $params{'barcode'} = $self->{'barcode'} if !defined $params{'barcode'};
1605 $params{'meta'} = $self->{'meta'} if !defined $params{'meta'};
1606 $params{'slot'} = $self->{'this_slot'} if !defined $params{'slot'};
1607 return $self->{'chg'}->make_new_tape_label(%params);
1611 sub make_new_meta_label {
1615 return $self->{'chg'}->make_new_meta_label(%params);
1618 package Amanda::Changer::Config;
1619 use Amanda::Config qw( :getconf string_to_boolean );
1620 use Amanda::Device qw( :constants );
1626 my $self = bless {}, $class;
1629 $self->{'name'} = changer_config_name($cc);
1630 $self->{'is_global'} = 0;
1632 $self->{'tapedev'} = changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
1633 $self->{'tpchanger'} = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
1634 $self->{'changerdev'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERDEV);
1635 $self->{'changerfile'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERFILE);
1637 $self->{'properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_PROPERTY);
1638 $self->{'device_properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_DEVICE_PROPERTY);
1640 $self->{'name'} = "default";
1641 $self->{'is_global'} = 1;
1643 $self->{'tapedev'} = getconf($CNF_TAPEDEV);
1644 $self->{'tpchanger'} = getconf($CNF_TPCHANGER);
1645 $self->{'changerdev'} = getconf($CNF_CHANGERDEV);
1646 $self->{'changerfile'} = getconf($CNF_CHANGERFILE);
1648 # no changer or device properties, since there's no changer definition to use
1649 $self->{'properties'} = {};
1650 $self->{'device_properties'} = {};
1655 sub configure_device {
1659 # we'll accumulate properties in this hash *overwriting* previous properties
1660 # instead of appending to them
1663 # always use implicit properties
1664 %properties = ( %properties, %{ $self->_get_implicit_properties() } );
1666 # always use global properties
1667 %properties = ( %properties, %{ getconf($CNF_DEVICE_PROPERTY) } );
1669 # if this is a device alias, add properties from its device definition
1670 if (my $dc = lookup_device_config($device->device_name)) {
1671 %properties = ( %properties,
1672 %{ device_config_getconf($dc, $DEVICE_CONFIG_DEVICE_PROPERTY); } );
1675 # finally, add any props from the changer config
1676 %properties = ( %properties, %{ $self->{'device_properties'} } );
1678 while (my ($propname, $propinfo) = each(%properties)) {
1679 for my $value (@{$propinfo->{'values'}}) {
1680 if (!$device->property_set($propname, $value)) {
1682 if ($device->status == $DEVICE_STATUS_SUCCESS) {
1683 $msg = "Error setting '$propname' on device '".$device->device_name."'";
1685 $msg = $device->error() . " on device '".$device->device_name."'";
1687 if (exists $propinfo->{'optional'}) {
1688 if ($propinfo->{'optional'} eq 'warn') {
1689 warn("$msg (ignored)");
1703 my ($property) = @_;
1705 my $prophash = $self->{'properties'}->{$property};
1706 return undef unless defined($prophash);
1708 return wantarray? @{$prophash->{'values'}} : $prophash->{'values'}->[0];
1711 sub get_boolean_property {
1713 my ($propname, $default) = @_;
1716 unless (exists $self->{'properties'}->{$propname});
1718 my $propinfo = $self->{'properties'}->{$propname};
1719 return undef unless @{$propinfo->{'values'}} == 1;
1720 return string_to_boolean($propinfo->{'values'}->[0]);
1723 sub _get_implicit_properties {
1727 my $tapetype_name = getconf($CNF_TAPETYPE);
1728 return unless defined($tapetype_name);
1730 my $tapetype = lookup_tapetype($tapetype_name);
1731 return unless defined($tapetype);
1733 # The property hashes used here add the 'optional' key, which indicates
1734 # that the property is implicit and that a failure to set it is not fatal.
1735 # The flag is used by configure_device.
1736 if (tapetype_seen($tapetype, $TAPETYPE_LENGTH)) {
1737 $props->{'max_volume_usage'} = {
1742 tapetype_getconf($tapetype, $TAPETYPE_LENGTH) * 1024,
1746 if (tapetype_seen($tapetype, $TAPETYPE_READBLOCKSIZE)) {
1747 $props->{'read_block_size'} = {
1748 optional => "warn", # optional, but give a warning
1752 tapetype_getconf($tapetype, $TAPETYPE_READBLOCKSIZE) * 1024,
1756 if (tapetype_seen($tapetype, $TAPETYPE_BLOCKSIZE)) {
1757 $props->{'block_size'} = {
1762 # convert the length from kb to bytes here
1763 tapetype_getconf($tapetype, $TAPETYPE_BLOCKSIZE) * 1024,