1 # Copyright (c) 2005-2008 Zmanda Inc. All Rights Reserved.
3 # This library is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU Lesser General Public License version 2.1 as
5 # published 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 Mathlida Ave, Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 package Amanda::Changer;
29 use Amanda::Config qw( :getconf );
30 use Amanda::Device qw( :constants );
34 Amanda::Changer -- interface to changer scripts
40 my $chg = Amanda::Changer->new(); # loads the default changer; OR
41 $chg = Amanda::Changer->new("somechanger"); # references a defined changer in amanda.conf
46 my ($err, $reservation) = @_;
50 $dev = Amanda::Device->new($reservation->{device_name});
55 $reservation->release(finished_cb => $start_next_volume);
59 This interface will change before the next release.
63 All operations in the module return immediately, and take as an argument a
64 callback function which will indicate completion of the changer operation -- a
65 kind of continuation. The caller should run a main loop (see
66 L<Amanda::MainLoop>) to allow the interactions with the changer script to
69 A new object is created with the C<new> function as follows:
71 my $chg = Amanda::Changer->new($changer);
73 to create a named changer (a name provided by the user, either specifying a
74 changer directly or specifying a changer definition), or
76 my $chg = Amanda::Changer->new();
78 to run the default changer. This function handles the many ways a user can
83 A res_cb C<$cb> is called back as:
87 in the event of an error, or
89 $cb->(undef, $reservation);
91 with a successful reservation. res_cb must always be specified. A finished_cb
92 C<$cb> is called back as
96 in the event of an error, or
100 on success. A finished_cb may be omitted if no notification of completion is
105 Changers maintain a global concept of a "current" slot, for
106 compatibility with Amanda algorithms such as the taperscan. However, it
107 is not compatible with concurrent use of the same changer, and may be
108 inefficient for some changers, so new algorithms should avoid using it,
109 preferring instead to load the correct tape immediately (with C<load>),
110 and to progress from tape to tape using the reservation objects'
111 C<next_slot> attribute.
113 =head2 CHANGER OBJECTS
115 =head3 $chg->load(res_cb => $cb, label => $label, set_current => $sc)
117 Load a volume with the given label. This may leverage any barcodes or other
118 indices that the changer has created, or may resort to a sequential scan of
119 media. If set_current is specified and true, then the changer's current slot
120 should be updated to correspond to $slot. If not, then the changer should not
121 update its current slot (but some changers will anyway - specifically,
124 Note that the changer I<tries> to load the requested volume, but it's a mean
125 world out there, and you may not get what you want, so check the label on the
126 loaded volume before getting started.
128 =head3 $chg->load(res_cb => $cb, slot => "current")
130 Reserve the volume in the "current" slot. This is used by the sequential
131 taperscan algorithm to begin its search.
133 =head3 $chg->load(res_cb => $cb, slot => "next")
135 Reserve the volume that follows the current slot. This may not be a
136 very efficient operation on all devices.
138 =head3 $chg->load(res_cb => $cb, slot => $slot, set_current => $sc)
140 Reserve the volume in the given slot. $slot must be a string that appeared in a
141 reservation's 'next_slot' field at some point, or a string from the user (e.g.,
142 an argument to amtape).
144 =head3 $chg->info(info_cb => $cb, info => [ $key1, $key2, .. ])
146 Query the changer for miscellaneous information. Any number of keys may be
147 specified. The C<info_cb> is called with C<$error> as the first argument,
148 much like a C<res_cb>, but the remaining arguments form a hash giving values
149 for all of the requested keys that are supported by the changer. The preamble
150 to such a callback is usually
164 The total number of slots in the changer device. If this key is not
165 present, then the device cannot determine its slot count (for example,
166 an archival device that names slots by timestamp could potentially run
167 until the heat-death of the universe).
171 A string describing the name and model of the changer device.
175 =head3 $chg->reset(finished_cb => $cb)
177 Reset the changer to a "base" state. This will generally reset the "current"
178 slot to something the user would think of as the "first" tape, unload any
179 loaded drives, etc. It is an error to call this while any reservations are
182 =head3 $chg->clean(finished_cb => $cb, drive => $drivename)
184 Clean a drive, if the changer supports it. Drivename can be an empty string for
185 devices with only one drive, or can be an arbitrary string from the user (e.g.,
186 an amtape argument). Note that some changers cannot detect the completion of a
187 cleaning cycle; in this case, the user will just need to delay further Amanda
188 activities until the cleaning is complete.
190 =head3 $chg->update(finished_cb => $cb, changed => $changed)
192 The user has changed something -- loading or unloading tapes,
193 reconfiguring the changer, etc. -- that may have invalidated the
194 database. C<$changed> is a changer-specific string indicating what has
195 changed; if it is omitted, the changer will check everything.
197 =head3 $chg->import(finished_cb => $cb, slots => $slots)
199 The user has placed volumes in the import/export slots, and would like the
200 changer to place them in storage slots. This is a very changer-specific
201 operation, and $slots should be supplied by the user for verbatim transmission
202 to the changer, and may specify which import/export slots, for example, contain
205 =head3 $chg->export(finished_cb => $cb, slot => $slot)
207 =head3 $chg->export(finished_cb => $cb, label => $label)
209 Place the indicated volume (by $label, or in $slot) into an available
210 import/export slot. This, too, is a very changer-specific operation.
212 =head3 $chg->move(finished_cb => $cb, from_slot => $from, to_slot => $to)
214 Move a volume between two slots in the changer. These slots are provided by the
215 user, and have meaning for the changer.
217 =head2 RESERVATION OBJECTS
219 =head3 $res->{'device_name'}
221 This is the name of the device reserved by a reservation object.
223 =head3 $res->{'this_slot'}
225 This is the name of this slot. It is an arbitrary string which will
226 have some meaning to the changer's C<load()> method. It is safe to
227 access this field after the reservation has been released.
229 =head3 $res->{'next_slot'}
231 This is the "next" slot after this one. It is safe to access this field,
232 too, after the reservation has been released (and, in changers with only
233 one "drive", this is the only way you will get to the next volume!)
235 =head3 $res->release(finished_cb => $cb, eject => $eject)
237 This is how an Amanda application indicates that it no longer needs the
238 reserved volume. The callback is called after any related operations are
239 complete -- possibly immediately. Some drives and changers have a notion of
240 "ejecting" a volume, and some don't. In particular, a manual changer can cause
241 the tape drive to eject the tape, while a tape robot can move a tape back to
242 storage, leaving the drive empty. If the eject parameter is given and true, it
243 indicates that Amanda is done with the volume and has reason to believe the
244 user is done with the volume, too -- for example, when a tape has been written
247 A reservation will be released automatically when the object is destroyed, but
248 in this case no finished_cb is given, so the release operation may not complete
249 before the process exits. Wherever possible, reservations should be explicitly
252 =head3 $res->set_label(finished_cb => $cb, label => $label)
254 This is how Amanda indicates to the changer that the volume in the device has
255 been (re-)labeled. Changers can keep a database of volume labels by slot or by
256 barcode, or just ignore this function and call $cb immediately. Note that the
257 reservation must still be held when this function is called.
261 See the other changer packages, including:
265 =item L<Amanda::Changer::disk>
267 =item L<Amanda::Changer::compat>
269 =item L<Amanda::Changer::single>
275 - support loading by barcode, showing barcodes in reservations
276 - support deadlock avoidance by returning more information in load errors
277 - Amanda::Changer::Single
281 # this is a "virtual" constructor which instantiates objects of different
282 # classes based on its argument. Subclasses should not try to chain up!
284 shift eq 'Amanda::Changer'
285 or die("Do not call the Amanda::Changer constructor from subclasses");
289 # creating a named changer is a bit easier
290 if (defined($name)) {
291 # first, is it a changer alias?
292 if (($uri,$cc) = _changer_alias_to_uri($name)) {
293 return _new_from_uri($uri, $cc, $name);
296 # maybe a straight-up changer URI?
297 if (_uri_to_pkgname($name)) {
298 return _new_from_uri($name, undef, $name);
301 # assume it's a device name or alias, and invoke the single-changer
302 return _new_from_uri("chg-single:$name", undef, $name);
303 } else { # !defined($name)
304 if (getconf_seen($CNF_TPCHANGER)) {
305 my $tpchanger = getconf($CNF_TPCHANGER);
307 # first, is it an old changer script?
308 if ($uri = _old_script_to_uri($tpchanger)) {
309 return _new_from_uri($uri, undef, $name);
312 # if not, then there had better be no tapdev
313 if (getconf_seen($CNF_TAPEDEV)) {
314 die "Cannot specify both 'tapedev' and 'tpchanger' unless using an old-style changer script";
317 # maybe a changer alias?
318 if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
319 return _new_from_uri($uri, $cc, $name);
322 # maybe a straight-up changer URI?
323 if (_uri_to_pkgname($tpchanger)) {
324 return _new_from_uri($tpchanger, undef, $name);
327 # assume it's a device name or alias, and invoke the single-changer
328 return _new_from_uri("chg-single:$tpchanger", undef, $name);
329 } elsif (getconf_seen($CNF_TAPEDEV)) {
330 my $tapedev = getconf($CNF_TAPEDEV);
332 # first, is it a changer alias?
333 if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
334 return _new_from_uri($uri, $cc, $name);
337 # maybe a straight-up changer URI?
338 if (_uri_to_pkgname($tapedev)) {
339 return _new_from_uri($tapedev, undef, $name);
342 # assume it's a device name or alias, and invoke the single-changer
343 return _new_from_uri("chg-single:$tapedev", undef, $name);
345 die "Must specify one of 'tapedev' or 'tpchanger'";
350 # helper functions for new
352 sub _changer_alias_to_uri {
355 my $cc = Amanda::Config::lookup_changer_config($name);
357 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
358 if (my $uri = _old_script_to_uri($tpchanger)) {
360 } elsif (_uri_to_pkgname($tpchanger)) {
361 return ($tpchanger, $cc);
363 die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
371 sub _old_script_to_uri {
374 if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
375 return "chg-compat:$name"
382 # try to load the package for the given URI. $@ is set properly
383 # if this function returns a false value.
384 sub _uri_to_pkgname {
387 my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
388 if (!defined $type) {
389 $@ = "'$name' is not a changer URI";
393 $type =~ tr/A-Z-/a-z_/;
395 # create a package name to see if it's already imported
396 my $pkgname = "Amanda::Changer::$type";
397 my $filename = $pkgname;
398 $filename =~ s|::|/|g;
400 return $pkgname if (exists $INC{$filename});
403 eval "use $pkgname;";
407 # determine whether the module doesn't exist at all, or if there was an
408 # error loading it; die if we found a syntax error
409 if (exists $INC{$filename}) {
419 # already-instsantiated changer objects (using 'our' so that the installcheck
420 # and reset this list as necessary)
421 our %changers_by_uri_cc = ();
423 sub _new_from_uri { # (note: this sub is patched by the installcheck)
424 my ($uri, $cc, $name) = @_;
426 # make up a key for our hash of already-instantiated objects,
427 # using a newline as a separator, since perl can't use tuples
429 my $uri_cc = "$uri\n";
431 $uri_cc = $uri_cc . changer_config_name($cc);
434 # return a pre-existing changer, if possible
436 if (exists($changers_by_uri_cc{$uri_cc})) {
437 return $changers_by_uri_cc{$uri_cc};
440 # look up the type and load the class
441 my $pkgname = _uri_to_pkgname($uri);
446 my $rv = $pkgname->new($cc, $uri);
447 die "$pkgname->new did not return an Amanda::Changer object"
448 unless ($rv->isa("Amanda::Changer"));
450 # store this in our cache for next time
451 $changers_by_uri_cc{$uri_cc} = $rv;
456 # parent-class methods; mostly "unimplemented method"
462 my $class = ref($self);
463 $params{'res_cb'}->("$class does not support load()", undef);
470 my $class = ref($self);
471 if (exists $params{'finished_cb'}) {
472 $params{'finished_cb'}->("$class does not support reset()");
480 my $class = ref($self);
481 if (exists $params{'info_cb'}) {
482 $params{'info_cb'}->("$class does not support info()");
490 my $class = ref($self);
491 if (exists $params{'finished_cb'}) {
492 $params{'finished_cb'}->("$class does not support clean()");
500 my $class = ref($self);
501 if (exists $params{'finished_cb'}) {
502 $params{'finished_cb'}->("$class does not support update()");
510 my $class = ref($self);
511 if (exists $params{'finished_cb'}) {
512 $params{'finished_cb'}->("$class does not support import()");
520 my $class = ref($self);
521 if (exists $params{'finished_cb'}) {
522 $params{'finished_cb'}->("$class does not support export()");
530 my $class = ref($self);
531 if (exists $params{'finished_cb'}) {
532 $params{'finished_cb'}->("$class does not support move()");
536 package Amanda::Changer::Reservation;
538 # this is a simple base class with stub method or two.
545 return bless ($self, $class)
550 if (!$self->{'released'}) {
551 $self->release(finished_cb => sub {
554 warn "While releasing reservation: $err";
564 # nothing to do: just call the finished callback
565 if (exists $params{'finished_cb'}) {
566 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
574 return if $self->{'released'};
576 $self->{'released'} = 1;
577 $self->do_release(%params);
579 if (exists $params{'finished_cb'}) {
580 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
585 # this is the one subclasses should override