1 # Copyright (c) 2008, 2009, 2010 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU General Public License version 2 as published
5 # by the Free Software Foundation.
7 # This program is distributed in the hope that it will be useful, but
8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
9 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 # You should have received a copy of the GNU General Public License along
13 # with this program; if not, write to the Free Software Foundation, Inc.,
14 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
19 package Amanda::Changer::compat;
24 @ISA = qw( Amanda::Changer );
27 use File::Glob qw( :glob );
30 use Amanda::MainLoop qw( :GIOCondition );
31 use Amanda::Config qw( :getconf );
32 use Amanda::Debug qw( debug );
33 use Amanda::Device qw( :constants );
39 Amanda::Changer::compat -- run "old" changer scripts
43 This package calls through to old Changer API shell scripts using the new API.
44 If necessary, it writes temporary configurations under C<$AMANDA_TMPDIR> and
45 invokes the changer there, allowing multiple distinct changers to run within
46 the same Amanda process.
48 See the amanda-changers(7) manpage for usage information.
52 In-process reservations are handled correctly - only one device may be used at
53 a time. However, the underlying scripts do not support reservations, so
54 another application can easily run the script and change the current device.
60 # Clean out old changer temporary directories on object destruction.
64 my ($config, $tpchanger) = @_;
65 my ($script) = ($tpchanger =~ /chg-compat:(.*)/);
68 $script = "$amlibexecdir/$script";
72 return Amanda::Changer->make_error("fatal", undef,
73 message => "'$script' is not executable");
87 bless ($self, $class);
89 $self->_make_cfg_dir($config);
91 debug("$class initialized with script $script, temporary directory $self->{cfg_dir}");
100 $self->validate_params('load', \%params);
101 return if $self->check_error($params{'res_cb'});
103 if ($self->{'reserved'}) {
104 return $self->make_error("failed", $params{'res_cb'},
105 reason => "driveinuse",
106 message => "Changer is already reserved: '" . $self->{'reserved'}->device_name . "'");
109 my $steps = define_steps
110 cb_ref => \$params{'res_cb'};
112 # make sure the info is loaded, and re-call load() if we have to wait
113 step get_info => sub {
114 $self->_get_info($steps->{'got_info'});
117 step got_info => sub {
118 my ($exitval, $message) = @_;
119 if (defined $exitval) { # error
120 # this is always fatal - we can't load without info
121 return $self->make_error("fatal", $params{'res_cb'},
122 message => $message);
125 $steps->{'start_load'}->();
128 step start_load => sub {
129 if (exists $params{'label'}) {
130 if ($self->{'searchable'}) {
131 $self->_run_tpchanger($steps->{'load_run_done'}, "-search", $params{'label'});
133 # not searchable -- run a manual scan
134 $self->_manual_scan(%params);
136 } elsif (exists $params{'relative_slot'}) {
137 # if there is an explicit $slot, then just hope it's the same as the current
138 # slot, or we're in trouble. We don't know what the current slot is, so we
139 # can't verify, but the current slot is set on *every* load, so this works.
141 # if we've already seen nslots slots, then the next slot is
142 # certainly one of them, so the iteration should terminate.
143 # However, not all changers will return nslots distinct slots
144 # (chg-zd-mtx skips empty slots, for example), so we will need to
145 # protect against except_slots in other ways, too.
146 if (exists $params{'except_slots'} and (keys %{$params{'except_slots'}}) == $self->{'nslots'}) {
147 return $self->make_error("failed", $params{'res_cb'},
148 reason => 'notfound',
149 message => "all slots have been loaded");
152 $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'relative_slot'});
153 } elsif (exists $params{'slot'}) {
154 $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'slot'});
158 step load_run_done => sub {
159 my ($exitval, $slot, $rest) = @_;
162 return $self->make_error("fatal", $params{'res_cb'},
163 message => "changer script did not provide a device name");
165 } elsif ($exitval >= 2) {
166 return $self->make_error("fatal", $params{'res_cb'},
169 return $self->make_error("failed", $params{'res_cb'},
170 reason => "notfound",
174 # re-check except_slots, and return 'notfound' if we've loaded a
175 # forbidden slot. This will generally happen when scanning, and when
176 # the underlying changer script has "skipped" some slots and looped
177 # around earlier than we expected.
178 if (exists $params{'except_slots'} and exists $params{'except_slots'}{$slot}) {
179 return $self->make_error("failed", $params{'res_cb'},
180 reason => 'notfound',
181 message => "all slots have been loaded");
184 return $self->_make_res($params{'res_cb'}, $slot, $rest, undef);
192 my ($get_info, $got_info, $run_cb, $load_next);
193 my $first_scanned_slot = -1;
195 my $user_msg_fn = $params{'user_msg_fn'};
196 $user_msg_fn ||= sub { Amanda::Debug::info("chg-compat: " . $_[0]); };
198 # search manually, starting with "current" and proceeding through nslots-1
199 # loads of "next". This doesn't use the except_slots iteration mechanism as
200 # that would just add extra layers of complexity with no benefit
203 $self->_get_info($got_info);
207 $user_msg_fn->("beginning manual scan of $self->{nslots} slots");
208 $self->_run_tpchanger($run_cb, "-slot", "current");
211 my ($exitval, $slot, $rest) = @_;
213 if ($slot == $first_scanned_slot) {
214 $nchecked = $self->{'nslots'};
215 return $load_next->();
218 $first_scanned_slot = $slot if $first_scanned_slot == -1;
220 $user_msg_fn->("updated slot $slot");
222 # if we're looking for a label, check what we got
223 if (defined $params{'label'}) {
224 my $device = Amanda::Device->new($rest);
225 if ($device and $device->configure(1)
226 and $device->read_label() == $DEVICE_STATUS_SUCCESS
227 and $device->volume_label() eq $params{'label'}) {
228 # we found the correct slot
229 $self->_make_res($params{'res_cb'}, $slot, $rest, $device);
234 return $load_next->();
236 # don't continue scanning after a fatal error
238 return $self->make_error("fatal", $params{'res_cb'},
242 return $load_next->();
247 # if we've scanned all nslots, we haven't found the label.
248 if (++$nchecked >= $self->{'nslots'}) {
249 if (defined $params{'label'}) {
250 return $self->make_error("failed", $params{'res_cb'},
251 reason => "notfound",
252 message => "Volume '$params{label}' not found");
254 return $params{'res_cb'}->(undef, undef);
258 $self->_run_tpchanger($run_cb, "-slot", "next");
264 # takes $res_cb, $slot and $rest; creates and configures the device, and calls
265 # $res_cb with the results.
268 my ($res_cb, $slot, $rest, $device) = @_;
271 if (!defined $device) {
272 $device = Amanda::Device->new($rest);
273 if ($device->status != $DEVICE_STATUS_SUCCESS) {
274 return $self->make_error("failed", $res_cb,
276 message => "opening '$rest': " . $device->error_or_status());
280 if (my $err = $self->{'config'}->configure_device($device)) {
281 return $self->make_error("failed", $res_cb,
286 $res = Amanda::Changer::compat::Reservation->new($self, $slot, $device);
287 $device->read_label();
289 $res_cb->(undef, $res);
296 $self->_get_info(sub {
297 my ($exitval, $message) = @_;
298 if (defined $exitval) { # error
300 return $self->make_error("fatal", $params{'finished_cb'},
301 message => $message);
303 return $self->make_error("failed", $params{'finished_cb'},
304 reason => "notfound",
305 message => $message);
309 # no error, so we're done with setup
310 $params{'finished_cb'}->();
316 my ($key, %params) = @_;
319 if ($key eq 'num_slots') {
320 $results{$key} = $self->{'nslots'};
321 } elsif ($key eq 'fast_search') {
322 $results{$key} = $self->{'searchable'};
325 $params{'info_cb'}->(undef, %results) if $params{'info_cb'};
328 # run a simple op -- no arguments, no slot returned
335 my ($exitval, $slot, $rest) = @_;
337 if (exists $params{'finished_cb'}) {
338 $params{'finished_cb'}->(undef);
342 return $self->make_error("fatal", $params{'finished_cb'},
345 return $self->make_error("failed", $params{'finished_cb'},
351 $self->_run_tpchanger($run_cb, "-$op");
358 $self->_simple_op("reset", %params);
365 # note: parameter 'drive' is ignored
366 $self->_simple_op("clean", %params);
373 # note: parameter 'drive' is ignored
374 $self->_simple_op("eject", %params);
381 if ($params{'changed'}) {
382 return $self->make_error("failed", $params{'finished_cb'},
384 message => 'chg-compat does not support specifying what has changed');
387 my $scan_done_cb = make_cb(scan_done_cb => sub {
388 my ($err, $res) = @_;
390 return $params{'finished_cb'}->($err);
393 # we didn't search for a label, so we don't get a reservation
394 $params{'finished_cb'}->(undef);
397 # for compat changers, "update" just entails scanning the whole changer
399 res_cb => $scan_done_cb,
400 label => undef, # search forever
401 user_msg_fn => $params{'user_msg_fn'},
405 # Internal function to call the script's -info and store the results in $self.
406 # If this returns true, then the info is loaded; otherwise, got_info_cb will be
407 # called either with no arguments (success) or ($exitval, $message) on error.
409 my ($self, $got_info_cb) = @_;
411 Amanda::MainLoop::synchronized($self->{'info_lock'}, $got_info_cb, sub {
412 my ($got_info_cb) = @_;
414 # if we've already got info, just call back right away
415 if ($self->{'got_info'}) {
416 return $got_info_cb->();
420 my ($exitval, $slot, $rest) = @_;
422 # old, unsearchable changers don't return the third result, so it's
423 # optional in the regex
424 unless ($rest =~ /(\d+) (\d+) ?(\d+)?/) {
425 return $got_info_cb->(2,
426 "Malformed response from changer -info: $rest");
429 $self->{'nslots'} = $1;
430 $self->{'backward'} = $2;
431 $self->{'searchable'} = $3? 1:0;
433 $self->{'got_info'} = 1;
434 return $got_info_cb->(undef, undef);
436 return $got_info_cb->($exitval, $rest);
440 $self->_run_tpchanger($run_cb, "-info");
444 # Internal function to create a temporary configuration directory, which persists
445 # for the duration of this changer's lifetime (and beyond, TODO)
447 my ($self, $config) = @_;
449 if ($config->{'is_global'}) {
450 # for the default changer, we don't need to invent a config..
451 $self->{'cfg_dir'} = Amanda::Config::get_config_dir();
453 my $cfg_name = Amanda::Config::get_config_name();
454 my $changer_name = $config->{'name'};
455 my $tapedev = $config->{'tapedev'};
456 my $tpchanger = $config->{'tpchanger'};
457 my $changerdev = $config->{'changerdev'};
458 my $changerfile = $config->{'changerfile'};
460 my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name";
464 or die("Could not delete '$cfg_dir'");
468 or die("Could not create '$cfg_dir'");
470 # Write an amanda.conf
471 open(my $amconf, ">", "$cfg_dir/amanda.conf")
472 or die ("Could not write '$cfg_dir/amanda.conf'");
474 print $amconf "# automatically generated by Amanda::Changer::compat\n";
475 print $amconf 'org "', getconf($CNF_ORG), "\"\n"
476 if getconf_seen($CNF_ORG);
477 print $amconf 'mailto "', getconf($CNF_MAILTO), "\"\n"
478 if getconf_seen($CNF_MAILTO);
479 print $amconf 'mailer "', getconf($CNF_MAILER), "\"\n"
480 if getconf_seen($CNF_MAILER);
481 print $amconf "tapedev \"$tapedev\"\n"
482 if defined($tapedev);
483 print $amconf "tpchanger \"$tpchanger\"\n"
484 if defined($tpchanger);
485 print $amconf "changerdev \"$changerdev\"\n"
486 if defined($changerdev);
487 print $amconf "changerfile \"",
488 Amanda::Config::config_dir_relative($changerfile),
490 if defined($changerfile);
492 # TODO: device_property, tapetype, and the tapetype def
496 $self->{'cfg_dir'} = $cfg_dir;
501 # Internal-use function to actually invoke a changer script and parse
504 # @param $run_cb: called with ($exitval, $slot, $rest)
505 # @params @args: command-line arguments to follow the name of the changer
507 my ($self, $run_cb, @args) = @_;
509 Amanda::MainLoop::synchronized($self->{'lock'}, $run_cb, sub {
511 debug("Amanda::Changer::compat: invoking $self->{script} with " . join(" ", @args));
513 my ($readfd, $writefd) = POSIX::pipe();
514 if (!defined($writefd)) {
515 croak("Error creating pipe to run changer script: $!");
519 if (!defined($pid) or $pid < 0) {
520 croak("Can't fork to run changer script: $!");
526 # get our file-handle house in order
527 POSIX::close($readfd);
528 POSIX::dup2($writefd, 1);
529 POSIX::close($writefd);
531 # cd into the config dir
532 if (!chdir($self->{'cfg_dir'})) {
533 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n";
537 %ENV = Amanda::Util::safe_env();
539 my $script = $self->{'script'};
540 { exec { $script } $script, @args; } # braces protect against warning
542 my $err = "<error> Could not exec $script: $!\n";
543 POSIX::write($writefd, $err, length($err));
549 # clean up file descriptors from the fork
550 POSIX::close($writefd);
552 # the callbacks that follow share these lexical variables
554 my $child_output = '';
556 my $child_exit_status = 0;
558 my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
560 # Perl note: we have to use anonymous subs here, as they are instantiated
561 # at runtime, rather than at compile time.
563 $maybe_finished = sub {
564 return unless $child_eof;
565 return unless $child_dead;
567 # everything is finished -- process the results and invoke the callback
570 # handle unexpected exit status as a fatal error
571 if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 2) {
572 $run_cb->(POSIX::WEXITSTATUS($child_exit_status), undef,
573 "Fatal error from changer script: ".$child_output);
577 # parse the child's output
578 my @child_output = split '\n', $child_output;
579 my $exitval = POSIX::WEXITSTATUS($child_exit_status);
581 debug("Amanda::Changer::compat: Got response '$child_output' with exit status $exitval");
582 if (@child_output < 1) {
583 $run_cb->(2, undef, "Malformed output from changer script -- no output");
586 my $slotline = shift @child_output;
587 if ($slotline !~ /\s*([^\s]+)(?:\s+(.+))?/) {
588 $run_cb->(2, undef, "Malformed output from changer script: '$slotline'");
591 my ($slot, $rest) = ($1, $2);
593 # append any additional lines to $rest
595 $rest .= "\n" . join("\n", @child_output);
598 # let the callback take care of any further interpretation
599 $run_cb->($exitval, $slot, $rest);
602 $fd_source_cb = sub {
605 $len = POSIX::read($readfd, $bytes, 1024);
607 # if we got an EOF, shut things down.
610 POSIX::close($readfd);
612 $fdsrc = undef; # break a reference loop
615 # otherwise, just keep the bytes
616 $child_output .= $bytes;
619 $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
620 $fdsrc->set_callback($fd_source_cb);
622 $child_watch_source_cb = sub {
623 my ($cwsrc, $got_pid, $got_status) = @_;
625 $cwsrc = undef; # break a reference loop
627 $child_exit_status = $got_status;
631 $cwsrc = Amanda::MainLoop::child_watch_source($pid);
632 $cwsrc->set_callback($child_watch_source_cb);
636 package Amanda::Changer::compat::Reservation;
638 use Amanda::Debug qw( debug );
639 @ISA = qw( Amanda::Changer::Reservation );
643 my ($chg, $slot, $device) = @_;
644 my $self = Amanda::Changer::Reservation::new($class);
646 $self->{'chg'} = $chg;
648 $self->{'device'} = $device;
649 $self->{'this_slot'} = $slot;
651 # mark the changer as reserved
652 $self->{'chg'}->{'reserved'} = $device;
664 $self->{'chg'}->{'reserved'} = 0;
666 # unref the device, for good measure
667 $self->{'device'} = undef;
669 $params{'finished_cb'}->($message) if $params{'finished_cb'};
672 if (exists $params{'eject'} && $params{'eject'}) {
673 $self->{'chg'}->eject(finished_cb => $finished);
683 # non-searchable changers don't get -label, except that chg-zd-mtx needs
684 # it to maintain its slotinfofile (this is a hack)
685 if (!$self->{'chg'}->{'searchable'}
686 && $self->{'chg'}->{'script'} !~ /chg-zd-mtx$/) {
687 debug("Amanda::Changer::compat - changer script is not searchable, so not invoking -label for set_label");
688 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
692 if (!defined $params{'label'}) {
693 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
698 my ($exitval, $slot, $rest) = @_;
700 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
703 return $self->{'chg'}->make_error("fatal", $params{'finished_cb'},
706 return $self->{'chg'}->make_error("failed", $params{'finished_cb'},
712 $self->{'chg'}->_run_tpchanger(
713 $run_cb, "-label", $params{'label'});