git.gag.com Git - debian/amanda/blob - perl/Amanda/Changer.pm

   1 # Copyright (c) 2005-2008 Zmanda Inc.  All Rights Reserved.
   2 #
   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.
   6 #
   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
  10 # for more details.
  11 #
  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
  15 #
  16 # Contact information: Zmanda Inc, 465 S Mathlida Ave, Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 package Amanda::Changer;
  20
  21 use strict;
  22 use warnings;
  23 use Carp;
  24 use POSIX ();
  25 use vars qw( @ISA );
  26
  27 use Amanda::Paths;
  28 use Amanda::Util;
  29 use Amanda::Config qw( :getconf );
  30 use Amanda::Device qw( :constants );
  31
  32 =head1 NAME
  33
  34 Amanda::Changer -- interface to changer scripts
  35
  36 =head1 SYNOPSIS
  37
  38     use Amanda::Changer;
  39
  40     my $chg = Amanda::Changer->new(); # loads the default changer; OR
  41     $chg = Amanda::Changer->new("somechanger"); # references a defined changer in amanda.conf
  42
  43     $chg->load(
  44         label => "TAPE-012",
  45         res_cb => sub {
  46             my ($err, $reservation) = @_;
  47             if ($err) {
  48                 die $err->{message};
  49             }
  50             $dev = Amanda::Device->new($reservation->{device_name});
  51             # use device..
  52         });
  53
  54     # later..
  55     $reservation->release(finished_cb => $start_next_volume);
  56
  57 =head1 API STATUS
  58
  59 This interface will change before the next release.
  60
  61 =head1 INTERFACE
  62
  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
  67 continue.
  68
  69 A new object is created with the C<new> function as follows:
  70
  71   my $chg = Amanda::Changer->new($changer);
  72
  73 to create a named changer (a name provided by the user, either specifying a
  74 changer directly or specifying a changer definition), or
  75
  76   my $chg = Amanda::Changer->new();
  77
  78 to run the default changer.  This function handles the many ways a user can
  79 configure a changer.
  80
  81 =head2 CALLBACKS
  82
  83 A res_cb C<$cb> is called back as:
  84
  85  $cb->($error, undef);
  86
  87 in the event of an error, or
  88
  89  $cb->(undef, $reservation);
  90
  91 with a successful reservation. res_cb must always be specified.  A finished_cb
  92 C<$cb> is called back as
  93
  94  $cb->($error);
  95
  96 in the event of an error, or
  97
  98  $cb->(undef);
  99
 100 on success. A finished_cb may be omitted if no notification of completion is
 101 required.
 102
 103 =head2 CURRENT SLOT
 104
 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.
 112
 113 =head2 CHANGER OBJECTS
 114
 115 =head3 $chg->load(res_cb => $cb, label => $label, set_current => $sc)
 116
 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,
 122 chg-compat).
 123
 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.
 127
 128 =head3 $chg->load(res_cb => $cb, slot => "current")
 129
 130 Reserve the volume in the "current" slot. This is used by the sequential
 131 taperscan algorithm to begin its search.
 132
 133 =head3 $chg->load(res_cb => $cb, slot => "next")
 134
 135 Reserve the volume that follows the current slot.  This may not be a
 136 very efficient operation on all devices.
 137
 138 =head3 $chg->load(res_cb => $cb, slot => $slot, set_current => $sc)
 139
 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).
 143
 144 =head3 $chg->info(info_cb => $cb, info => [ $key1, $key2, .. ])
 145
 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
 151
 152   info_cb => sub {
 153     my $error = shift;
 154     my %results = @_;
 155     # ..
 156   }
 157
 158 Supported keys are:
 159
 160 =over 2
 161
 162 =item num_slots
 163
 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).
 168
 169 =item vendor_string
 170
 171 A string describing the name and model of the changer device.
 172
 173 =back
 174
 175 =head3 $chg->reset(finished_cb => $cb)
 176
 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
 180 outstanding.
 181
 182 =head3 $chg->clean(finished_cb => $cb, drive => $drivename)
 183
 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.
 189
 190 =head3 $chg->update(finished_cb => $cb, changed => $changed)
 191
 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.
 196
 197 =head3 $chg->import(finished_cb => $cb, slots => $slots)
 198
 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
 203 the new volumes.
 204
 205 =head3 $chg->export(finished_cb => $cb, slot => $slot)
 206
 207 =head3 $chg->export(finished_cb => $cb, label => $label)
 208
 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.
 211
 212 =head3 $chg->move(finished_cb => $cb, from_slot => $from, to_slot => $to)
 213
 214 Move a volume between two slots in the changer. These slots are provided by the
 215 user, and have meaning for the changer.
 216
 217 =head2 RESERVATION OBJECTS
 218
 219 =head3 $res->{'device_name'}
 220
 221 This is the name of the device reserved by a reservation object.
 222
 223 =head3 $res->{'this_slot'}
 224
 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.
 228
 229 =head3 $res->{'next_slot'}
 230
 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!)
 234
 235 =head3 $res->release(finished_cb => $cb, eject => $eject)
 236
 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
 245 completely.
 246
 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
 250 released.
 251
 252 =head3 $res->set_label(finished_cb => $cb, label => $label)
 253
 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.
 258
 259 =head1 SEE ALSO
 260
 261 See the other changer packages, including:
 262
 263 =over 2
 264
 265 =item L<Amanda::Changer::disk>
 266
 267 =item L<Amanda::Changer::compat>
 268
 269 =item L<Amanda::Changer::single>
 270
 271 =back
 272
 273 =head1 TODO
 274
 275  - support loading by barcode, showing barcodes in reservations
 276  - support deadlock avoidance by returning more information in load errors
 277  - Amanda::Changer::Single
 278
 279 =cut
 280
 281 # this is a "virtual" constructor which instantiates objects of different
 282 # classes based on its argument.  Subclasses should not try to chain up!
 283 sub new {
 284     shift eq 'Amanda::Changer'
 285         or die("Do not call the Amanda::Changer constructor from subclasses");
 286     my ($name) = @_;
 287     my ($uri, $cc);
 288
 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);
 294         }
 295
 296         # maybe a straight-up changer URI?
 297         if (_uri_to_pkgname($name)) {
 298             return _new_from_uri($name, undef, $name);
 299         }
 300
 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);
 306
 307             # first, is it an old changer script?
 308             if ($uri = _old_script_to_uri($tpchanger)) {
 309                 return _new_from_uri($uri, undef, $name);
 310             }
 311
 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";
 315             }
 316
 317             # maybe a changer alias?
 318             if (($uri,$cc) = _changer_alias_to_uri($tpchanger)) {
 319                 return _new_from_uri($uri, $cc, $name);
 320             }
 321
 322             # maybe a straight-up changer URI?
 323             if (_uri_to_pkgname($tpchanger)) {
 324                 return _new_from_uri($tpchanger, undef, $name);
 325             }
 326
 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);
 331
 332             # first, is it a changer alias?
 333             if (($uri,$cc) = _changer_alias_to_uri($tapedev)) {
 334                 return _new_from_uri($uri, $cc, $name);
 335             }
 336
 337             # maybe a straight-up changer URI?
 338             if (_uri_to_pkgname($tapedev)) {
 339                 return _new_from_uri($tapedev, undef, $name);
 340             }
 341
 342             # assume it's a device name or alias, and invoke the single-changer
 343             return _new_from_uri("chg-single:$tapedev", undef, $name);
 344         } else {
 345             die "Must specify one of 'tapedev' or 'tpchanger'";
 346         }
 347     }
 348 }
 349
 350 # helper functions for new
 351
 352 sub _changer_alias_to_uri {
 353     my ($name) = @_;
 354
 355     my $cc = Amanda::Config::lookup_changer_config($name);
 356     if ($cc) {
 357         my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
 358         if (my $uri = _old_script_to_uri($tpchanger)) {
 359             return ($uri, $cc);
 360         } elsif (_uri_to_pkgname($tpchanger)) {
 361             return ($tpchanger, $cc);
 362         } else {
 363             die "Changer '$name' specifies invalid tpchanger '$tpchanger'";
 364         }
 365     }
 366
 367     # not an alias
 368     return;
 369 }
 370
 371 sub _old_script_to_uri {
 372     my ($name) = @_;
 373
 374     if ((-x "$amlibexecdir/$name") or (($name =~ qr{^/}) and (-x $name))) {
 375         return "chg-compat:$name"
 376     }
 377
 378     # not an old script
 379     return;
 380 }
 381
 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 {
 385     my ($name) = @_;
 386
 387     my ($type) = ($name =~ /^chg-([A-Za-z_]+):/);
 388     if (!defined $type) {
 389         $@ = "'$name' is not a changer URI";
 390         return 0;
 391     }
 392
 393     $type =~ tr/A-Z-/a-z_/;
 394
 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;
 399     $filename .= '.pm';
 400     return $pkgname if (exists $INC{$filename});
 401
 402     # try loading it
 403     eval "use $pkgname;";
 404     if ($@) {
 405         my $err = $@;
 406
 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}) {
 410             die($err);
 411         }
 412
 413         return 0;
 414     }
 415
 416     return $pkgname;
 417 }
 418
 419 # already-instsantiated changer objects (using 'our' so that the installcheck
 420 # and reset this list as necessary)
 421 our %changers_by_uri_cc = ();
 422
 423 sub _new_from_uri { # (note: this sub is patched by the installcheck)
 424     my ($uri, $cc, $name) = @_;
 425
 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
 428     # as keys
 429     my $uri_cc = "$uri\n";
 430     if (defined $cc) {
 431         $uri_cc = $uri_cc . changer_config_name($cc);
 432     }
 433
 434     # return a pre-existing changer, if possible
 435
 436     if (exists($changers_by_uri_cc{$uri_cc})) {
 437         return $changers_by_uri_cc{$uri_cc};
 438     }
 439
 440     # look up the type and load the class
 441     my $pkgname = _uri_to_pkgname($uri);
 442     if (!$pkgname) {
 443         die $@;
 444     }
 445
 446     my $rv = $pkgname->new($cc, $uri);
 447     die "$pkgname->new did not return an Amanda::Changer object"
 448         unless ($rv->isa("Amanda::Changer"));
 449
 450     # store this in our cache for next time
 451     $changers_by_uri_cc{$uri_cc} = $rv;
 452
 453     return $rv;
 454 }
 455
 456 # parent-class methods; mostly "unimplemented method"
 457
 458 sub load {
 459     my $self = shift;
 460     my %params = @_;
 461
 462     my $class = ref($self);
 463     $params{'res_cb'}->("$class does not support load()", undef);
 464 }
 465
 466 sub reset {
 467     my $self = shift;
 468     my %params = @_;
 469
 470     my $class = ref($self);
 471     if (exists $params{'finished_cb'}) {
 472         $params{'finished_cb'}->("$class does not support reset()");
 473     }
 474 }
 475
 476 sub info {
 477     my $self = shift;
 478     my %params = @_;
 479
 480     my $class = ref($self);
 481     if (exists $params{'info_cb'}) {
 482         $params{'info_cb'}->("$class does not support info()");
 483     }
 484 }
 485
 486 sub clean {
 487     my $self = shift;
 488     my %params = @_;
 489
 490     my $class = ref($self);
 491     if (exists $params{'finished_cb'}) {
 492         $params{'finished_cb'}->("$class does not support clean()");
 493     }
 494 }
 495
 496 sub update {
 497     my $self = shift;
 498     my %params = @_;
 499
 500     my $class = ref($self);
 501     if (exists $params{'finished_cb'}) {
 502         $params{'finished_cb'}->("$class does not support update()");
 503     }
 504 }
 505
 506 sub import {
 507     my $self = shift;
 508     my %params = @_;
 509
 510     my $class = ref($self);
 511     if (exists $params{'finished_cb'}) {
 512         $params{'finished_cb'}->("$class does not support import()");
 513     }
 514 }
 515
 516 sub export {
 517     my $self = shift;
 518     my %params = @_;
 519
 520     my $class = ref($self);
 521     if (exists $params{'finished_cb'}) {
 522         $params{'finished_cb'}->("$class does not support export()");
 523     }
 524 }
 525
 526 sub move {
 527     my $self = shift;
 528     my %params = @_;
 529
 530     my $class = ref($self);
 531     if (exists $params{'finished_cb'}) {
 532         $params{'finished_cb'}->("$class does not support move()");
 533     }
 534 }
 535
 536 package Amanda::Changer::Reservation;
 537
 538 # this is a simple base class with stub method or two.
 539
 540 sub new {
 541     my $class = shift;
 542     my $self = {
 543         released => 0,
 544     };
 545     return bless ($self, $class)
 546 }
 547
 548 sub DESTROY {
 549     my ($self) = @_;
 550     if (!$self->{'released'}) {
 551         $self->release(finished_cb => sub {
 552             my ($err) = @_;
 553             if (defined $err) {
 554                 warn "While releasing reservation: $err";
 555             }
 556         });
 557     }
 558 }
 559
 560 sub set_label {
 561     my $self = shift;
 562     my %params = @_;
 563
 564     # nothing to do: just call the finished callback
 565     if (exists $params{'finished_cb'}) {
 566         Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
 567     }
 568 }
 569
 570 sub release {
 571     my $self = shift;
 572     my %params = @_;
 573
 574     return if $self->{'released'};
 575
 576     $self->{'released'} = 1;
 577     $self->do_release(%params);
 578
 579     if (exists $params{'finished_cb'}) {
 580         Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
 581     }
 582 }
 583
 584 sub do_release {
 585     # this is the one subclasses should override
 586 }
 587
 588 1;