1 # Copyright (c) 2009,2010 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 library 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 Lesser General Public
10 # License for more details.
12 # You should have received a copy of the GNU Lesser General Public License
13 # along with this library; if not, write to the Free Software Foundation,
14 # Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
16 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 package Amanda::Changer::robot;
25 @ISA = qw( Amanda::Changer );
30 use Amanda::MainLoop qw( :GIOCondition make_cb define_steps step );
31 use Amanda::Config qw( :getconf );
32 use Amanda::Debug qw( debug warning );
33 use Amanda::Device qw( :constants );
35 use Amanda::Constants;
39 Amanda::Changer::robot -- control a physical tape changer
43 This package controls a physical tape changer via 'mtx'.
45 See the amanda-changers(7) manpage for usage information.
51 # This is one of the more sophisticated changers. Here are some notes that may
52 # help while reading the source code.
56 # The device state is shared between all changers accessing the same library.
57 # It is a hash with keys:
60 # drive_lru - recently used drives, least recent first
61 # bc2lb - hash mapping known barcodes to known labels
62 # current_slot - the current slot
63 # last_operation_time - time the last operation finished
64 # last_operation_delay - required delay for that operation
65 # last_status - last time a 'status' command finished
67 # The 'slots' key is a hash, with slot numbers as keys and hashes
68 # as values. Each slot's hash has keys
69 # state - SLOT_FULL/SLOT_EMPTY/SLOT_UNKNOWN
70 # device_status - the status of the device
71 # f_type - The f_type of the header
72 # label - volume label, if known
73 # barcode - volume barcode, if available
74 # loaded_in - drive this volume is loaded in
75 # ie - 1 if this is an import/export slot
76 # note that this state pretends that a tape physically located
77 # in a tape drive is still located in its original slot.
79 # The 'drives' key is also a hash by drive numbere, the values of
80 # which are hashes with keys
81 # state - SLOT_FULL/SLOT_EMPTY/SLOT_UNKNOWN
82 # label - volume label
83 # barcode - volume barcode
84 # orig_slot - slot from which this tape was loaded
88 # This package uses Amanda::Changer's with_locked_state to lock a statefile and
89 # load its contents. Every time the state is locked, the package also
90 # considers running 'status' to update the state; the status_interval protects
91 # against running status too often.
93 # Each changer method has an "_unlocked" version that does the actual work, and
94 # is called with an additional 'state' parameter containing the locked state.
95 # This is particularly useful when the load method calls the eject method to
96 # empty a drive that it wants to use.
100 # Reservations are currently represented by a PID in the state file. If that
101 # pid is no longer running, then the reservation is considered stale and is
102 # discarded (with a warning).
104 # Reservation objects defer most of the interesting operations back to the
105 # changer itself, since the operations require locked access to the state.
109 # All of the operating-system-specific functionality is abstracted into the
110 # Interface class. This is written in such a way that it could be replaced
111 # by a direct SCSI interface.
115 my ($config, $tpchanger) = @_;
117 # strip the "chg-foo:" prefix from $tpchanger
118 my $device_name = $tpchanger;
119 $device_name =~ s/^[^:]*://;
121 # get the 'chg-foo' form of this changer script
122 my $class_name = $class;
123 $class_name =~ s/Amanda::Changer::/chg-/;
127 device_name => $device_name,
130 # set below from properties
132 drive2device => {}, # { drive => device name }
133 driveorder => [], # order of tape-device properties
134 drive_choice => 'lru',
135 eject_before_unload => 0,
138 status_interval => 2, # in seconds
139 load_poll => [0, 2, 120], # delay, poll, until
140 eject_delay => 0, # in seconds
141 unload_delay => 0, # in seconds
142 class_name => $class_name,
144 bless ($self, $class);
146 # handle some config and properties
147 my $properties = $config->{'properties'};
149 if (defined $config->{'changerdev'} and $config->{'changerdev'} ne '') {
150 return Amanda::Changer->make_error("fatal", undef,
151 message => "'changerdev' is not allowed with $self->{class_name}");
154 if ($config->{'changerfile'}) {
155 $self->{'statefile'} = Amanda::Config::config_dir_relative($config->{'changerfile'});
157 my $safe_filename = "$self->{class_name}:$device_name";
158 $safe_filename =~ tr/a-zA-Z0-9/-/cs;
159 $safe_filename =~ s/^-*//;
160 $self->{'statefile'} = "$localstatedir/amanda/$safe_filename";
162 $self->_debug("using statefile '$self->{statefile}'");
164 # figure out the drive number to device name mapping
165 if (exists $config->{'tapedev'}
166 and $config->{'tapedev'} ne ''
167 and !exists $properties->{'tape-device'}) {
168 # if the tapedev points to us (the changer), then give an error
169 if ($config->{'tapedev'} eq $tpchanger) {
170 return Amanda::Changer->make_error("fatal", undef,
171 message => "must specify a tape-device property");
173 $self->{'drive2device'} = { '0' => $config->{'tapedev'} };
174 push @{$self->{'driveorder'}}, '0';
176 if (!exists $properties->{'tape-device'}) {
177 return Amanda::Changer->make_error("fatal", undef,
178 message => "no 'tape-device' property specified");
180 for my $pval (@{$properties->{'tape-device'}->{'values'}}) {
181 my ($drive, $device);
182 unless (($drive, $device) = ($pval =~ /(\d+)=(.*)/)) {
183 return Amanda::Changer->make_error("fatal", undef,
184 message => "invalid 'tape-device' property '$pval'");
186 if (exists $self->{'drive2device'}->{$drive}) {
187 return Amanda::Changer->make_error("fatal", undef,
188 message => "tape-device drive $drive defined more than once");
190 $self->{'drive2device'}->{$drive} = $device;
191 push @{$self->{'driveorder'}}, $drive;
195 # eject-before-unload
196 my $ebu = $self->get_boolean_property($self->{'config'},
197 "eject-before-unload", 0);
199 return Amanda::Changer->make_error("fatal", undef,
200 message => "invalid 'eject-before-unload' value");
202 $self->{'eject_before_unload'} = $ebu;
205 my $fast_search = $self->get_boolean_property($self->{'config'},
207 if (!defined $fast_search) {
208 return Amanda::Changer->make_error("fatal", undef,
209 message => "invalid 'fast-search' value");
211 $self->{'fast_search'} = $fast_search;
214 if (exists $properties->{'use-slots'}) {
215 $self->{'use_slots'} = join ",", @{$properties->{'use-slots'}->{'values'}};
216 if ($self->{'use_slots'} !~ /\d+(-\d+)?(,\d+(-\d+)?)*/) {
217 return Amanda::Changer->make_error("fatal", undef,
218 message => "invalid 'use-slots' value '$self->{use_slots}'");
223 if (exists $properties->{'drive-choice'}) {
224 my $pval = $properties->{'drive-choice'}->{'values'}->[0];
225 if (!grep { lc($_) eq $pval } ('lru', 'firstavail')) {
226 return Amanda::Changer->make_error("fatal", undef,
227 message => "invalid 'drive-choice' value '$pval'");
229 $self->{'drive_choice'} = $pval;
234 next unless exists $config->{'properties'}->{'load-poll'};
235 if (@{$config->{'properties'}->{'load-poll'}->{'values'}} > 1) {
236 return Amanda::Changer->make_error("fatal", undef,
237 message => "only one value allowed for 'load-poll'");
239 my $propval = $config->{'properties'}->{'load-poll'}->{'values'}->[0];
240 my ($delay, $delayu, $poll, $pollu, $until, $untilu) = ($propval =~ /^
252 if (!defined $delay) {
253 return Amanda::Changer->make_error("fatal", undef,
254 message => "invalid delay value '$propval' for 'load-poll'");
257 $delay *= 60 if (defined $delayu and $delayu =~ /m/i);
259 $poll = 0 unless defined $poll;
260 $poll *= 60 if (defined $pollu and $pollu =~ /m/i);
262 $until = 0 unless defined $until;
263 $until *= 60 if (defined $untilu and $untilu =~ /m/i);
265 $self->{'load_poll'} = [ $delay, $poll, $until ];
268 # status-interval, eject-delay, unload-delay
269 for my $propname qw(status-interval eject-delay unload-delay) {
270 next unless exists $config->{'properties'}->{$propname};
271 if (@{$config->{'properties'}->{$propname}->{'values'}} > 1) {
272 return Amanda::Changer->make_error("fatal", undef,
273 message => "only one value allowed for $propname");
275 my $propval = $config->{'properties'}->{$propname}->{'values'}->[0];
276 my ($time, $timeu) = ($propval =~ /^(\d+)([ms]?)/ix);
278 if (!defined $time) {
279 return Amanda::Changer->make_error("fatal", undef,
280 message => "invalid time value '$propval' for '$propname'");
283 $time *= 60 if (defined $timeu and $timeu =~ /m/i);
287 $self->{$key} = $time;
290 my $ignore_barcodes = $self->get_boolean_property($self->{'config'},
291 "ignore-barcodes", 0);
292 if (!defined $ignore_barcodes) {
293 return Amanda::Changer->make_error("fatal", undef,
294 message => "invalid 'ignore-barcodes' value");
297 # get the interface, returning an error if we get one
298 $self->{'interface'} = $self->get_interface($device_name, $ignore_barcodes);
299 return $self->{'interface'}
300 if ($self->{'interface'}->isa("Amanda::Changer::Error"));
308 $self->validate_params('load', \%params);
310 return if $self->check_error($params{'res_cb'});
312 $self->_with_updated_state(\%params, 'res_cb', sub { $self->load_unlocked(@_) });
318 my ($slot, $drive, $need_unload);
319 my $state = $params{'state'};
321 my $steps = define_steps
322 cb_ref => \$params{'res_cb'};
324 step calculate_slot => sub {
325 # make sure the slot is numeric
326 if (exists $params{'slot'}) {
327 if ($params{'slot'} =~ /^\d+$/) {
328 $params{'slot'} = $params{'slot'}+0;
330 return $self->make_error("failed", $params{'res_cb'},
332 message => "invalid slot '$params{slot}'");
336 if (exists $params{'relative_slot'}) {
337 if ($params{'relative_slot'} eq "next") {
338 if (exists $params{'slot'}) {
339 $slot = $self->_get_next_slot($state, $params{'slot'});
340 $self->_debug("loading next relative to $params{slot}: $slot");
342 $slot = $self->_get_next_slot($state, $state->{'current_slot'});
343 $self->_debug("loading next relative to current slot: $slot");
346 return $self->make_error("failed", $params{'res_cb'},
348 message => "could not find next slot");
350 } elsif ($params{'relative_slot'} eq "current") {
351 $slot = $state->{'current_slot'};
353 # seek to the first slot
354 $slot = $self->_get_next_slot($state, $state->{'current_slot'});
357 return $self->make_error("failed", $params{'res_cb'},
359 message => "no current slot");
362 return $self->make_error("failed", $params{'res_cb'},
364 message => "invalid relative_slot '$params{relative_slot}'");
367 } elsif (exists $params{'slot'}) {
368 $slot = $params{'slot'};
369 $self->_debug("loading slot '$params{slot}'");
371 if (!defined $slot or !exists $state->{'slots'}->{$slot}) {
372 return $self->make_error("failed", $params{'res_cb'},
374 message => "invalid slot '$slot'");
377 } elsif (exists $params{'label'}) {
378 $self->_debug("loading label '$params{label}'");
379 while (my ($sl, $info) = each(%{$state->{'slots'}})) {
380 if (defined $info->{'label'} and $info->{'label'} eq $params{'label'}) {
386 if (!defined $slot) {
387 return $self->make_error("failed", $params{'res_cb'},
388 reason => "notfound",
389 message => "label '$params{label}' not recognized or not found");
393 return $self->make_error("failed", $params{'res_cb'},
395 message => "no 'slot' or 'label' specified to load()");
398 if (!$self->_is_slot_allowed($slot)) {
399 if (exists $params{'label'}) {
400 return $self->make_error("failed", $params{'res_cb'},
402 message => "label '$params{label}' is in slot $slot, which is " .
403 "not in use-slots ($self->{use_slots})");
405 return $self->make_error("failed", $params{'res_cb'},
407 message => "slot $slot not in use-slots ($self->{use_slots})");
411 if (exists $params{'except_slots'} and exists $params{'except_slots'}->{$slot}) {
412 return $self->make_error("failed", $params{'res_cb'},
413 reason => "notfound",
414 message => "all slots have been loaded");
417 if ($state->{'slots'}->{$slot}->{'state'} eq Amanda::Changer::SLOT_EMPTY) {
418 return $self->make_error("failed", $params{'res_cb'},
419 reason => "notfound",
420 message => "slot $slot is empty");
423 return $steps->{'calculate_drive'}->();
426 step calculate_drive => sub {
430 # see if the tape is already in a drive
431 $drive = $state->{'slots'}->{$slot}->{'loaded_in'};
432 if (defined $drive) {
433 $self->_debug("requested volume is already in drive $drive");
434 my $info = $state->{'drives'}->{$drive};
436 # if it's reserved, it can't be used
437 if ($info->{'res_info'} and $self->_res_info_verify($info->{'res_info'})) {
438 return $self->make_error("failed", $params{'res_cb'},
439 reason => "volinuse",
441 message => "the requested volume is in use (drive $drive)");
444 # if it's not reserved, but not in our list of drives, well, it still
446 if (!exists $self->{'drive2device'}->{$drive}) {
447 return $self->make_error("failed", $params{'res_cb'},
448 # not 'volinuse' because we can't expect the tape to be magically
449 # unloaded any time soon -- it's not actually in use, just inaccessible
451 message => "the requested volume is in drive $drive, which this " .
452 "changer instance cannot access");
455 # otherwise, we can jump all the way to the end of this process
456 return $steps->{'start_polling'}->();
459 # here is where we implement each of the drive-selection algorithms
461 if ($self->{'drive_choice'} eq 'lru') {
462 my %lru = map { $_, 1 } @{$state->{'drive_lru'}};
463 my @unused = grep { ! exists $lru{$_} } @{$self->{'driveorder'}};
465 # search through unused drives, then the LRU list
466 @check_order = (@unused, @{$state->{'drive_lru'}});
467 } elsif ($self->{'drive_choice'} eq 'firstavail') {
468 # just the drive order, so we tend to prefer the first drive in
470 @check_order = (@{$self->{'driveorder'}});
472 # the constructor should detect this circumstance
473 die "invalid drive_choice";
477 for my $dr (@check_order) {
478 my $info = $state->{'drives'}->{$dr};
479 next unless defined $info;
480 next if exists $checked{$dr}; # don't check drives repeatedly
483 # skip drives we don't have rights to use
484 next unless exists $self->{'drive2device'}->{$dr};
486 # skip reserved drives
487 if ($info->{'res_info'}) {
488 if ($self->_res_info_verify($info->{'res_info'})) {
489 # this is a valid reservation -> skip this drive
490 $self->_debug("skipping drive $dr - already reserved");
493 warning("invalidating stale reservation on drive $dr");
494 $info->{'res_info'} = undef;
498 # otherwise, the drive is available, so use it (whether it contains
501 if ($info->{'state'} != Amanda::Changer::SLOT_EMPTY) {
507 if (!defined $drive) {
508 return $self->make_error("failed", $params{'res_cb'},
509 reason => "driveinuse",
510 message => "no drives available");
513 # remove this drive from the lru and put it at the end
514 $state->{'drive_lru'} = [ grep { $_ ne $drive } @{$state->{'drive_lru'}} ];
515 push @{$state->{'drive_lru'}}, $drive;
517 $self->_debug("using drive $drive");
519 $steps->{'wait_to_start'}->();
522 step wait_to_start => sub {
523 $self->_after_delay($state, $steps->{'start_operation'});
526 step start_operation => sub {
527 # $need_unload is set in $steps->{calculate_drive}
529 $steps->{'start_eject'}->();
531 $steps->{'start_load'}->();
535 step start_eject => sub {
536 # we use the 'eject' method to unload here -- it ejects the volume
537 # if the configuration calls for it, then puts the volume away in its
539 $self->eject_unlocked(
540 finished_cb => $steps->{'eject_finished'},
545 step eject_finished => sub {
549 return $params{'res_cb'}->($err);
552 $steps->{'wait_to_load'}->();
555 step wait_to_load => sub {
556 $self->_after_delay($state, $steps->{'start_load'});
559 step start_load => sub {
560 # $slot and $drive are set
561 $self->{'interface'}->load($slot, $drive, $steps->{'load_finished'});
564 step load_finished => sub {
565 # $slot and $drive are set
569 return $self->make_error("failed", $params{'res_cb'},
574 $steps->{'start_polling'}->();
577 my ($next_poll, $last_poll);
578 step start_polling => sub {
579 my ($delay, $poll, $until) = @{ $self->{'load_poll'} };
581 $next_poll = $now + $delay;
582 $last_poll = $now + $until;
584 return Amanda::MainLoop::call_after(1000 * ($next_poll - $now), $steps->{'check_device'});
587 step check_device => sub {
588 my $device_name = $self->{'drive2device'}->{$drive};
589 die "drive $drive not found in drive2device" unless $device_name; # shouldn't happen
591 $self->_debug("polling '$device_name' to see if it's ready");
593 my $device = $self->get_device($device_name);
594 return $params{'res_cb'}->($device) if $device->isa("Amanda::Changer::Error");
597 $device->read_label();
599 # see if the device thinks it's possible it's busy or empty
600 if ($device->status & $DEVICE_STATUS_VOLUME_MISSING
601 or $device->status & $DEVICE_STATUS_DEVICE_BUSY) {
602 # device is not ready -- set up for the next polling step
603 my ($delay, $poll, $until) = @{ $self->{'load_poll'} };
606 $next_poll = $now + 1 if ($next_poll < $now);
607 if ($poll != 0 and $next_poll < $last_poll) {
608 return Amanda::MainLoop::call_after(
609 1000 * ($next_poll - $now), $steps->{'check_device'});
612 # (fall through if we're done polling)
615 if ($device->status == $DEVICE_STATUS_SUCCESS) {
616 $label = $device->volume_label;
617 } elsif ($device->status & $DEVICE_STATUS_VOLUME_UNLABELED) {
620 return $self->make_error("fatal", $params{'res_cb'},
621 message => "while waiting for '$device_name' to become ready: "
622 . $device->error_or_status());
626 $steps->{'make_res'}->($device, $label);
629 step make_res => sub {
630 my ($device, $label) = @_;
632 # check the label against the desired label, in case this isn't the
634 if ($label and $params{'label'} and $label ne $params{'label'}) {
635 $self->_debug("Expected label '$params{label}', but got '$label'");
637 # update metadata with this new information
638 $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
639 $state->{'slots'}->{$slot}->{'device_status'} = $device->status;
640 if (defined $device->{'volume_header'}) {
641 $state->{'slots'}->{$slot}->{'f_type'} = $device->{'volume_header'}->{type};
643 $state->{'slots'}->{$slot}->{'f_type'} = undef;
645 $state->{'slots'}->{$slot}->{'label'} = $label;
646 if ($state->{'slots'}->{$slot}->{'barcode'}) {
647 $state->{'bc2lb'}->{$state->{'slots'}->{$slot}->{'barcode'}} = $label;
650 return $self->make_error("failed", $params{'res_cb'},
651 reason => "notfound",
652 message => "Found unexpected tape '$label' while looking " .
653 "for '$params{label}'");
656 if (!$label and $params{'label'}) {
657 $self->_debug("Expected label '$params{label}', but got an unlabeled tape");
659 # update metadata with this new information
660 $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
661 $state->{'slots'}->{$slot}->{'device_status'} = $device->status;
662 if (defined $device->{'volume_header'}) {
663 $state->{'slots'}->{$slot}->{'f_type'} = $device->{'volume_header'}->{type};
665 $state->{'slots'}->{$slot}->{'f_type'} = undef;
667 $state->{'slots'}->{$slot}->{'label'} = undef;
668 if ($state->{'slots'}->{$slot}->{'barcode'}) {
669 delete $state->{'bc2lb'}->{$state->{'slots'}->{$slot}->{'barcode'}};
672 return $self->make_error("failed", $params{'res_cb'},
673 reason => "notfound",
674 message => "Found unlabeled tape while looking for '$params{label}'");
677 my $res = Amanda::Changer::robot::Reservation->new($self, $slot, $drive,
678 $device, $state->{'slots'}->{$slot}->{'barcode'});
680 # mark this as reserved
681 $state->{'drives'}->{$drive}->{'res_info'} = $self->_res_info_new();
683 # update our state before returning
684 $state->{'slots'}->{$slot}->{'loaded_in'} = $drive;
685 $state->{'drives'}->{$drive}->{'orig_slot'} = $slot;
686 $state->{'slots'}->{$slot}->{'label'} = $label;
687 $state->{'drives'}->{$drive}->{'label'} = $label;
688 $state->{'drives'}->{$drive}->{'state'} = Amanda::Changer::SLOT_FULL;
689 $state->{'drives'}->{$drive}->{'barcode'} = $state->{'slots'}->{$slot}->{'barcode'};
690 #$state->{'slots'}->{$slot}->{'device_status'} = 9;
691 if ($label and $state->{'slots'}->{$slot}->{'barcode'}) {
692 $state->{'bc2lb'}->{$state->{'slots'}->{$slot}->{'barcode'}} = $label;
694 if ($params{'set_current'}) {
695 $self->_debug("setting current slot to $slot");
696 $state->{'current_slot'} = $slot;
699 return $params{'res_cb'}->(undef, $res);
705 my ($key, %params) = @_;
707 if ($key eq 'fast_search') {
708 $self->info_key_fast_search(%params);
709 } elsif ($key eq 'vendor_string') {
710 $self->info_key_vendor_string(%params);
711 } elsif ($key eq 'num_slots') {
712 $self->info_key_num_slots(%params);
716 sub info_key_fast_search {
720 $params{'info_cb'}->(undef,
721 fast_search => $self->{'fast_search'},
725 sub info_key_vendor_string {
729 $self->{'interface'}->inquiry(make_cb(inquiry_cb => sub {
730 my ($err, $info) = @_;
731 return $self->make_error("fatal", $params{'info_cb'},
732 message => "$err") if $err;
734 my $vendor_string = sprintf "%s %s",
735 ($info->{'vendor id'} or "<unknown>"),
736 ($info->{'product id'} or "<unknown>");
738 $params{'info_cb'}->(undef,
739 vendor_string => $vendor_string,
744 sub info_key_num_slots {
748 $self->_with_updated_state(\%params, 'info_cb',
749 sub { $self->info_key_num_slots_unlocked(@_) });
752 sub info_key_num_slots_unlocked {
755 my $state = $params{'state'};
757 my @allowed_slots = grep { $self->_is_slot_allowed($_) }
758 keys %{$state->{'slots'}};
760 $params{'info_cb'}->(undef, num_slots => scalar @allowed_slots);
763 sub get_interface { # (overridden by subclasses)
765 my ($device_name, $ignore_barcodes) = @_;
768 if (exists $self->{'config'}->{'properties'}->{'mtx'}) {
769 if (@{$self->{'config'}->{'properties'}->{'mtx'}->{'values'}} > 1) {
770 return Amanda::Changer->make_error("fatal", undef,
771 message => "only one value allowed for 'mtx'");
773 $mtx = $self->{'config'}->{'properties'}->{'mtx'}->{'values'}->[0];
775 $mtx = $Amanda::Constants::MTX;
779 return Amanda::Changer->make_error("fatal", undef,
780 message => "no default value for property MTX");
783 return Amanda::Changer::robot::Interface::MTX->new($device_name, $mtx, $ignore_barcodes),
786 # get, configure, and return a new device, or return a changer error
787 sub get_device { # (overridden by subclasses)
789 my ($device_name) = @_;
791 my $device = Amanda::Device->new($device_name);
792 if ($device->status != $DEVICE_STATUS_SUCCESS) {
793 return Amanda::Changer->make_error("fatal", undef,
795 message => "opening '$device_name': " . $device->error_or_status());
798 if (my $err = $self->{'config'}->configure_device($device)) {
799 return Amanda::Changer->make_error("fatal", undef,
811 return if $self->check_error($params{'finished_cb'});
813 $self->_with_updated_state(\%params, 'finished_cb',
814 sub { $self->_set_label_unlocked(@_); });
817 sub _set_label_unlocked {
820 my $state = $params{'state'};
822 # update all of the various pieces of cached information
823 my $drive = $params{'drive'};
824 my $slot = $state->{'drives'}->{$drive}->{'orig_slot'};
825 my $label = $params{'label'};
826 my $barcode = $state->{'drives'}->{$drive}->{'barcode'};
827 my $dev = $params{dev};
829 $state->{'drives'}->{$drive}->{'label'} = $label;
831 delete $state->{'slots'}->{$slot}->{'unkknown_state'};
832 $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
833 $state->{'slots'}->{$slot}->{'device_status'} = "".$dev->status;
834 my $volume_header = $dev->volume_header;
835 if (defined $volume_header) {
836 $state->{'slots'}->{$slot}->{'f_type'} = "".$volume_header->{type};
838 $state->{'slots'}->{$slot}->{'f_type'} = undef;
840 $state->{'slots'}->{$slot}->{'label'} = $label;
842 if (defined $barcode) {
843 $state->{'bc2lb'}->{$barcode} = $label;
846 $params{'finished_cb'}->(undef);
853 return if $self->check_error($params{'finished_cb'});
855 $self->_with_updated_state(\%params, 'finished_cb',
856 sub { $self->_release_unlocked(@_); });
859 sub _release_unlocked {
862 my $state = $params{'state'};
863 my $drive = $params{'drive'};
865 # delete the reservation and save the statefile
866 if (!$self->_res_info_is_mine($state->{'drives'}->{$drive}->{'res_info'})) {
867 # this should *never* happen
868 return $self->make_error("fatal", $params{'finished_cb'},
869 message => "reservation belongs to another instance");
871 $state->{'drives'}->{$drive}->{'res_info'} = undef;
873 # bounce off to eject if the user has requested it, using the xx_unlocked
874 # variant since we've already got the statefile open
875 if ($params{'eject'}) {
876 $self->eject_unlocked(
878 finished_cb => $params{'finished_cb'},
882 $params{'finished_cb'}->();
890 return if $self->check_error($params{'finished_cb'});
892 $self->_with_updated_state(\%params, 'finished_cb',
893 sub { $self->reset_unlocked(@_); });
899 my $state = $params{'state'};
901 $state->{'current_slot'} = $self->_get_next_slot($state, -1);
903 $params{'finished_cb'}->();
910 return if $self->check_error($params{'finished_cb'});
912 $self->_with_updated_state(\%params, 'finished_cb',
913 sub { $self->eject_unlocked(@_); });
919 my $state = $params{'state'};
920 my ($drive, $drive_info);
922 return if $self->check_error($params{'finished_cb'});
924 my $steps = define_steps
925 cb_ref => \$params{'finished_cb'};
927 # note that this changer treats "eject" as "unload", which may also require an eject
928 # operation if the eject_before_unload property is set
931 # if drive isn't specified, see if we only have one
932 if (!exists $params{'drive'}) {
933 if ((keys %{$self->{'drive2device'}}) == 1) {
934 $params{'drive'} = (keys %{$self->{'drive2device'}})[0];
936 return $self->make_error("failed", $params{'finished_cb'},
938 message => "no drive specified");
941 $drive = $params{'drive'};
943 $self->_debug("unloading drive $drive");
944 $drive_info = $state->{'drives'}->{$drive};
946 return $self->make_error("failed", $params{'finished_cb'},
948 message => "invalid drive '$drive'");
951 # if the drive exists, but not configured in this changer, then
953 if (!defined $self->{'drive2device'}->{$drive}) {
954 return $self->make_error("failed", $params{'finished_cb'},
956 message => "this changer instance is not configured to access drive $drive");
960 # check for a reservation
961 if ($drive_info->{'res_info'}
962 and $self->_res_info_verify($drive_info->{'res_info'})) {
963 return $self->make_error("failed", $params{'finished_cb'},
964 reason => "volinuse",
965 message => "tape in drive '$drive' is in use");
968 if ($self->{'eject_before_unload'}) {
969 $steps->{'wait_to_eject'}->();
971 $steps->{'wait_to_unload'}->();
975 step wait_to_eject => sub {
976 $self->_after_delay($state, $steps->{'eject'});
980 my $device_name = $self->{'drive2device'}->{$drive};
981 $self->_debug("ejecting $device_name before unload");
983 my $device = $self->get_device($device_name);
984 return $device if $device->isa("Amanda::Changer::Error");
986 if (!$device->eject()) {
987 return $self->make_error("failed", $params{'finished_cb'},
989 message => "while ejecting volume: " . $device->error_or_status);
993 $self->_set_delay($state, $self->{'eject_delay'});
995 $steps->{'wait_to_unload'}->();
998 step wait_to_unload => sub {
999 $self->_after_delay($state, $steps->{'unload'});
1002 step unload => sub {
1003 # find target slot and unload it - note that the target slot may not be
1004 # in the USE-SLOTS list, as it may belong to another config
1005 my $orig_slot = $drive_info->{'orig_slot'};
1006 $self->{'interface'}->unload($drive, $orig_slot, $steps->{'unload_finished'});
1009 step unload_finished => sub {
1013 return $self->make_error("failed", $params{'finished_cb'},
1014 reason => "unknown",
1018 $self->_debug("unload complete");
1019 my $orig_slot = $state->{'drives'}->{$drive}->{'orig_slot'};
1020 $state->{'slots'}->{$orig_slot}->{'state'} = $state->{'drives'}->{$drive}->{'state'};
1021 $state->{'slots'}->{$orig_slot}->{'label'} = $state->{'drives'}->{$drive}->{'label'};
1022 $state->{'slots'}->{$orig_slot}->{'barcode'} = $state->{'drives'}->{$drive}->{'barcode'};
1023 $state->{'slots'}->{$orig_slot}->{'loaded_in'} = undef;
1024 $state->{'drives'}->{$drive}->{'state'} = Amanda::Changer::SLOT_EMPTY;
1025 $state->{'drives'}->{$drive}->{'label'} = undef;
1026 $state->{'drives'}->{$drive}->{'barcode'} = undef;
1027 $state->{'drives'}->{$drive}->{'orig_slot'} = undef;
1029 $self->_set_delay($state, $self->{'unload_delay'});
1030 $params{'finished_cb'}->();
1038 return if $self->check_error($params{'finished_cb'});
1040 $self->_with_updated_state(\%params, 'finished_cb',
1041 sub { $self->update_unlocked(@_); });
1044 sub update_unlocked {
1048 my $state = $params{'state'};
1049 my $set_to_unknown = 0;
1051 return if $self->check_error($params{'finished_cb'});
1053 my $user_msg_fn = $params{'user_msg_fn'};
1054 $user_msg_fn ||= sub { $self->_debug($_[0]); };
1056 my $steps = define_steps
1057 cb_ref => \$params{'finished_cb'};
1059 step handle_assignment => sub {
1060 # check for the SL=LABEL format, and handle it here
1061 if (exists $params{'changed'} and $params{'changed'} =~ /^\d+=\S+$/) {
1062 my ($slot, $label) = ($params{'changed'} =~ /^(\d+)=(\S+)$/);
1064 # let's list the reasons we *can't* do what the user has asked
1066 if (!exists $state->{'slots'}) {
1067 $whynot = "slot $slot does not exist";
1068 } elsif (!$self->_is_slot_allowed($slot)) {
1069 $whynot = "slot $slot is not used by this changer";
1070 } elsif ($state->{'slots'}->{$slot}->{'state'} ==
1071 Amanda::Changer::SLOT_EMPTY) {
1072 $whynot = "slot $slot is empty";
1073 } elsif (defined $state->{'slots'}->{$slot}->{'loaded_in'}) {
1074 $whynot = "slot $slot is currently loaded";
1078 return $self->make_error("failed", $params{'finished_cb'},
1079 reason => "unknown", message => $whynot);
1082 $user_msg_fn->("recoding volume '$label' in slot $slot");
1083 # ok, now erase all knowledge of that label
1084 while (my ($bc, $lb) = each %{$state->{'bc2lb'}}) {
1085 if ($lb eq $label) {
1086 delete $state->{'bc2lb'}->{$bc};
1090 while (my ($sl, $inf) = each %{$state->{'slots'}}) {
1091 if ($inf->{'label'} and $inf->{'label'} eq $label) {
1092 delete $inf->{'device_status'};
1093 delete $inf->{'f_type'};
1094 delete $inf->{'label'};
1098 # and add knowledge of the label to the given slot
1099 #$state->{'slots'}->{$slot}->{'device_status'} = $DEVICE_STATUS_SUCCESS;
1100 #$state->{'slots'}->{$slot}->{'f_type'} = $Amanda::Header::F_TAPESTART;
1101 $state->{'slots'}->{$slot}->{'label'} = $label;
1102 if ($state->{'slots'}->{$slot}->{'barcode'}) {
1103 my $bc = $state->{'slots'}->{$slot}->{'barcode'};
1104 $state->{'bc2lb'}->{$bc} = $label;
1107 # that's it -- no changer motion required
1108 return $params{'finished_cb'}->(undef);
1109 } elsif (exists $params{'changed'} and
1110 $params{'changed'} =~ /^(.+)=$/) {
1111 $params{'changed'} = $1;
1112 $set_to_unknown = 1;
1113 $steps->{'calculate_slots'}->($steps->{'set_to_unknown'});
1115 $steps->{'calculate_slots'}->($steps->{'update_slot'});
1119 step calculate_slots => sub {
1120 my ($update_slot_cb) = shift @_;
1121 if (exists $params{'changed'}) {
1122 # parse the string just like use-slots, using a hash for uniqueness
1124 for my $range (split ',', $params{'changed'}) {
1125 my ($first, $last) = ($range =~ /(\d+)(?:-(\d+))?/);
1126 $last = $first unless defined($last);
1127 for ($first .. $last) {
1128 $changed{$_} = undef;
1132 @slots_to_check = keys %changed;
1133 @slots_to_check = grep { exists $state->{'slots'}->{$_} } @slots_to_check;
1135 @slots_to_check = keys %{ $state->{'slots'} };
1138 # limit the update to allowed slots, and sort them so we don't confuse
1139 # the user with a "random" order
1140 @slots_to_check = grep { $self->_is_slot_allowed($_) } @slots_to_check;
1141 @slots_to_check = grep { $state->{'slots'}->{$_}->{'state'} == Amanda::Changer::SLOT_FULL} @slots_to_check;
1142 @slots_to_check = sort { $a <=> $b } @slots_to_check;
1144 $update_slot_cb->();
1147 step set_to_unknown => sub {
1148 return $steps->{'done'}->() if (!@slots_to_check);
1150 my $slot = shift @slots_to_check;
1151 $user_msg_fn->("Removing entry for slot $slot");
1152 if (!defined $state->{'slots'}->{$slot}->{'barcode'}) {
1153 $state->{'slots'}->{$slot}->{'label'} = undef;
1154 $state->{'slots'}->{$slot}->{'device_status'} = undef;
1155 $state->{'slots'}->{$slot}->{'f_type'} = undef;
1156 if (defined $state->{'slots'}->{$slot}->{'loaded_in'}) {
1157 my $drive = $state->{'slots'}->{$slot}->{'loaded_in'};
1158 $state->{'drives'}->{$drive}->{'label'} = undef;
1159 $state->{'drives'}->{$drive}->{'state'} =
1160 Amanda::Changer::SLOT_FULL;
1163 $steps->{'set_to_unknown'}->();
1166 # TODO: parallelize this if multiple drives are available
1168 step update_slot => sub {
1169 return $steps->{'done'}->() if (!@slots_to_check);
1171 my $slot = shift @slots_to_check;
1172 $user_msg_fn->("scanning slot $slot");
1174 $self->load_unlocked(
1176 res_cb => $steps->{'slot_loaded'},
1180 step slot_loaded => sub {
1181 my ($err, $res) = @_;
1183 return $params{'finished_cb'}->($err);
1186 # load() already fixed up the metadata, so just release; but we have to
1187 # be careful to do an unlocked release.
1189 finished_cb => $steps->{'released'},
1194 step released => sub {
1197 return $params{'finished_cb'}->($err);
1200 $steps->{'update_slot'}->();
1204 $params{'finished_cb'}->(undef);
1212 return if $self->check_error($params{'inventory_cb'});
1214 $self->_with_updated_state(\%params, 'inventory_cb',
1215 sub { $self->inventory_unlocked(@_); });
1218 sub inventory_unlocked {
1221 my $state = $params{'state'};
1223 my @slot_names = sort { $a <=> $b } keys %{ $state->{'slots'} };
1225 for my $slot_name (@slot_names) {
1227 next unless $self->_is_slot_allowed($slot_name);
1228 my $slot = $state->{'slots'}->{$slot_name};
1230 $i->{'slot'} = $slot_name;
1231 $i->{'state'} = $slot->{'state'};
1232 $i->{'device_status'} = $slot->{'device_status'};
1233 $i->{'f_type'} = $slot->{'f_type'};
1234 $i->{'label'} = $slot->{'label'};
1235 $i->{'barcode'} = $slot->{'barcode'}
1236 if ($slot->{'barcode'});
1237 if (defined $slot->{'loaded_in'}) {
1238 $i->{'loaded_in'} = $slot->{'loaded_in'};
1239 my $drive = $state->{'drives'}->{$slot->{'loaded_in'}};
1240 if ($drive->{'res_info'} and $self->_res_info_verify($drive->{'res_info'})) {
1241 $i->{'reserved'} = 1;
1244 $i->{'import_export'} = 1
1248 if $slot_name eq $state->{'current_slot'};
1253 $params{'inventory_cb'}->(undef, \@inv);
1260 return if $self->check_error($params{'finished_cb'});
1262 $self->_with_updated_state(\%params, 'finished_cb',
1263 sub { $self->move_unlocked(@_); });
1269 my $state = $params{'state'};
1271 my $from_slot = $params{'from_slot'};
1272 my $to_slot = $params{'to_slot'};
1274 # make sure this is OK
1275 for ($from_slot, $to_slot) {
1276 if (!$self->_is_slot_allowed($_)) {
1277 return $self->make_error("failed", $params{'finished_cb'},
1278 reason => "invalid",
1279 message => "invalid slot $_");
1283 if ($state->{'slots'}->{$from_slot}->{'state'} == Amanda::Changer::SLOT_EMPTY) {
1284 return $self->make_error("failed", $params{'finished_cb'},
1285 reason => "invalid",
1286 message => "slot $from_slot is empty");
1289 my $in_drive = $state->{'slots'}->{$from_slot}->{'loaded_in'};
1290 if (defined $in_drive) {
1291 my $info = $state->{'drives'}->{$in_drive};
1292 if ($info->{'res_info'} and $self->_res_info_verify($info->{'res_info'})) {
1293 return $self->make_error("failed", $params{'finished_cb'},
1294 reason => "invalid",
1295 message => "slot $from_slot is currently loaded and reserved");
1299 if ($state->{'slots'}->{$to_slot}->{'state'} == Amanda::Changer::SLOT_FULL) {
1300 return $self->make_error("failed", $params{'finished_cb'},
1301 reason => "invalid",
1302 message => "slot $to_slot is not empty");
1305 # if the destination slot is loaded, then we could do an "exchange", but
1308 my $transfer_complete = make_cb(transfer_complete => sub {
1310 return $params{'finished_cb'}->($err) if $err;
1313 if ($from_slot ne $to_slot) {
1314 my $f = $state->{'slots'}->{$from_slot};
1315 my $t = $state->{'slots'}->{$to_slot};
1317 $t->{'device_status'} = $f->{'device_status'};
1318 $f->{'device_status'} = undef;
1320 $t->{'state'} = $f->{'state'};
1321 $f->{'state'} = Amanda::Changer::SLOT_EMPTY;
1323 $t->{'f_type'} = $f->{'f_type'};
1324 $f->{'f_type'} = undef;
1326 $t->{'label'} = $f->{'label'};
1327 $f->{'label'} = undef;
1329 $t->{'barcode'} = $f->{'barcode'};
1330 $f->{'barcode'} = undef;
1333 # properly represent the unload operation, if it was performed
1334 if (defined $in_drive) {
1335 $state->{'slots'}->{$from_slot}->{'loaded_in'} = undef;
1336 $state->{'slots'}->{$to_slot}->{'loaded_in'} = undef;
1338 $state->{'drives'}->{$in_drive}->{'state'} =
1339 Amanda::Changer::SLOT_EMPTY;
1340 $state->{'drives'}->{$in_drive}->{'label'} = undef;
1341 $state->{'drives'}->{$in_drive}->{'barcode'} = undef;
1342 $state->{'drives'}->{$in_drive}->{'orig_slot'} = undef;
1345 $params{'finished_cb'}->();
1348 # if the source slot is loaded, then this is just a directed unload operation;
1349 # otherwise, it's a transfer.
1350 if (defined $in_drive) {
1351 Amanda::Debug::debug("move(): unloading drive $in_drive to slot $to_slot");
1352 $self->{'interface'}->unload($in_drive, $to_slot, $transfer_complete);
1354 $self->{'interface'}->transfer($from_slot, $to_slot, $transfer_complete);
1361 # calculate the next highest non-empty slot after $slot (assuming that
1362 # the changer status has been updated)
1363 sub _get_next_slot {
1365 my ($state, $slot) = @_;
1367 my @nonempty = sort { $a <=> $b } grep {
1368 $state->{'slots'}->{$_}->{'state'} == Amanda::Changer::SLOT_FULL
1369 and $self->_is_slot_allowed($_)
1370 } keys(%{$state->{'slots'}});
1372 my @higher = grep { $_ > $slot } @nonempty;
1374 # return the next higher slot, or the first nonempty slot (to loop around)
1375 return $higher[0] if (@higher);
1376 return $nonempty[0];
1379 # is $slot in the slots specified by the use-slots property?
1380 sub _is_slot_allowed {
1384 # if use-slots is not specified, all slots are available
1385 return 1 unless ($self->{'use_slots'});
1387 for my $range (split ',', $self->{'use_slots'}) {
1388 my ($first, $last) = ($range =~ /(\d+)(?:-(\d+))?/);
1389 $last = $first unless defined($last);
1390 return 1 if ($slot >= $first and $slot <= $last);
1396 # add a prefix and call Amanda::Debug::debug
1400 # chg_name is not set until *after* the constructor finishes
1401 my $chg_name = $self->{'chg_name'} || $self->{'class_name'};
1402 debug("$chg_name: $msg");
1408 # Wait until the delay from the last operation has expired, and call the
1409 # given callback with the given arguments
1412 my ($state, $cb, @args) = @_;
1414 confess("undefined \$cb") unless (defined $cb);
1416 # if the current time is before $start, then we'll perform the action anyway; this
1417 # saves us from long delays when clocks fall out of sync or run backward, but delays
1419 my ($start, $end, $now);
1420 $start = $state->{'last_operation_time'};
1421 if (!defined $start) {
1422 return $cb->(@args);
1425 $end = $start + $state->{'last_operation_delay'};
1428 if ($now >= $start and $now < $end) {
1429 Amanda::MainLoop::call_after(1000 * ($end - $now), $cb, @args);
1431 return $cb->(@args);
1435 # set the delay parameters in the statefile
1438 my ($state, $delay) = @_;
1440 $state->{'last_operation_time'} = time;
1441 $state->{'last_operation_delay'} = $delay;
1445 # Statefile management
1447 # wrapper around Amanda::Changer's with_locked_state to lock the statefile and
1448 # then update the state with the results of the 'status' command.
1450 # Like with_locked_state, this method assumes the keyword-based parameter
1451 # style, and adds a 'state' parameter with the new state. Also like
1452 # with_locked_state, it replaces the $cbname key with a wrapped version of that
1453 # callback. It then calls $sub.
1454 sub _with_updated_state {
1456 my ($paramsref, $cbname, $sub) = @_;
1457 my %params = %$paramsref;
1460 my $steps = define_steps
1461 cb_ref => \$paramsref->{$cbname};
1464 $self->with_locked_state($self->{'statefile'},
1465 $params{$cbname}, $steps->{'got_lock'});
1468 step got_lock => sub {
1469 ($state, my $new_cb) = @_;
1471 # set up params for calling through to $sub later
1472 $params{'state'} = $state;
1473 $params{$cbname} = $new_cb;
1475 if (!keys %$state) {
1476 $state->{'slots'} = {};
1477 $state->{'drives'} = {};
1478 $state->{'drive_lru'} = [];
1479 $state->{'bc2lb'} = {};
1480 $state->{'current_slot'} = -1;
1483 # this is for testing ONLY!
1484 $self->{'__last_state'} = $state;
1486 # if it's not time for another run of the status command yet, then just skip to
1488 if (defined $state->{'last_status'}
1489 and time < $state->{'last_status'} + $self->{'status_interval'}) {
1490 $self->_debug("too early for another 'status' invocation");
1491 $steps->{'done'}->();
1493 $steps->{'wait'}->();
1498 $self->_after_delay($state, $steps->{'call_status'});
1501 step call_status => sub {
1502 $self->{'interface'}->status($steps->{'status_cb'});
1505 step status_cb => sub {
1506 my ($err, $status) = @_;
1508 return $self->make_error("fatal", $params{$cbname},
1512 $state->{'last_status'} = time;
1513 $self->_debug("updating state");
1515 # process the results; $status can update our slot->label
1516 # mapping, but the barcode->label mapping stays the same.
1519 my ($drv, $slot, $info);
1521 # note that loaded_in is always undef; it will be set correctly
1522 # when the drives are scanned
1523 while (($slot, $info) = each %{$status->{'slots'}}) {
1524 if ($info->{'empty'}) {
1526 $new_slots->{$slot} = {
1527 state => Amanda::Changer::SLOT_EMPTY,
1528 device_status => undef,
1533 ie => $info->{'ie'},
1538 if (defined $info->{'barcode'}) {
1540 my $label = $state->{'bc2lb'}->{$info->{'barcode'}};
1542 $new_slots->{$slot} = {
1543 state => Amanda::Changer::SLOT_FULL,
1544 device_status => $state->{'slots'}->{$slot}->{device_status},
1545 f_type => $state->{'slots'}->{$slot}->{f_type},
1547 barcode => $info->{'barcode'},
1549 ie => $info->{'ie'},
1552 # assume the status of this slot has not changed since the last
1553 # time we looked at it, although mark it as not loaded in a slot
1554 if (exists $state->{'slots'}->{$slot}) {
1555 $new_slots->{$slot} = $state->{'slots'}->{$slot};
1556 $new_slots->{$slot}->{'loaded_in'} = undef;
1558 $new_slots->{$slot} = {
1559 state => Amanda::Changer::SLOT_FULL,
1560 device_status => undef,
1565 ie => $info->{'ie'},
1570 my $old_slots_state = $state->{'slots'};
1571 $state->{'slots'} = $new_slots;
1573 # now handle the drives
1574 my $new_drives = {};
1575 while (($drv, $info) = each %{$status->{'drives'}}) {
1576 my $old_drive = $state->{'drives'}->{$drv};
1578 # if this drive still has a valid reservation, don't change it
1579 if (defined $old_drive->{'res_info'}
1580 and $self->_res_info_verify($old_drive->{'res_info'})) {
1581 $new_drives->{$drv} = $old_drive;
1585 # if the drive is empty, this is pretty easy
1586 if (!defined $info) {
1587 $new_drives->{$drv} = {
1588 state => Amanda::Changer::SLOT_EMPTY,
1596 # trust our own orig_slot over that from the changer, if possible,
1597 # as some changers do not report this information accurately
1598 my ($orig_slot, $label);
1599 if (defined $old_drive->{'orig_slot'}) {
1600 $orig_slot = $old_drive->{'orig_slot'};
1601 $label = $old_drive->{'label'};
1604 # but don't trust it if the barcode has changed
1605 if (defined $info->{'barcode'}
1606 and defined $old_drive->{'barcode'}
1607 and $info->{'barcode'} ne $old_drive->{'barcode'}) {
1612 # get the robot's notion of the original slot if we don't know ourselves
1613 if (!defined $orig_slot) {
1614 $orig_slot = $info->{'orig_slot'};
1617 # but if there's a tape in that slot, then we've got a problem
1618 if (defined $orig_slot
1619 and $state->{'slots'}->{$orig_slot}->{'state'} != Amanda::Changer::SLOT_EMPTY) {
1620 warning("mtx indicates tape in drive $drv should go to slot $orig_slot, " .
1621 "but that slot is not empty.");
1623 for my $slot (keys %{ $state->{'slots'} }) {
1624 if ($state->{'slots'}->{$slot}->{'state'} == Amanda::Changer::SLOT_EMPTY) {
1629 if (!defined $orig_slot) {
1630 warning("cannot find an empty slot for the tape in drive $drv");
1634 # and look up the label by barcode if possible
1635 if (!defined $label && defined $info->{'barcode'}) {
1636 $label = $state->{'bc2lb'}->{$info->{'barcode'}};
1639 $new_drives->{$drv} = {
1640 state => Amanda::Changer::SLOT_FULL,
1642 barcode => $info->{'barcode'},
1643 orig_slot => $orig_slot,
1646 $state->{'drives'} = $new_drives;
1648 # update the loaded_in info for the relevant slots
1649 while (($drv, $info) = each %$new_drives) {
1650 # also update the slots with the relevant 'loaded_in' info
1651 if (defined $info->{'orig_slot'}) {
1652 my $old_state = $old_slots_state->{$info->{'orig_slot'}};
1653 $state->{'slots'}->{$info->{'orig_slot'}} = {
1654 state => $info->{'state'},
1655 device_status => $old_state->{'device_status'},
1656 f_type => $old_state->{'f_type'},
1657 label => $info->{'label'},
1658 barcode => $info->{'barcode'},
1664 # sanity check that we don't have tape-device info for nonexistent drives
1665 for my $dr (@{$self->{'driveorder'}}) {
1666 if (!exists $state->{'drives'}->{$dr}) {
1667 warning("tape-device property specified for drive $dr, but no such " .
1668 "drive exists in the library");
1672 if ($state->{'current_slot'} == -1) {
1673 $state->{'current_slot'} = $self->_get_next_slot($state, -1);
1676 $steps->{'done'}->();
1680 # finally, call through to the user's method; $params{$cbname} has been
1681 # properly patched to release the state lock when this method is done.
1687 # reservation records
1689 # A reservation record is recorded in the statefile, and is distinct from an
1690 # Amanda::Changer::robot:Reservation object in that it is seen by all users of
1691 # the tape device, whether in this process or another.
1693 # This is abstracted out to enable support for a more robust mechanism than
1698 return { pid => $$, };
1701 sub _res_info_verify {
1703 my ($res_info) = @_;
1705 # true if this is our reservation
1706 return 1 if ($res_info->{'pid'} == $$);
1708 # or if the process is dead
1709 return kill 0, $res_info->{'pid'};
1712 sub _res_info_is_mine {
1714 my ($res_info) = @_;
1716 return 1 if ($res_info and $res_info->{'pid'} == $$);
1719 package Amanda::Changer::robot::Reservation;
1720 use vars qw( @ISA );
1721 use Amanda::Debug qw( debug warning );
1722 @ISA = qw( Amanda::Changer::Reservation );
1726 my ($chg, $slot, $drive, $device, $barcode) = @_;
1727 my $self = Amanda::Changer::Reservation::new($class);
1729 $self->{'chg'} = $chg;
1731 $self->{'drive'} = $drive;
1732 $self->{'device'} = $device;
1733 $self->{'this_slot'} = $slot;
1734 $self->{'barcode'} = $barcode;
1743 # if we're in global cleanup and the changer is already dead,
1745 return unless $self->{'chg'};
1747 # unref the device, for good measure
1748 $self->{'device'} = undef;
1750 # punt this method off to the changer itself, optionally calling
1751 # the unlocked version if we have the 'state' parameter
1752 if (exists $params{'unlocked'} and exists $params{'state'}) {
1753 $self->{'chg'}->_release_unlocked(drive => $self->{'drive'}, %params);
1755 $self->{'chg'}->_release(drive => $self->{'drive'}, %params);
1763 return unless $self->{'chg'};
1764 $self->{'chg'}->_set_label(drive => $self->{'drive'},
1765 dev => $self->{device}, %params);
1768 package Amanda::Changer::robot::Interface;
1770 # The physical interface to the changer is abstracted out to allow several
1771 # implementations (see chg-ndmp for one of them). This API is "reasonably
1772 # stable", but is really only known to this changer and its subclasses, so it's
1773 # not documented in POD. The methods are:
1775 # $iface->inquiry($inquiry_cb);
1777 # Inquire as to the relevant information about the changer. The result is a
1778 # hash table of lowercased key names and values, $info. The inquiry_cb is
1779 # called as $inquiry_cb->($errmsg, $info). The resulting strings have quotes
1780 # and whitespace stripped. Keys include 'vendor id' and 'product id'.
1782 # $iface->status($status_cb)
1784 # Get the READ ELEMENT STATUS output for the changer. The status_cb is called
1785 # as $status_cb->($errmsg, $status). $status is a hash with keys 'drives' and
1786 # 'slots', each of which is a hash indexed by the element address (note that drive
1787 # element addresses can and usually do overlap with slots. The values of the slots
1788 # hash are hashes with keys
1789 # - 'empty' (1 if the slot is empty)
1790 # - 'barcode' (which may be undef if the changer does not support barcodes)
1791 # - 'ie' (a boolean indicating whether this is an import/export slot).
1792 # The values of the drives are undef for empty drive, or hashes with keys
1793 # - 'barcode' (which may be undef if the changer does not support barcodes)
1794 # - 'orig_slot' (slot from which this volume was taken, if known)
1796 # $iface->load($slot, $drive, $finished_cb)
1798 # Load $slot into $drive. The finished_cb gets a single argument, $error,
1799 # which is only defined if an error occurred. Note that this does not
1800 # necessarily wait until the load operation is complete (most drives give
1801 # no such indication) (this method also implements unload, if $un=1)
1803 # $iface->unload($drive, $slot, $finished_cb);
1805 # Unload $drive into $slot. Finished_cb is just as for load().
1807 # $iface->eject($drive_name, $finished_cb);
1809 # Eject $drive_name (named /dev/whatever, not the drive number), and call finished_cb.
1811 # $iface->transfer($src_slot, $dst_slot, $finished_cb);
1813 # Move the tape in $src_slot into $dst_slot. The finished_cb gets a single
1814 # argument, $error, which is only defined if an error occurred. Note that this
1815 # does not necessarily wait until the load operation is complete.
1817 package Amanda::Changer::robot::Interface::MTX;
1820 use Amanda::Config qw( :getconf );
1821 use Amanda::Debug qw( debug warning );
1822 use Amanda::MainLoop qw( :GIOCondition synchronized make_cb define_steps step );
1823 use Amanda::Device qw( :constants );
1827 my ($device_name, $mtx, $ignore_barcodes) = @_;
1829 unless (-e $device_name) {
1830 return Amanda::Changer->make_error("fatal", undef,
1831 message => "'$device_name' not found");
1835 # This object uses a big lock to block *all* operations, not just mtx
1836 # invocations. This allows us to add delays to certain operations, while still
1839 device_name => $device_name,
1841 ignore_barcodes => $ignore_barcodes,
1847 my ($inquiry_cb) = @_;
1849 synchronized($self->{'lock'}, $inquiry_cb, sub {
1850 my ($inquiry_cb) = @_;
1851 my $sys_cb = make_cb(sys_cb => sub {
1852 my ($exitstatus, $output) = @_;
1853 if ($exitstatus != 0) {
1854 return $inquiry_cb->("error from mtx: " . $output, {});
1857 for my $line (split '\n', $output) {
1858 if (my ($k, $v) = ($line =~ /^(.*):\s*(.*)$/)) {
1859 $v =~ s/^'(.*)'$/$1/;
1864 return $inquiry_cb->(undef, \%info);
1868 $self->_run_system_command($sys_cb,
1869 $self->{'mtx'}, "-f", $self->{'device_name'}, 'inquiry');
1875 my ($status_cb) = @_;
1877 synchronized($self->{'lock'}, $status_cb, sub {
1878 my ($status_cb) = @_;
1880 my $sys_cb = make_cb(sys_cb => sub {
1881 my ($exitstatus, $output) = @_;
1882 if ($exitstatus != 0) {
1884 # if it's a regular SCSI error, just show the sense key
1885 my ($sensekey) = ($err =~ /mtx: Request Sense: Sense Key=(.*)\n/);
1886 $err = "SCSI error; Sense Key=$sensekey" if $sensekey;
1887 return $status_cb->("error from mtx: " . $err, {});
1890 for my $line (split '\n', $output) {
1891 my ($slot, $ie, $slinfo);
1893 # drives (data transfer elements)
1894 if (($slot, $slinfo) = ($line =~
1895 /^Data Transfer Element\s*(\d+)?\s*:\s*(.*)/i)) {
1896 # assume 0 when not given a drive #
1897 $slot = 0 unless defined $slot;
1898 if ($slinfo =~ /^Empty/i) {
1899 $status{'drives'}->{$slot} = undef;
1900 } elsif ($slinfo =~ /^Full/i) {
1901 my ($barcode, $orig_slot);
1902 ($barcode) = ($slinfo =~ /:VolumeTag\s*=\s*(\S+)/i);
1903 ($orig_slot) = ($slinfo =~ /\(Storage Element (\d+) Loaded\)/i);
1904 $status{'drives'}->{$slot} = {
1905 barcode => $barcode,
1906 orig_slot => $orig_slot,
1910 # slots (storage elements)
1911 } elsif (($slot, $ie, $slinfo) = ($line =~
1912 /^\s*Storage Element\s*(\d+)\s*(IMPORT\/EXPORT)?\s*:\s*(.*)/i)) {
1914 if ($slinfo =~ /^Empty/i) {
1915 $status{'slots'}->{$slot} = {
1919 } elsif ($slinfo =~ /^Full/i) {
1921 ($barcode) = ($slinfo =~ /:VolumeTag\s*=\s*(\S+)/i)
1922 unless ($self->{'ignore_barcodes'});
1923 $status{'slots'}->{$slot} = {
1924 barcode => $barcode,
1931 return $status_cb->(undef, \%status);
1935 my @nobarcode = ('nobarcode') if $self->{'ignore_barcodes'};
1936 $self->_run_system_command($sys_cb,
1937 $self->{'mtx'}, "-f", $self->{'device_name'}, @nobarcode, 'status');
1943 my ($slot, $drive, $finished_cb, $un) = @_;
1945 synchronized($self->{'lock'}, $finished_cb, sub {
1946 my ($finished_cb) = @_;
1948 my $sys_cb = make_cb(sys_cb => sub {
1949 my ($exitstatus, $output) = @_;
1950 if ($exitstatus != 0) {
1951 return $finished_cb->("error from mtx: " . $output);
1953 return $finished_cb->(undef);
1958 $self->_run_system_command($sys_cb,
1959 $self->{'mtx'}, "-f", $self->{'device_name'},
1960 $un? 'unload':'load', $slot, $drive);
1966 my ($drive, $slot, $finished_cb) = @_;
1967 return $self->load($slot, $drive, $finished_cb, 1);
1972 my ($src_slot, $dst_slot, $finished_cb) = @_;
1974 synchronized($self->{'lock'}, $finished_cb, sub {
1975 my ($finished_cb) = @_;
1977 my $sys_cb = make_cb(sys_cb => sub {
1978 my ($exitstatus, $output) = @_;
1979 if ($exitstatus != 0) {
1980 return $finished_cb->("error from mtx: " . $output);
1982 return $finished_cb->(undef);
1986 $self->_run_system_command($sys_cb,
1987 $self->{'mtx'}, "-f", $self->{'device_name'},
1988 'transfer', $src_slot, $dst_slot);
1992 # Run 'mtx' and capture the output. Standard output and error
1993 # are lumped together.
1995 # @param $sys_cb: called with ($exitstatus, $output)
1996 # @param @args: args to pass to exec()
1997 sub _run_system_command {
1998 my ($self, $sys_cb, @args) = @_;
2000 debug("invoking " . join(" ", @args));
2002 my ($readfd, $writefd) = POSIX::pipe();
2003 if (!defined($writefd)) {
2004 die("Error creating pipe: $!");
2008 if (!defined($pid) or $pid < 0) {
2009 die("Can't fork to run changer script: $!");
2015 # get our file-handle house in order
2016 POSIX::close($readfd);
2017 POSIX::dup2($writefd, 1);
2018 POSIX::dup2($writefd, 2);
2019 POSIX::close($writefd);
2021 %ENV = Amanda::Util::safe_env();
2023 { exec { $args[0] } @args; } # braces protect against warning
2029 # clean up file descriptors from the fork
2030 POSIX::close($writefd);
2032 # the callbacks that follow share these lexical variables
2034 my $child_output = '';
2036 my $child_exit_status = 0;
2037 my ($fdsrc, $cwsrc);
2038 my $open_sources = 0;
2040 my $steps = define_steps
2045 Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP)
2046 ->set_callback($steps->{'fd_source_cb'});
2049 Amanda::MainLoop::child_watch_source($pid)
2050 ->set_callback($steps->{'child_watch_source_cb'});
2053 step immediate => 1,
2054 fd_source_cb => sub {
2057 $len = POSIX::read($readfd, $bytes, 1024);
2059 # if we got an EOF, shut things down.
2062 POSIX::close($readfd);
2064 $fdsrc = undef; # break a reference loop
2065 $steps->{'maybe_finished'}->();
2067 # otherwise, just keep the bytes
2068 $child_output .= $bytes;
2072 step immediate => 1,
2073 child_watch_source_cb => sub {
2074 my ($cwsrc, $got_pid, $got_status) = @_;
2076 $cwsrc = undef; # break a reference loop
2078 $child_exit_status = $got_status;
2080 $steps->{'maybe_finished'}->();
2083 step maybe_finished => sub {
2084 return if --$open_sources;
2086 # everything is finished -- process the results and invoke the callback
2087 chomp $child_output;
2089 # let the callback take care of any further interpretation
2090 my $exitval = POSIX::WEXITSTATUS($child_exit_status);
2091 $sys_cb->($exitval, $child_output);