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,
390 To devise a new name for a volume using the C<barcode> and C<meta> arguments.
391 This will return C<undef> if no label could be created.
393 =head3 make_new_meta_label
395 $chg->make_new_meta_label();
397 To devise a new meta name for a meta volume.
398 This will return C<undef> if no label could be created.
400 =head3 have_inventory
402 $chg->have_inventory()
404 Return True if the changer have the inventory method.
406 =head3 volume_is_labelable
408 $chg->volume_is_labelable($device_status, $f_type, $label);
410 Return 1 if the volume is labelable acording to the autolabel setting.
420 Set to C<1> if it is the current slot.
424 Set to C<SLOT_FULL> if the slot is full, C<SLOT_EMPTY> if the slot is empty (no
425 volume in slot), C<SLOT_UNKNOWN> if the changer doesn't know if the slot is full
426 or not (but it can know), or undef if the changer can't know if the slot is full or not.
427 A changer that doesn't keep state must set it to undef, like chg-single.
428 These constants are available in the C<:constants> export tag.
430 A blank or erased volume is not the same as an empty slot.
434 The device status after the open or read_label, undef if device status is unknown.
438 The file header type as returned by read_label, only if device_status is DEVICE_STATUS_SUCCESS.
442 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.
444 =item barcode (optional)
446 The barcode for the volume in this slot, if barcodes are available.
450 Set to C<1> if this slot is reserved, either by this process or another
451 process. This is only set for I<exclusive> reservations, meaning that loading
452 the slot would result in an C<volinuse> error. Devices which can support
453 concurrent access will never set this flag.
455 =item loaded_in (optional)
457 For changers which have distinct user-visible drives, this gives the drive
458 currently accessing the volume in this slot.
460 =item import_export (optional)
462 Set to C<1> if this is an import-export slot -- a slot in which the user can
463 easily add or remove volumes. This information may be useful for operations to
464 bulk-import newly-inserted tapes or bulk-export a set of tapes.
470 $chg->move(finished_cb => $cb,
474 Move a volume between two slots in the changer. These slots are provided by the
475 user, and have meaning for the changer.
477 =head2 RESERVATION OBJECTS
483 This is the changer object.
485 =head3 $res->{'device'}
487 This is the fully configured device for the reserved volume. The device is not
490 =head3 $res->{'this_slot'}
492 This is the name of this slot. It is an arbitrary string which will
493 have some meaning to the changer's C<load()> method. It is safe to
494 access this field after the reservation has been released.
496 =head3 $res->{'barcode'}
498 If this changer supports barcodes, then this is the barcode of the reserved
499 volume. This can be helpful for labeling tapes using their barcode.
501 =head3 $label = $res->make_new_tape_label()
503 To devise a new name for a volume.
504 This will return C<undef> if no label could be created.
506 =head3 $meta = $res->make_new_meta_label()
508 To devise a new meta name for a meta volume.
509 This will return C<undef> if no label could be created.
511 =head3 $res->release(finished_cb => $cb, eject => $eject)
513 This is how an Amanda application indicates that it no longer needs the
514 reserved volume. The callback is called after any related operations are
515 complete -- possibly immediately. Some drives and changers have a notion of
516 "ejecting" a volume, and some don't. In particular, a manual changer can cause
517 the tape drive to eject the tape, while a tape robot can move a tape back to
518 storage, leaving the drive empty. If the eject parameter is given and true, it
519 indicates that Amanda is done with the volume and has reason to believe the
520 user is done with the volume, too -- for example, when a tape has been written
523 A reservation will be released automatically when the object is destroyed, but
524 in this case no finished_cb is given, so the release operation may not complete
525 before the process exits. Wherever possible, reservations should be explicitly
528 =head3 $res->set_label(finished_cb => $cb, label => $label)
530 This is how Amanda indicates to the changer that the volume in the device has
531 been (re-)labeled. Changers can keep a database of volume labels by slot or by
532 barcode, or just ignore this function and call $cb immediately. Note that the
533 reservation must still be held when this function is called.
535 =head1 SUBCLASS HELPERS
537 C<Amanda::Changer> implements some methods and attributes to help subclass
542 Implementing the C<info> method can be tricky, because it can potentially request
543 a number of keys that require asynchronous access. The C<info> implementation in
544 this class may make the process a bit easier.
546 First, if the method C<info_setup> is defined, C<info> calls it, passing it a
547 C<finished_cb> and the list of desired keys, C<info>. This method is useful to
548 gather information that is useful for several info keys.
550 Next, for each requested key, C<info> calls
552 $self->info_key($key, %params)
554 including a regular C<info_cb> callback. The C<info> method will wait for
555 all C<info_key> invocations to finish, then collect the results or errors that
558 =head2 ERROR HANDLING
560 To create a new error object, use C<< $self->make_error($type, $cb, %args) >>.
561 This method will create a new C<Amanda::Changer::Error> object and optionally
562 invoke a callback with it. If C<$type> is C<fatal>, then
563 C<< $chg->{'fatal_error'} >> is made a reference to the new error object. The
564 callback C<$cb> (which should be made using C<make_cb()> from
565 C<Amanda::MainLoop>) is called with the new error object. The C<%args> are
566 added to the new error object. In use, this looks something like:
569 return $self->make_error("failed", $params{'res_cb'},
570 reason => "notfound",
571 message => "Volume '$label' not found");
574 This method can also be called as a class method, e.g., from a constructor.
575 In this case, it returns the resulting error object, which should be fatal.
578 return Amanda::Changer->make_error("fatal", undef,
579 message => "config error");
582 For cases where a number of errors have occurred, it is helpful to make a
583 "combined" error. The method C<make_combined_error> takes care of this
584 operation, given a callback and an array of tuples C<[ $description, $err ]>
585 for each error. This method uses some heuristics to figure out the
586 appropriate type and reason for the combined error.
588 if ($left_err and $right_err) {
589 return $self->make_combined_error($params{'finished_cb'},
590 [ [ "from the left", $left_err ],
591 [ "from the right", $right_err ] ]);
594 Any additional keyword arguments to C<make_combined_error> are put into the
595 combined error; this is useful to set the C<slot> attribute.
597 The method C<< $self->check_error($cb) >> is a useful method for subclasses to
598 avoid doing anything after a fatal error. This method checks
599 C<< $self->{'fatal_error'} >>. If the error is defined, the method calls C<$cb>
600 and returns true. The usual recipe is
606 return if $self->check_error($params{'res_cb'});
612 C<Amanda::Changer->new> calls subclass constructors with two parameters: a
613 configuration object and a changer specification. The changer specification is
614 the string that led to creation of this changer device. The configuration
615 object is of type C<Amanda::Changer::Config>, and can be treated as a hashref
616 with the following keys:
618 name -- name of the changer section (or "default")
619 is_global -- true if this changer is the default changer
620 tapedev -- tapedev parameter
621 tpchanger -- tpchanger parameter
622 changerdev -- changerdev parameter
623 changerfile -- changerfile parameter
624 properties -- all properties for this changer
625 device_properties -- device properties from this changer
627 The four parameters are just as supplied by the user, either in the global
628 config or in a changer section. Changer authors are cautioned not to try to
629 override any of these parameters as previous changers have done (e.g.,
630 C<changerfile> specifying both configuration and state files). Use properties
633 The C<properties> and C<device_properties> parameters are in the format
634 provided by C<Amanda::Config>. If C<is_global> is true, then
635 C<device_properties> will include any device properties specified globally, as
636 well as properties culled from the global tapetype.
638 The C<configure_device> method generally takes care of the intricacies of
639 handling device properties. Pass it a newly opened device and it will apply
640 the relevant properties, returning undef on success or an error message on
643 The C<get_property> method is a shortcut method to get the value of a changer
644 property, ignoring its the priority and other attributes. In a list context,
645 it returns all values for the property; in a scalar context, it returns the
646 first value specified.
648 Many properties are boolean, and Amanda has a habit of accepting a number of
649 different ways of writing boolean values. The method
650 C<< $config->get_boolean_property($prop, $default) >> will parse such a
651 property, returning 0 or 1 if the property is specified, C<$default> if it is
652 not specified, or C<undef> if the property cannot be parsed.
654 =head2 PERSISTENT STATE AND LOCKING
656 Many changer subclasses need to track state across invocations and between
657 different processes, and to ensure that the state is read and written
658 atomically. The C<with_locked_state> provides this functionality by
659 locking a statefile, only unlocking it after any changes have been written back
660 to it. Subclasses can use this method both for mutual exclusion (ensuring that
661 only one changer operation is in progress at any time) and for atomic state
664 The C<with_locked_state> method works like C<synchronized> (in
665 L<Amanda::MainLoop>), but with some extra arguments:
667 $self->with_locked_state($filename, $some_cb, sub {
668 # note: $some_cb shadows outer $some_cb; see Amanda::MainLoop::synchronized
669 my ($state, $some_cb) = @_;
670 # ... and eventually:
674 The callback C<$some_cb> is assumed to take a changer error as its first
675 argument, and if there are any errors locking the statefile, they will be
676 reported directly to this callback. Otherwise, a wrapped version of
677 C<$some_cb> is passed to the inner C<sub>. When this wrapper is invoked, the
678 state will be written to disk and unlocked before the original callback is
681 The state itself begins as an empty hashref, but subclasses can add arbitrary
682 keys to the hash. Serialization is currently handled with L<Data::Dumper>.
684 =head2 PARAMETER VALIDATION
686 The C<validate_params> method is useful to make sure that the proper parameters
687 are present for a particular method, dying if not. Call it like this:
689 $self->validate_params("load", \%params);
691 The method currently only supports the "load" method, but can be expanded to
696 The Amanda Wiki (http://wiki.zmanda.com) has a higher-level description of the
697 changer model implemented by this package.
699 See amanda-changers(7) for user-level documentation of the changer implementations.
703 # constants for the states that slots may be in; note that these states still
704 # apply even if the tape is actually loaded in a drive
706 # slot is known to contain a volume
707 use constant SLOT_FULL => 1;
709 # slot is known to contain no volume
710 use constant SLOT_EMPTY => 2;
712 # don't known if slot contains a volume
713 use constant SLOT_UNKNOWN => 3;
715 our @EXPORT_OK = qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN );
717 constants => [ qw( SLOT_FULL SLOT_EMPTY SLOT_UNKNOWN ) ],
720 # this is a "virtual" constructor which instantiates objects of different
721 # classes based on its argument. Subclasses should not try to chain up!
723 shift eq 'Amanda::Changer'
724 or die("Do not call the Amanda::Changer constructor from subclasses");
729 # creating a named changer is a bit easier
730 if (defined($name)) {
731 # first, is it a changer alias?
732 if (($uri,$cc) = _changer_alias_to_uri($name)) {
733 return _new_from_uri($uri, $cc, $name, %params);
736 # maybe a straight-up changer URI?
737 if (_uri_to_pkgname($name)) {
738 return _new_from_uri($name, undef, $name, %params);
741 # assume it's a device name or alias, and invoke the single-changer
742 return _new_from_uri("chg-single:$name", undef, $name, %params);
743 } else { # !defined($name)
744 if ((getconf_linenum($CNF_TPCHANGER) == -2 ||
745 (getconf_seen($CNF_TPCHANGER) &&
746 getconf_linenum($CNF_TAPEDEV) != -2)) &&
747 getconf($CNF_TPCHANGER) ne '') {
748 my $tpchanger = getconf($CNF_TPCHANGER);
750 # first, is it an old changer script?
751 if ($uri = _old_script_to_uri($tpchanger)) {
752 return _new_from_uri($uri, undef, $tpchanger, %params);
755 # if not, then there had better be no tapdev
756 if (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '' and
757 ((getconf_linenum($CNF_TAPEDEV) > 0 and
758 getconf_linenum($CNF_TPCHANGER) > 0) ||
759 (getconf_linenum($CNF_TAPEDEV) == -2))) {
760 return Amanda::Changer::Error->new('fatal',
761 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
762 "unless using an old-style changer script");
765 # maybe a changer alias?
766 if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
767 return _new_from_uri($uri, $cc, $tpchanger, %params);
770 # maybe a straight-up changer URI?
771 if (_uri_to_pkgname($tpchanger)) {
772 return _new_from_uri($tpchanger, undef, $tpchanger, %params);
775 # assume it's a device name or alias, and invoke the single-changer
776 return _new_from_uri("chg-single:$tpchanger", undef, $tpchanger, %params);
777 } elsif (getconf_seen($CNF_TAPEDEV) and getconf($CNF_TAPEDEV) ne '') {
778 my $tapedev = getconf($CNF_TAPEDEV);
780 # first, is it a changer alias?
781 if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
782 return _new_from_uri($uri, $cc, $tapedev, %params);
785 # maybe a straight-up changer URI?
786 if (_uri_to_pkgname($tapedev)) {
787 return _new_from_uri($tapedev, undef, $tapedev, %params);
790 # assume it's a device name or alias, and invoke chg-single.
791 # chg-single will check the device immediately and error out
792 # if the device name is invalid.
793 return _new_from_uri("chg-single:$tapedev", undef, $tapedev, %params);
795 return Amanda::Changer::Error->new('fatal',
796 message => "You must specify one of 'tapedev' or 'tpchanger'");
804 debug("Changer '$self->{'chg_name'}' not quit") if defined $self->{'chg_name'};
811 foreach (keys %$self) {
816 # helper functions for new
818 sub _changer_alias_to_uri {
821 my $cc = Amanda::Config::lookup_changer_config($name);
823 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
825 if (my $uri = _old_script_to_uri($tpchanger)) {
830 my $seen_tpchanger = changer_config_seen($cc, $CHANGER_CONFIG_TPCHANGER);
831 my $seen_tapedev = changer_config_seen($cc, $CHANGER_CONFIG_TAPEDEV);
832 if ($seen_tpchanger and $seen_tapedev) {
833 return Amanda::Changer::Error->new('fatal',
834 message => "Cannot specify both 'tapedev' and 'tpchanger' " .
835 "**unless using an old-style changer script");
837 if (!$seen_tpchanger and !$seen_tapedev) {
838 return Amanda::Changer::Error->new('fatal',
839 message => "You must specify one of 'tapedev' or 'tpchanger'");
841 $tpchanger ||= changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
843 if (_uri_to_pkgname($tpchanger)) {
844 return ($tpchanger, $cc);
846 die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
854 sub _old_script_to_uri {
857 die("empty changer script name") unless $name;
859 if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
860 return "chg-compat:$name"
867 # try to load the package for the given URI. $@ is set properly
868 # if this function returns a false value.
869 sub _uri_to_pkgname {
872 my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
873 if (!defined $type) {
874 $@ = "'$name' is not a changer URI";
878 $type =~ tr/A-Z-/a-z_/;
880 # create a package name to see if it's already imported
881 my $pkgname = "Amanda::Changer::$type";
882 my $filename = $pkgname;
883 $filename =~ s|::|/|g;
885 return $pkgname if (exists $INC{$filename});
888 eval "use $pkgname;";
892 # determine whether the module doesn't exist at all, or if there was an
893 # error loading it; die if we found a syntax error
894 if (exists $INC{$filename} or $err =~ /did not return a true value/) {
904 sub _new_from_uri { # (note: this sub is patched by the installcheck)
910 # as a special case, if the URI came back as an error, just pass
911 # that along. This lets the _xxx_to_uri methods return errors more
913 if (ref $uri and $uri->isa("Amanda::Changer::Error")) {
917 # make up a key for our hash of already-instantiated objects,
918 # using a newline as a separator, since perl can't use tuples
920 my $uri_cc = "$uri\n";
922 $uri_cc = $uri_cc . changer_config_name($cc);
925 # return a pre-existing changer, if possible
927 # look up the type and load the class
928 my $pkgname = _uri_to_pkgname($uri);
933 my $rv = eval {$pkgname->new(Amanda::Changer::Config->new($cc), $uri);};
934 die "$pkgname->new return undef" if $@;
935 die "$pkgname->new did not return an Amanda::Changer object or an Amanda::Changer::Error"
936 unless ($rv->isa("Amanda::Changer") or $rv->isa("Amanda::Changer::Error"));
938 if ($rv->isa("Amanda::Changer::Error")) {
942 if ($rv->isa("Amanda::Changer")) {
943 # add an instance variable or two
944 $rv->{'fatal_error'} = undef;
947 $rv->{'tapelist'} = $params{'tapelist'};
948 $rv->{'autolabel'} = $params{'autolabel'};
949 $rv->{'autolabel'} = getconf($CNF_AUTOLABEL)
950 unless defined $rv->{'autolabel'};
951 $rv->{'labelstr'} = $params{'labelstr'};
952 $rv->{'labelstr'} = getconf($CNF_LABELSTR)
953 unless defined $rv->{'labelstr'};
954 $rv->{'meta_autolabel'} = $params{'meta_autolabel'};
955 $rv->{'meta_autolabel'} = getconf($CNF_META_AUTOLABEL)
956 unless defined $rv->{'meta_autolabel'};
957 $rv->{'chg_name'} = $name;
961 # method stubs that return a "notimpl" error
964 my ($op, $cbname, $self, %params) = @_;
965 return if $self->check_error($params{$cbname});
967 my $class = ref($self);
968 my $chg_foo = "chg-" . ($class =~ /Amanda::Changer::(.*)/)[0];
969 return $self->make_error("failed", $params{$cbname},
971 message => "'$chg_foo:' does not support $op");
974 sub load { _stubop("loading volumes", "res_cb", @_); }
975 sub reset { _stubop("reset", "finished_cb", @_); }
976 sub clean { _stubop("clean", "finished_cb", @_); }
977 sub eject { _stubop("eject", "finished_cb", @_); }
978 sub update { _stubop("update", "finished_cb", @_); }
979 sub inventory { _stubop("inventory", "inventory_cb", @_); }
980 sub move { _stubop("move", "finished_cb", @_); }
981 sub set_meta_label { _stubop("set_meta_label", "finished_cb", @_); }
982 sub get_meta_label { _stubop("get_meta_label", "finished_cb", @_); }
987 return $self->can("inventory") ne \&Amanda::Changer::inventory;
990 # info calls out to info_setup and info_key; see POD above
995 if (!$self->can('info_key')) {
996 my $class = ref($self);
997 $params{'info_cb'}->("$class does not support info()");
1001 my ($do_setup, $start_keys, $all_done);
1004 if ($self->can('info_setup')) {
1005 $self->info_setup(info => $params{'info'},
1006 finished_cb => sub {
1009 $params{'info_cb'}->($err);
1020 my $remaining_keys = 1;
1023 my $maybe_done = sub {
1024 return if (--$remaining_keys);
1025 $all_done->(%key_results);
1028 for my $key (@{$params{'info'}}) {
1030 $self->info_key($key, info_cb => sub {
1031 $key_results{$key} = [ @_ ];
1036 # we started with $remaining_keys = 1, so decrement it now
1041 my %key_results = @_;
1043 # if there are *any* errors, handle them
1044 my @annotated_errs =
1045 map { [ sprintf("While getting info key '%s'", $_), $key_results{$_}->[0] ] }
1046 grep { defined($key_results{$_}->[0]) }
1049 if (@annotated_errs) {
1050 return $self->make_combined_error(
1051 $params{'info_cb'}, [ @annotated_errs ]);
1054 # no errors, so combine the results and return them
1056 while (my ($key, $result) = each(%key_results)) {
1057 my ($err, %key_info) = @$result;
1058 if (exists $key_info{$key}) {
1059 $info{$key} = $key_info{$key};
1061 warn("No value available for $key");
1065 $params{'info_cb'}->(undef, %info);
1075 my ($type, $cb, %args) = @_;
1077 my $classmeth = $self eq "Amanda::Changer";
1079 if ($classmeth and $type ne 'fatal') {
1080 cluck("type must be fatal when calling make_error as a class method");
1084 my $err = Amanda::Changer::Error->new($type, %args);
1087 $self->{'fatal_error'} = $err
1096 sub make_combined_error {
1098 my ($cb, $suberrors, %extra_args) = @_;
1101 if (@$suberrors == 0) {
1102 die("make_combined_error called with no errors");
1105 my $classmeth = $self eq "Amanda::Changer";
1107 # if there's only one suberror, just use it directly
1108 if (@$suberrors == 1) {
1109 $err = $suberrors->[0][1];
1110 die("$err is not an Error object")
1111 unless defined($err) and $err->isa("Amanda::Changer::Error");
1113 $err = Amanda::Changer::Error->new(
1115 reason => $err->{'reason'},
1116 message => $suberrors->[0][0] . ": " . $err->{'message'});
1118 my $fatal = $classmeth or grep { $_->[1]{'fatal'} } @$suberrors;
1123 map { ($_->[1]{'reason'}, undef) }
1124 grep { $_->[1]{'reason'} }
1126 if ((keys %reasons) == 1) {
1127 $reason = (keys %reasons)[0];
1129 $reason = 'unknown'; # multiple or 0 "source" reasons
1133 my $message = join("; ",
1134 map { sprintf("%s: %s", @$_) }
1137 my %errargs = ( message => $message, %extra_args );
1138 $errargs{'reason'} = $reason unless ($fatal);
1139 $err = Amanda::Changer::Error->new(
1140 $fatal? "fatal" : "failed",
1145 $self->{'fatal_error'} = $err
1158 if (defined $self->{'fatal_error'}) {
1159 $cb->($self->{'fatal_error'}) if $cb;
1164 sub lock_statefile {
1168 my $statefile = $params{'statefile_filename'};
1169 my $lock_cb = $params{'lock_cb'};
1170 Amanda::Changer::StateFile->new($statefile, $lock_cb);
1173 sub with_locked_state {
1175 my ($statefile, $cb, $sub) = @_;
1176 my ($filelock, $STATE);
1177 my $poll = 0; # first delay will be 0.1s; see below
1179 my $steps = define_steps
1183 $filelock = Amanda::Util::file_lock->new($statefile);
1185 $steps->{'lock'}->();
1189 my $rv = $filelock->lock();
1191 # loop until we get the lock, increasing $poll to 10s
1192 $poll += 100 unless $poll >= 10000;
1193 return Amanda::MainLoop::call_after($poll, $steps->{'lock'});
1194 } elsif ($rv == -1) {
1195 return $self->make_error("fatal", $cb,
1196 message => "Error locking '$statefile'");
1199 $steps->{'read'}->();
1203 my $contents = $filelock->data();
1207 # $fh goes out of scope here, and is thus automatically
1209 return $cb->("error reading '$statefile': $@", undef);
1211 if (!defined $STATE or ref($STATE) ne 'HASH') {
1212 return $cb->("'$statefile' did not define \$STATE properly", undef);
1215 # initial state (blank file)
1219 $sub->($STATE, $steps->{'cb_wrap'});
1222 step cb_wrap => sub {
1225 my $dumper = Data::Dumper->new([ $STATE ], ["STATE"]);
1227 $filelock->write($dumper->Dump);
1228 $filelock->unlock();
1230 # call through to the original callback with the original
1236 sub validate_params {
1237 my ($self, $op, $params) = @_;
1239 if ($op eq 'load') {
1240 unless(exists $params->{'label'} || exists $params->{'slot'} ||
1241 exists $params->{'relative_slot'}) {
1242 confess "Invalid parameters to 'load'";
1245 confess "don't know how to validate '$op'";
1249 sub make_new_tape_label {
1253 my $tl = $self->{'tapelist'};
1254 die ("make_new_tape_label: no tapelist") if !$tl;
1255 return undef if !defined $self->{'autolabel'}->{'template'};
1256 return undef if !defined $self->{'labelstr'};
1257 my $template = $self->{'autolabel'}->{'template'};
1258 my $labelstr = $self->{'labelstr'};
1261 return (undef, "template is not set, you must set autolabel");
1263 $template =~ s/\$\$/SUBSTITUTE_DOLLAR/g;
1264 $template =~ s/\$b/SUBSTITUTE_BARCODE/g;
1265 $template =~ s/\$m/SUBSTITUTE_META/g;
1266 $template =~ s/\$o/SUBSTITUTE_ORG/g;
1267 $template =~ s/\$c/SUBSTITUTE_CONFIG/g;
1269 my $org = getconf($CNF_ORG);
1270 my $config = Amanda::Config::get_config_name();
1271 my $barcode = $params{'barcode'};
1272 $barcode = '' if !defined $barcode;
1273 my $meta = $params{'meta'};
1274 $meta = $self->make_new_meta_label(%params) if !defined $meta;
1275 $meta = '' if !defined $meta;
1277 $template =~ s/SUBSTITUTE_DOLLAR/\$/g;
1278 $template =~ s/SUBSTITUTE_ORG/$org/g;
1279 $template =~ s/SUBSTITUTE_CONFIG/$config/g;
1280 $template =~ s/SUBSTITUTE_META/$meta/g;
1281 # Do not susbtitute the barcode now
1284 $template) =~ s/[^%]*(%+)[^%]*/length($1)/e;
1285 my $nlabels = 10 ** $npercents;
1288 if ($npercents == 0) {
1289 if ($template =~ /SUBSTITUTE_BARCODE/ && defined $barcode) {
1291 $label =~ s/SUBSTITUTE_BARCODE/$barcode/g;
1292 if ($tl->lookup_tapelabel($label)) {
1293 return (undef, "Label '$label' already exists");
1295 } elsif ($template =~ /SUBSTITUTE_BARCODE/ && !defined $barcode) {
1296 return (undef, "Can't generate new label because volume have no barcode");
1298 return (undef, "autolabel require at least one '%'");
1301 # make up a sprintf pattern
1303 $template) =~ s/(%+)/"%0" . length($1) . "d"/e;
1305 my %existing_labels;
1306 for my $tle (@{$tl->{'tles'}}) {
1307 if (defined $tle && defined $tle->{'label'}) {
1308 my $tle_label = $tle->{'label'};
1309 my $tle_barcode = $tle->{'barcode'};
1310 if (defined $tle_barcode) {
1311 $tle_label =~ s/$tle_barcode/SUBSTITUTE_BARCODE/g;
1313 $existing_labels{$tle_label} = 1 if defined $tle_label;
1318 for ($i = 1; $i < $nlabels; $i++) {
1319 $label = sprintf($sprintf_pat, $i);
1320 last unless (exists $existing_labels{$label});
1322 # susbtitute the barcode
1324 $label =~ s/SUBSTITUTE_BARCODE/$barcode/g;
1326 # bail out if we didn't find an unused label
1327 return (undef, "Can't label unlabeled volume: All label used")
1328 if ($i >= $nlabels);
1331 # verify $label matches $labelstr
1332 if ($label !~ /$labelstr/) {
1333 return (undef, "Newly-generated label '$label' does not match labelstr '$labelstr'");
1337 return (undef, "Generated label is empty");
1343 sub make_new_meta_label {
1347 my $tl = $self->{'tapelist'};
1348 die ("make_new_meta_label: no tapelist") if !$tl;
1349 return undef if !defined $self->{'meta_autolabel'};
1350 my $template = $self->{'meta_autolabel'};
1351 return if !defined $template;
1354 return (undef, "template is not set, you must set meta-autolabel");
1356 $template =~ s/\$\$/SUBSTITUTE_DOLLAR/g;
1357 $template =~ s/\$o/SUBSTITUTE_ORG/g;
1358 $template =~ s/\$c/SUBSTITUTE_CONFIG/g;
1360 my $org = getconf($CNF_ORG);
1361 my $config = Amanda::Config::get_config_name();
1363 $template =~ s/SUBSTITUTE_DOLLAR/\$/g;
1364 $template =~ s/SUBSTITUTE_ORG/$org/g;
1365 $template =~ s/SUBSTITUTE_CONFIG/$config/g;
1368 $template) =~ s/[^%]*(%+)[^%]*/length($1)/e;
1369 my $nlabels = 10 ** $npercents;
1371 # make up a sprintf pattern
1372 (my $sprintf_pat = $template) =~ s/(%+)/"%0" . length($1) . "d"/e;
1374 my %existing_meta_labels =
1375 map { $_->{'meta'} => 1 } @{$tl->{'tles'}};
1378 for ($i = 1; $i < $nlabels; $i++) {
1379 $meta = sprintf($sprintf_pat, $i);
1380 last unless (exists $existing_meta_labels{$meta});
1383 # bail out if we didn't find an unused label
1384 return (undef, "Can't label unlabeled meta volume: All meta label used")
1385 if ($i >= $nlabels);
1388 return (undef, "Generated meta-label is empty");
1394 sub volume_is_labelable {
1396 my $dev_status = shift;
1399 my $autolabel = $self->{'autolabel'};
1401 if (!defined $dev_status) {
1403 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_UNLABELED and
1404 $f_type == $Amanda::Header::F_EMPTY) {
1405 return 0 if (!$autolabel->{'empty'});
1406 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_UNLABELED and
1407 $f_type == $Amanda::Header::F_WEIRD) {
1408 return 0 if (!$autolabel->{'non_amanda'});
1409 } elsif ($dev_status & $DEVICE_STATUS_VOLUME_ERROR) {
1410 return 0 if (!$autolabel->{'volume_error'});
1411 } elsif ($dev_status != $DEVICE_STATUS_SUCCESS) {
1413 } elsif ($dev_status & $DEVICE_STATUS_SUCCESS and
1414 $f_type == $Amanda::Header::F_TAPESTART and
1415 $label !~ /$self->{'labelstr'}/) {
1416 return 0 if (!$autolabel->{'other_config'});
1422 package Amanda::Changer::Error;
1423 use Amanda::Debug qw( :logging );
1424 use Carp qw( cluck );
1427 '""' => sub { $_[0]->{'message'}; },
1428 'cmp' => sub { $_[0]->{'message'} cmp $_[1]; };
1430 my %known_err_types = map { ($_, 1) } qw( fatal failed );
1431 my %known_err_reasons = map { ($_, 1) } qw( notfound invalid notimpl driveinuse volinuse unknown device empty );
1434 my $class = shift; # ignore class
1435 my ($type, %info) = @_;
1438 $reason = ", reason='$info{reason}'" if $type eq "failed";
1439 debug("new Amanda::Changer::Error: type='$type'$reason, message='$info{message}'");
1441 $info{'type'} = $type;
1443 # do some sanity checks. Note that these sanity checks issue a warning
1444 # with cluck, but add default values to the error. This is in the hope
1445 # that an unusual Amanda error is not obscured by a problem in the
1446 # make_error invocation. The stack trace produced by cluck should help to
1447 # track down the bad make_error invocation.
1449 if (!exists $info{'message'}) {
1450 cluck("no message given to A::C::make_error");
1451 $info{'message'} = "unknown error";
1454 if (!exists $known_err_types{$type}) {
1455 cluck("invalid Amanda::Changer::Error type '$type'");
1459 if ($type eq 'failed' and !exists $info{'reason'}) {
1460 cluck("no reason given to A::C::make_error");
1461 $info{'reason'} = "unknown";
1464 if ($type eq 'failed' and !exists $known_err_reasons{$info{'reason'}}) {
1465 cluck("invalid Amanda::Changer::Error reason '$info{reason}'");
1466 $info{'reason'} = 'unknown';
1469 return bless (\%info, $class);
1472 # do nothing in quit
1476 sub fatal { $_[0]->{'type'} eq 'fatal'; }
1477 sub failed { $_[0]->{'type'} eq 'failed'; }
1480 sub notfound { $_[0]->failed && $_[0]->{'reason'} eq 'notfound'; }
1481 sub invalid { $_[0]->failed && $_[0]->{'reason'} eq 'invalid'; }
1482 sub notimpl { $_[0]->failed && $_[0]->{'reason'} eq 'notimpl'; }
1483 sub driveinuse { $_[0]->failed && $_[0]->{'reason'} eq 'driveinuse'; }
1484 sub volinuse { $_[0]->failed && $_[0]->{'reason'} eq 'volinuse'; }
1485 sub unknown { $_[0]->failed && $_[0]->{'reason'} eq 'unknown'; }
1486 sub empty { $_[0]->failed && $_[0]->{'reason'} eq 'empty'; }
1489 sub slot { $_[0]->{'slot'}; }
1491 package Amanda::Changer::Reservation;
1492 # this is a simple base class with stub method or two.
1493 use Amanda::Config qw( :getconf );
1500 return bless ($self, $class)
1505 if (!$self->{'released'}) {
1506 if (defined $self->{this_slot}) {
1507 Amanda::Debug::warning("Changer reservation for slot '$self->{this_slot}' has " .
1508 "gone out of scope without release");
1510 Amanda::Debug::warning("Changer reservation for unknown slot has " .
1511 "gone out of scope without release");
1520 # nothing to do by default: just call the finished callback
1521 if (exists $params{'finished_cb'}) {
1522 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1530 return if $self->{'released'};
1532 # always finish the device on release; it's illegal for anything
1533 # else to use the device after this point, anyway, so we want to
1534 # release the device's resources immediately
1535 if (defined $self->{'device'}) {
1536 $self->{'device'}->finish();
1539 $self->{'released'} = 1;
1540 $self->do_release(%params);
1547 # this is the one subclasses should override
1549 if (exists $params{'finished_cb'}) {
1550 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1554 sub get_meta_label {
1558 # this is the one subclasses should override
1560 if (exists $params{'finished_cb'}) {
1561 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1565 sub set_meta_label {
1569 # this is the one subclasses should override
1571 if (exists $params{'finished_cb'}) {
1572 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
1576 sub make_new_tape_label {
1580 $params{'barcode'} = $self->{'barcode'} if !defined $params{'barcode'};
1581 $params{'meta'} = $self->{'meta'} if !defined $params{'meta'};
1582 return $self->{'chg'}->make_new_tape_label(%params);
1586 sub make_new_meta_label {
1590 return $self->{'chg'}->make_new_meta_label(%params);
1593 package Amanda::Changer::Config;
1594 use Amanda::Config qw( :getconf string_to_boolean );
1601 my $self = bless {}, $class;
1604 $self->{'name'} = changer_config_name($cc);
1605 $self->{'is_global'} = 0;
1607 $self->{'tapedev'} = changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
1608 $self->{'tpchanger'} = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
1609 $self->{'changerdev'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERDEV);
1610 $self->{'changerfile'} = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERFILE);
1612 $self->{'properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_PROPERTY);
1613 $self->{'device_properties'} = changer_config_getconf($cc, $CHANGER_CONFIG_DEVICE_PROPERTY);
1615 $self->{'name'} = "default";
1616 $self->{'is_global'} = 1;
1618 $self->{'tapedev'} = getconf($CNF_TAPEDEV);
1619 $self->{'tpchanger'} = getconf($CNF_TPCHANGER);
1620 $self->{'changerdev'} = getconf($CNF_CHANGERDEV);
1621 $self->{'changerfile'} = getconf($CNF_CHANGERFILE);
1623 # no changer or device properties, since there's no changer definition to use
1624 $self->{'properties'} = {};
1625 $self->{'device_properties'} = {};
1630 sub configure_device {
1634 # we'll accumulate properties in this hash *overwriting* previous properties
1635 # instead of appending to them
1638 # always use implicit properties
1639 %properties = ( %properties, %{ $self->_get_implicit_properties() } );
1641 # always use global properties
1642 %properties = ( %properties, %{ getconf($CNF_DEVICE_PROPERTY) } );
1644 # if this is a device alias, add properties from its device definition
1645 if (my $dc = lookup_device_config($device->device_name)) {
1646 %properties = ( %properties,
1647 %{ device_config_getconf($dc, $DEVICE_CONFIG_DEVICE_PROPERTY); } );
1650 # finally, add any props from the changer config
1651 %properties = ( %properties, %{ $self->{'device_properties'} } );
1653 while (my ($propname, $propinfo) = each(%properties)) {
1654 for my $value (@{$propinfo->{'values'}}) {
1655 if (!$device->property_set($propname, $value)) {
1656 my $msg = "Error setting '$propname' on device '".$device->device_name."'";
1657 if (exists $propinfo->{'optional'}) {
1658 if ($propinfo->{'optional'} eq 'warn') {
1659 warn("$msg (ignored)");
1673 my ($property) = @_;
1675 my $prophash = $self->{'properties'}->{$property};
1676 return undef unless defined($prophash);
1678 return wantarray? @{$prophash->{'values'}} : $prophash->{'values'}->[0];
1681 sub get_boolean_property {
1683 my ($propname, $default) = @_;
1686 unless (exists $self->{'properties'}->{$propname});
1688 my $propinfo = $self->{'properties'}->{$propname};
1689 return undef unless @{$propinfo->{'values'}} == 1;
1690 return string_to_boolean($propinfo->{'values'}->[0]);
1693 sub _get_implicit_properties {
1697 my $tapetype_name = getconf($CNF_TAPETYPE);
1698 return unless defined($tapetype_name);
1700 my $tapetype = lookup_tapetype($tapetype_name);
1701 return unless defined($tapetype);
1703 # The property hashes used here add the 'optional' key, which indicates
1704 # that the property is implicit and that a failure to set it is not fatal.
1705 # The flag is used by configure_device.
1706 if (tapetype_seen($tapetype, $TAPETYPE_LENGTH)) {
1707 $props->{'max_volume_usage'} = {
1712 tapetype_getconf($tapetype, $TAPETYPE_LENGTH) * 1024,
1716 if (tapetype_seen($tapetype, $TAPETYPE_READBLOCKSIZE)) {
1717 $props->{'read_block_size'} = {
1718 optional => "warn", # optional, but give a warning
1722 tapetype_getconf($tapetype, $TAPETYPE_READBLOCKSIZE) * 1024,
1726 if (tapetype_seen($tapetype, $TAPETYPE_BLOCKSIZE)) {
1727 $props->{'block_size'} = {
1732 # convert the length from kb to bytes here
1733 tapetype_getconf($tapetype, $TAPETYPE_BLOCKSIZE) * 1024,