1 # Copyright (c) 2008-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the terms of the GNU General Public License
5 # as published by the Free Software Foundation; either version 2
6 # of the License, or (at your option) any later version.
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
20 package Amanda::Changer::compat;
25 @ISA = qw( Amanda::Changer );
28 use File::Glob qw( :glob );
31 use Amanda::MainLoop qw( :GIOCondition );
32 use Amanda::Config qw( :getconf );
33 use Amanda::Debug qw( debug );
34 use Amanda::Device qw( :constants );
40 Amanda::Changer::compat -- run "old" changer scripts
44 This package calls through to old Changer API shell scripts using the new API.
45 If necessary, it writes temporary configurations under C<$AMANDA_TMPDIR> and
46 invokes the changer there, allowing multiple distinct changers to run within
47 the same Amanda process.
49 See the amanda-changers(7) manpage for usage information.
53 In-process reservations are handled correctly - only one device may be used at
54 a time. However, the underlying scripts do not support reservations, so
55 another application can easily run the script and change the current device.
61 # Clean out old changer temporary directories on object destruction.
65 my ($config, $tpchanger) = @_;
66 my ($script) = ($tpchanger =~ /chg-compat:(.*)/);
69 $script = "$amlibexecdir/$script";
73 return Amanda::Changer->make_error("fatal", undef,
74 message => "'$script' is not executable");
88 bless ($self, $class);
90 $self->_make_cfg_dir($config);
92 debug("$class initialized with script $script, temporary directory $self->{cfg_dir}");
101 $self->validate_params('load', \%params);
102 return if $self->check_error($params{'res_cb'});
104 if ($self->{'reserved'}) {
105 return $self->make_error("failed", $params{'res_cb'},
106 reason => "driveinuse",
107 message => "Changer is already reserved: '" . $self->{'reserved'}->device_name . "'");
110 my $steps = define_steps
111 cb_ref => \$params{'res_cb'};
113 # make sure the info is loaded, and re-call load() if we have to wait
114 step get_info => sub {
115 $self->_get_info($steps->{'got_info'});
118 step got_info => sub {
119 my ($exitval, $message) = @_;
120 if (defined $exitval) { # error
121 # this is always fatal - we can't load without info
122 return $self->make_error("fatal", $params{'res_cb'},
123 message => $message);
126 $steps->{'start_load'}->();
129 step start_load => sub {
130 if (exists $params{'label'}) {
131 if ($self->{'searchable'}) {
132 $self->_run_tpchanger($steps->{'load_run_done'}, "-search", $params{'label'});
134 # not searchable -- run a manual scan
135 $self->_manual_scan(%params);
137 } elsif (exists $params{'relative_slot'}) {
138 # if there is an explicit $slot, then just hope it's the same as the current
139 # slot, or we're in trouble. We don't know what the current slot is, so we
140 # can't verify, but the current slot is set on *every* load, so this works.
142 # if we've already seen nslots slots, then the next slot is
143 # certainly one of them, so the iteration should terminate.
144 # However, not all changers will return nslots distinct slots
145 # (chg-zd-mtx skips empty slots, for example), so we will need to
146 # protect against except_slots in other ways, too.
147 if (exists $params{'except_slots'} and (keys %{$params{'except_slots'}}) == $self->{'nslots'}) {
148 return $self->make_error("failed", $params{'res_cb'},
149 reason => 'notfound',
150 message => "all slots have been loaded");
153 $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'relative_slot'});
154 } elsif (exists $params{'slot'}) {
155 $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'slot'});
159 step load_run_done => sub {
160 my ($exitval, $slot, $rest) = @_;
163 return $self->make_error("fatal", $params{'res_cb'},
164 message => "changer script did not provide a device name");
166 } elsif ($exitval >= 2) {
167 return $self->make_error("fatal", $params{'res_cb'},
170 return $self->make_error("failed", $params{'res_cb'},
171 reason => "notfound",
175 # re-check except_slots, and return 'notfound' if we've loaded a
176 # forbidden slot. This will generally happen when scanning, and when
177 # the underlying changer script has "skipped" some slots and looped
178 # around earlier than we expected.
179 if (exists $params{'except_slots'} and exists $params{'except_slots'}{$slot}) {
180 return $self->make_error("failed", $params{'res_cb'},
181 reason => 'notfound',
182 message => "all slots have been loaded");
185 return $self->_make_res($params{'res_cb'}, $slot, $rest, undef);
193 my ($get_info, $got_info, $run_cb, $load_next);
194 my $first_scanned_slot = -1;
196 my $user_msg_fn = $params{'user_msg_fn'};
197 $user_msg_fn ||= sub { Amanda::Debug::info("chg-compat: " . $_[0]); };
199 # search manually, starting with "current" and proceeding through nslots-1
200 # loads of "next". This doesn't use the except_slots iteration mechanism as
201 # that would just add extra layers of complexity with no benefit
204 $self->_get_info($got_info);
208 $user_msg_fn->("beginning manual scan of $self->{nslots} slots");
209 $self->_run_tpchanger($run_cb, "-slot", "current");
212 my ($exitval, $slot, $rest) = @_;
214 if ($slot == $first_scanned_slot) {
215 $nchecked = $self->{'nslots'};
216 return $load_next->();
219 $first_scanned_slot = $slot if $first_scanned_slot == -1;
221 $user_msg_fn->("updated slot $slot");
223 # if we're looking for a label, check what we got
224 if (defined $params{'label'}) {
225 my $device = Amanda::Device->new($rest);
226 if ($device and $device->configure(1)
227 and $device->read_label() == $DEVICE_STATUS_SUCCESS
228 and $device->volume_label() eq $params{'label'}) {
229 # we found the correct slot
230 $self->_make_res($params{'res_cb'}, $slot, $rest, $device);
235 return $load_next->();
237 # don't continue scanning after a fatal error
239 return $self->make_error("fatal", $params{'res_cb'},
243 return $load_next->();
248 # if we've scanned all nslots, we haven't found the label.
249 if (++$nchecked >= $self->{'nslots'}) {
250 if (defined $params{'label'}) {
251 return $self->make_error("failed", $params{'res_cb'},
252 reason => "notfound",
253 message => "Volume '$params{label}' not found");
255 return $params{'res_cb'}->(undef, undef);
259 $self->_run_tpchanger($run_cb, "-slot", "next");
265 # takes $res_cb, $slot and $rest; creates and configures the device, and calls
266 # $res_cb with the results.
269 my ($res_cb, $slot, $rest, $device) = @_;
272 if (!defined $device) {
273 $device = Amanda::Device->new($rest);
274 if ($device->status != $DEVICE_STATUS_SUCCESS) {
275 return $self->make_error("failed", $res_cb,
277 message => "opening '$rest': " . $device->error_or_status());
281 if (my $err = $self->{'config'}->configure_device($device)) {
282 return $self->make_error("failed", $res_cb,
287 $res = Amanda::Changer::compat::Reservation->new($self, $slot, $device);
288 $device->read_label();
290 $res_cb->(undef, $res);
297 $self->_get_info(sub {
298 my ($exitval, $message) = @_;
299 if (defined $exitval) { # error
301 return $self->make_error("fatal", $params{'finished_cb'},
302 message => $message);
304 return $self->make_error("failed", $params{'finished_cb'},
305 reason => "notfound",
306 message => $message);
310 # no error, so we're done with setup
311 $params{'finished_cb'}->();
317 my ($key, %params) = @_;
320 if ($key eq 'num_slots') {
321 $results{$key} = $self->{'nslots'};
322 } elsif ($key eq 'fast_search') {
323 $results{$key} = $self->{'searchable'};
326 $params{'info_cb'}->(undef, %results) if $params{'info_cb'};
329 # run a simple op -- no arguments, no slot returned
336 my ($exitval, $slot, $rest) = @_;
338 if (exists $params{'finished_cb'}) {
339 $params{'finished_cb'}->(undef);
343 return $self->make_error("fatal", $params{'finished_cb'},
346 return $self->make_error("failed", $params{'finished_cb'},
352 $self->_run_tpchanger($run_cb, "-$op");
359 $self->_simple_op("reset", %params);
366 # note: parameter 'drive' is ignored
367 $self->_simple_op("clean", %params);
374 # note: parameter 'drive' is ignored
375 $self->_simple_op("eject", %params);
382 if ($params{'changed'}) {
383 return $self->make_error("failed", $params{'finished_cb'},
385 message => 'chg-compat does not support specifying what has changed');
388 my $scan_done_cb = make_cb(scan_done_cb => sub {
389 my ($err, $res) = @_;
391 return $params{'finished_cb'}->($err);
394 # we didn't search for a label, so we don't get a reservation
395 $params{'finished_cb'}->(undef);
398 # for compat changers, "update" just entails scanning the whole changer
400 res_cb => $scan_done_cb,
401 label => undef, # search forever
402 user_msg_fn => $params{'user_msg_fn'},
406 # Internal function to call the script's -info and store the results in $self.
407 # If this returns true, then the info is loaded; otherwise, got_info_cb will be
408 # called either with no arguments (success) or ($exitval, $message) on error.
410 my ($self, $got_info_cb) = @_;
412 Amanda::MainLoop::synchronized($self->{'info_lock'}, $got_info_cb, sub {
413 my ($got_info_cb) = @_;
415 # if we've already got info, just call back right away
416 if ($self->{'got_info'}) {
417 return $got_info_cb->();
421 my ($exitval, $slot, $rest) = @_;
423 # old, unsearchable changers don't return the third result, so it's
424 # optional in the regex
425 unless ($rest =~ /(\d+) (\d+) ?(\d+)?/) {
426 return $got_info_cb->(2,
427 "Malformed response from changer -info: $rest");
430 $self->{'nslots'} = $1;
431 $self->{'backward'} = $2;
432 $self->{'searchable'} = $3? 1:0;
434 $self->{'got_info'} = 1;
435 return $got_info_cb->(undef, undef);
437 return $got_info_cb->($exitval, $rest);
441 $self->_run_tpchanger($run_cb, "-info");
445 # Internal function to create a temporary configuration directory, which persists
446 # for the duration of this changer's lifetime (and beyond, TODO)
448 my ($self, $config) = @_;
450 if ($config->{'is_global'}) {
451 # for the default changer, we don't need to invent a config..
452 $self->{'cfg_dir'} = Amanda::Config::get_config_dir();
454 my $cfg_name = Amanda::Config::get_config_name();
455 my $changer_name = $config->{'name'};
456 my $tapedev = $config->{'tapedev'};
457 my $tpchanger = $config->{'tpchanger'};
458 my $changerdev = $config->{'changerdev'};
459 my $changerfile = $config->{'changerfile'};
461 my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name";
465 or die("Could not delete '$cfg_dir'");
469 or die("Could not create '$cfg_dir'");
471 # Write an amanda.conf
472 open(my $amconf, ">", "$cfg_dir/amanda.conf")
473 or die ("Could not write '$cfg_dir/amanda.conf'");
475 print $amconf "# automatically generated by Amanda::Changer::compat\n";
476 print $amconf 'org "', getconf($CNF_ORG), "\"\n"
477 if getconf_seen($CNF_ORG);
478 print $amconf 'mailto "', getconf($CNF_MAILTO), "\"\n"
479 if getconf_seen($CNF_MAILTO);
480 print $amconf 'mailer "', getconf($CNF_MAILER), "\"\n"
481 if getconf_seen($CNF_MAILER);
482 print $amconf "tapedev \"$tapedev\"\n"
483 if defined($tapedev);
484 print $amconf "tpchanger \"$tpchanger\"\n"
485 if defined($tpchanger);
486 print $amconf "changerdev \"$changerdev\"\n"
487 if defined($changerdev);
488 print $amconf "changerfile \"",
489 Amanda::Config::config_dir_relative($changerfile),
491 if defined($changerfile);
493 # TODO: device_property, tapetype, and the tapetype def
497 $self->{'cfg_dir'} = $cfg_dir;
502 # Internal-use function to actually invoke a changer script and parse
505 # @param $run_cb: called with ($exitval, $slot, $rest)
506 # @params @args: command-line arguments to follow the name of the changer
508 my ($self, $run_cb, @args) = @_;
510 Amanda::MainLoop::synchronized($self->{'lock'}, $run_cb, sub {
512 debug("Amanda::Changer::compat: invoking $self->{script} with " . join(" ", @args));
514 my ($readfd, $writefd) = POSIX::pipe();
515 if (!defined($writefd)) {
516 croak("Error creating pipe to run changer script: $!");
520 if (!defined($pid) or $pid < 0) {
521 croak("Can't fork to run changer script: $!");
527 # get our file-handle house in order
528 POSIX::close($readfd);
529 POSIX::dup2($writefd, 1);
530 POSIX::close($writefd);
532 # cd into the config dir
533 if (!chdir($self->{'cfg_dir'})) {
534 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n";
538 %ENV = Amanda::Util::safe_env();
540 my $script = $self->{'script'};
541 { exec { $script } $script, @args; } # braces protect against warning
543 my $err = "<error> Could not exec $script: $!\n";
544 POSIX::write($writefd, $err, length($err));
550 # clean up file descriptors from the fork
551 POSIX::close($writefd);
553 # the callbacks that follow share these lexical variables
555 my $child_output = '';
557 my $child_exit_status = 0;
559 my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
561 # Perl note: we have to use anonymous subs here, as they are instantiated
562 # at runtime, rather than at compile time.
564 $maybe_finished = sub {
565 return unless $child_eof;
566 return unless $child_dead;
568 # everything is finished -- process the results and invoke the callback
571 # handle unexpected exit status as a fatal error
572 if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 2) {
573 $run_cb->(POSIX::WEXITSTATUS($child_exit_status), undef,
574 "Fatal error from changer script: ".$child_output);
578 # parse the child's output
579 my @child_output = split '\n', $child_output;
580 my $exitval = POSIX::WEXITSTATUS($child_exit_status);
582 debug("Amanda::Changer::compat: Got response '$child_output' with exit status $exitval");
583 if (@child_output < 1) {
584 $run_cb->(2, undef, "Malformed output from changer script -- no output");
587 my $slotline = shift @child_output;
588 if ($slotline !~ /\s*([^\s]+)(?:\s+(.+))?/) {
589 $run_cb->(2, undef, "Malformed output from changer script: '$slotline'");
592 my ($slot, $rest) = ($1, $2);
594 # append any additional lines to $rest
596 $rest .= "\n" . join("\n", @child_output);
599 # let the callback take care of any further interpretation
600 $run_cb->($exitval, $slot, $rest);
603 $fd_source_cb = sub {
606 $len = POSIX::read($readfd, $bytes, 1024);
608 # if we got an EOF, shut things down.
611 POSIX::close($readfd);
613 $fdsrc = undef; # break a reference loop
616 # otherwise, just keep the bytes
617 $child_output .= $bytes;
620 $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
621 $fdsrc->set_callback($fd_source_cb);
623 $child_watch_source_cb = sub {
624 my ($cwsrc, $got_pid, $got_status) = @_;
626 $cwsrc = undef; # break a reference loop
628 $child_exit_status = $got_status;
632 $cwsrc = Amanda::MainLoop::child_watch_source($pid);
633 $cwsrc->set_callback($child_watch_source_cb);
637 package Amanda::Changer::compat::Reservation;
639 use Amanda::Debug qw( debug );
640 @ISA = qw( Amanda::Changer::Reservation );
644 my ($chg, $slot, $device) = @_;
645 my $self = Amanda::Changer::Reservation::new($class);
647 $self->{'chg'} = $chg;
649 $self->{'device'} = $device;
650 $self->{'this_slot'} = $slot;
652 # mark the changer as reserved
653 $self->{'chg'}->{'reserved'} = $device;
665 $self->{'chg'}->{'reserved'} = 0;
667 # unref the device, for good measure
668 $self->{'device'} = undef;
670 $params{'finished_cb'}->($message) if $params{'finished_cb'};
673 if (exists $params{'eject'} && $params{'eject'}) {
674 $self->{'chg'}->eject(finished_cb => $finished);
684 # non-searchable changers don't get -label, except that chg-zd-mtx needs
685 # it to maintain its slotinfofile (this is a hack)
686 if (!$self->{'chg'}->{'searchable'}
687 && $self->{'chg'}->{'script'} !~ /chg-zd-mtx$/) {
688 debug("Amanda::Changer::compat - changer script is not searchable, so not invoking -label for set_label");
689 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
693 if (!defined $params{'label'}) {
694 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
699 my ($exitval, $slot, $rest) = @_;
701 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
704 return $self->{'chg'}->make_error("fatal", $params{'finished_cb'},
707 return $self->{'chg'}->make_error("failed", $params{'finished_cb'},
713 $self->{'chg'}->_run_tpchanger(
714 $run_cb, "-label", $params{'label'});