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->eject(finished_cb => $cb, drive => $drivename)
192 Eject the volume in a drive, if the changer supports it. Drivename is as
193 specified to C<clean>. If possible, applications should prefer to eject a
194 reserved volume when finished with it (C<< $res->release(eject => 1) >>), to
195 ensure that the correct volume is ejected from a multi-drive changer.
197 =head3 $chg->update(finished_cb => $cb, changed => $changed)
199 The user has changed something -- loading or unloading tapes,
200 reconfiguring the changer, etc. -- that may have invalidated the
201 database. C<$changed> is a changer-specific string indicating what has
202 changed; if it is omitted, the changer will check everything.
204 =head3 $chg->import(finished_cb => $cb, slots => $slots)
206 The user has placed volumes in the import/export slots, and would like the
207 changer to place them in storage slots. This is a very changer-specific
208 operation, and $slots should be supplied by the user for verbatim transmission
209 to the changer, and may specify which import/export slots, for example, contain
212 =head3 $chg->export(finished_cb => $cb, slot => $slot)
214 =head3 $chg->export(finished_cb => $cb, label => $label)
216 Place the indicated volume (by $label, or in $slot) into an available
217 import/export slot. This, too, is a very changer-specific operation.
219 =head3 $chg->move(finished_cb => $cb, from_slot => $from, to_slot => $to)
221 Move a volume between two slots in the changer. These slots are provided by the
222 user, and have meaning for the changer.
224 =head2 RESERVATION OBJECTS
226 =head3 $res->{'device_name'}
228 This is the name of the device reserved by a reservation object.
230 =head3 $res->{'this_slot'}
232 This is the name of this slot. It is an arbitrary string which will
233 have some meaning to the changer's C<load()> method. It is safe to
234 access this field after the reservation has been released.
236 =head3 $res->{'next_slot'}
238 This is the "next" slot after this one. It is safe to access this field,
239 too, after the reservation has been released (and, in changers with only
240 one "drive", this is the only way you will get to the next volume!)
242 =head3 $res->release(finished_cb => $cb, eject => $eject)
244 This is how an Amanda application indicates that it no longer needs the
245 reserved volume. The callback is called after any related operations are
246 complete -- possibly immediately. Some drives and changers have a notion of
247 "ejecting" a volume, and some don't. In particular, a manual changer can cause
248 the tape drive to eject the tape, while a tape robot can move a tape back to
249 storage, leaving the drive empty. If the eject parameter is given and true, it
250 indicates that Amanda is done with the volume and has reason to believe the
251 user is done with the volume, too -- for example, when a tape has been written
254 A reservation will be released automatically when the object is destroyed, but
255 in this case no finished_cb is given, so the release operation may not complete
256 before the process exits. Wherever possible, reservations should be explicitly
259 =head3 $res->set_label(finished_cb => $cb, label => $label)
261 This is how Amanda indicates to the changer that the volume in the device has
262 been (re-)labeled. Changers can keep a database of volume labels by slot or by
263 barcode, or just ignore this function and call $cb immediately. Note that the
264 reservation must still be held when this function is called.
268 See the other changer packages, including:
272 =item L<Amanda::Changer::disk>
274 =item L<Amanda::Changer::compat>
276 =item L<Amanda::Changer::single>
282 - support loading by barcode, showing barcodes in reservations
283 - support deadlock avoidance by returning more information in load errors
284 - Amanda::Changer::Single
288 # this is a "virtual" constructor which instantiates objects of different
289 # classes based on its argument. Subclasses should not try to chain up!
291 shift eq 'Amanda::Changer'
292 or die("Do not call the Amanda::Changer constructor from subclasses");
296 # creating a named changer is a bit easier
297 if (defined($name)) {
298 # first, is it a changer alias?
299 if (($uri,$cc) = _changer_alias_to_uri($name)) {
300 return _new_from_uri($uri, $cc, $name);
303 # maybe a straight-up changer URI?
304 if (_uri_to_pkgname($name)) {
305 return _new_from_uri($name, undef, $name);
308 # assume it's a device name or alias, and invoke the single-changer
309 return _new_from_uri("chg-single:$name", undef, $name);
310 } else { # !defined($name)
311 if (getconf_seen($CNF_TPCHANGER)) {
312 my $tpchanger = getconf($CNF_TPCHANGER);
314 # first, is it an old changer script?
315 if ($uri = _old_script_to_uri($tpchanger)) {
316 return _new_from_uri($uri, undef, $name);
319 # if not, then there had better be no tapdev
320 if (getconf_seen($CNF_TAPEDEV)) {
321 die "Cannot specify both 'tapedev' and 'tpchanger' unless using an old-style changer script";
324 # maybe a changer alias?
325 if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
326 return _new_from_uri($uri, $cc, $name);
329 # maybe a straight-up changer URI?
330 if (_uri_to_pkgname($tpchanger)) {
331 return _new_from_uri($tpchanger, undef, $name);
334 # assume it's a device name or alias, and invoke the single-changer
335 return _new_from_uri("chg-single:$tpchanger", undef, $name);
336 } elsif (getconf_seen($CNF_TAPEDEV)) {
337 my $tapedev = getconf($CNF_TAPEDEV);
339 # first, is it a changer alias?
340 if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
341 return _new_from_uri($uri, $cc, $name);
344 # maybe a straight-up changer URI?
345 if (_uri_to_pkgname($tapedev)) {
346 return _new_from_uri($tapedev, undef, $name);
349 # assume it's a device name or alias, and invoke the single-changer
350 return _new_from_uri("chg-single:$tapedev", undef, $name);
352 die "Must specify one of 'tapedev' or 'tpchanger'";
357 # helper functions for new
359 sub _changer_alias_to_uri {
362 my $cc = Amanda::Config::lookup_changer_config($name);
364 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
365 if (my $uri = _old_script_to_uri($tpchanger)) {
367 } elsif (_uri_to_pkgname($tpchanger)) {
368 return ($tpchanger, $cc);
370 die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
378 sub _old_script_to_uri {
381 if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
382 return "chg-compat:$name"
389 # try to load the package for the given URI. $@ is set properly
390 # if this function returns a false value.
391 sub _uri_to_pkgname {
394 my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
395 if (!defined $type) {
396 $@ = "'$name' is not a changer URI";
400 $type =~ tr/A-Z-/a-z_/;
402 # create a package name to see if it's already imported
403 my $pkgname = "Amanda::Changer::$type";
404 my $filename = $pkgname;
405 $filename =~ s|::|/|g;
407 return $pkgname if (exists $INC{$filename});
410 eval "use $pkgname;";
414 # determine whether the module doesn't exist at all, or if there was an
415 # error loading it; die if we found a syntax error
416 if (exists $INC{$filename}) {
426 # already-instsantiated changer objects (using 'our' so that the installcheck
427 # and reset this list as necessary)
428 our %changers_by_uri_cc = ();
430 sub _new_from_uri { # (note: this sub is patched by the installcheck)
431 my ($uri, $cc, $name) = @_;
433 # make up a key for our hash of already-instantiated objects,
434 # using a newline as a separator, since perl can't use tuples
436 my $uri_cc = "$uri\n";
438 $uri_cc = $uri_cc . changer_config_name($cc);
441 # return a pre-existing changer, if possible
443 if (exists($changers_by_uri_cc{$uri_cc})) {
444 return $changers_by_uri_cc{$uri_cc};
447 # look up the type and load the class
448 my $pkgname = _uri_to_pkgname($uri);
453 my $rv = $pkgname->new($cc, $uri);
454 die "$pkgname->new did not return an Amanda::Changer object"
455 unless ($rv->isa("Amanda::Changer"));
457 # store this in our cache for next time
458 $changers_by_uri_cc{$uri_cc} = $rv;
463 # parent-class methods; mostly "unimplemented method"
469 my $class = ref($self);
470 $params{'res_cb'}->("$class does not support load()", undef);
477 my $class = ref($self);
478 if (exists $params{'finished_cb'}) {
479 $params{'finished_cb'}->("$class does not support reset()");
487 my $class = ref($self);
488 if (exists $params{'info_cb'}) {
489 $params{'info_cb'}->("$class does not support info()");
497 my $class = ref($self);
498 if (exists $params{'finished_cb'}) {
499 $params{'finished_cb'}->("$class does not support clean()");
507 my $class = ref($self);
508 if (exists $params{'finished_cb'}) {
509 $params{'finished_cb'}->("$class does not support eject()");
517 my $class = ref($self);
518 if (exists $params{'finished_cb'}) {
519 $params{'finished_cb'}->("$class does not support update()");
527 my $class = ref($self);
528 if (exists $params{'finished_cb'}) {
529 $params{'finished_cb'}->("$class does not support import()");
537 my $class = ref($self);
538 if (exists $params{'finished_cb'}) {
539 $params{'finished_cb'}->("$class does not support export()");
547 my $class = ref($self);
548 if (exists $params{'finished_cb'}) {
549 $params{'finished_cb'}->("$class does not support move()");
553 package Amanda::Changer::Reservation;
555 # this is a simple base class with stub method or two.
562 return bless ($self, $class)
567 if (!$self->{'released'}) {
568 $self->release(finished_cb => sub {
571 warn "While releasing reservation: $err";
581 # nothing to do: just call the finished callback
582 if (exists $params{'finished_cb'}) {
583 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
591 return if $self->{'released'};
593 $self->{'released'} = 1;
594 $self->do_release(%params);
601 # this is the one subclasses should override
603 if (exists $params{'finished_cb'}) {
604 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);