1 # Copyright (c) 2005-2008 Zmanda, Inc. All Rights Reserved.
3 # This library is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU Lesser General Public License version 2.1 as
5 # published by the Free Software Foundation.
7 # This 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 Mathlida Ave, Suite 300
17 # Sunnyvale, CA 94086, 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 );
38 Amanda::Changer::compat -- run "old" changer scripts
42 This package, calls through to old Changer API shell scripts using the new API.
43 If necessary, this writes temporary configurations under C<$AMANDA_TMPDIR> and
44 invokes the changer there, allowing multiple distinct changers to run within
45 the same Amanda process.
49 In-process reservations are handled correctly - only one device may be used at
50 a time. However, the underlying scripts do not support reservations, so
51 another application can easily run the script and change the current device.
54 Concurrent _run_tpchanger invocations are currently forbidden with a die() --
55 that should change to a simple FIFO queue of tpchanger invocations to make.
57 Clean out old changer temporary directories on object destruction.
65 my ($cc, $tpchanger) = @_;
66 my ($script) = ($tpchanger =~ /chg-compat:(.*)/);
75 bless ($self, $class);
77 $self->_make_cfg_dir($cc);
86 die "no callback supplied" unless (exists $params{'res_cb'});
87 my $cb = $params{'res_cb'};
89 if ($self->{'reserved'}) {
90 $cb->("Changer is already reserved: '" . $self->{'reserved'} . "'", undef);
94 # make sure the info is loaded, and re-call load() if we have to wait
95 if (!defined($self->{'nslots'})) {
108 my $run_success_cb = sub {
109 my ($slot, $rest) = @_;
110 my $res = Amanda::Changer::compat::Reservation->new($self, $slot, $rest);
113 my $run_fail_cb = sub {
114 my ($exitval, $message) = @_;
115 $cb->($message, undef);
118 if (exists $params{'label'}) {
119 if ($self->{'searchable'}) {
120 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-search", $params{'label'});
122 # not searchable -- run a manual scan
123 $self->_manual_scan(%params);
125 } elsif (exists $params{'slot'}) {
126 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-slot", $params{'slot'});
134 my ($run_success_cb, $run_fail_cb, $load_next);
136 # search manually, starting with "current" and proceeding through nslots-1
139 # TODO: support the case where nslots == -1
141 $run_success_cb = sub {
142 my ($slot, $rest) = @_;
144 my $device = Amanda::Device->new($rest);
145 if ($device and $device->configure(1)
146 and $device->read_label() == $DEVICE_STATUS_SUCCESS
147 and $device->volume_label() eq $params{'label'}) {
148 # we found the correct slot
149 my $res = Amanda::Changer::compat::Reservation->new($self, $slot, $rest);
150 Amanda::MainLoop::call_later($params{'res_cb'}, undef, $res);
158 my ($exitval, $message) = @_;
160 # don't continue scanning after a fatal error
162 Amanda::MainLoop::call_later($params{'res_cb'}, $message, undef);
170 # if we've scanned all nslots, we haven't found the label.
171 if (++$nchecked >= $self->{'nslots'}) {
172 Amanda::MainLoop::call_later($params{'res_cb'},
173 "Volume '$params{label}' not found", undef);
177 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-slot", "next");
180 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-slot", "current");
188 die "no info_cb supplied" unless (exists $params{'info_cb'});
189 die "no info supplied" unless (exists $params{'info'});
191 # make sure the info is loaded, and re-call info() if we have to wait
192 if (!defined($self->{'nslots'}) && grep(/^num_slots$/, @{$params{'info'}})) {
196 $self->info(%params);
200 $params{'info_cb'}->($msg);
205 # ok, info is loaded, so call back with the results
206 for my $inf (@{$params{'info'}}) {
207 if ($inf eq 'num_slots') {
208 $results{$inf} = $self->{'nslots'};
210 warn "Ignoring request for info key '$inf'";
214 Amanda::MainLoop::call_later($params{'info_cb'}, undef, %results);
217 # run a simple op -- no arguments, no slot returned
223 Amanda::Debug::debug("running simple op '$op'");
224 my $run_success_cb = sub {
225 Amanda::Debug::debug("simple op '$op' ok");
226 if (exists $params{'finished_cb'}) {
227 $params{'finished_cb'}->(undef);
230 my $run_fail_cb = sub {
231 my ($exitval, $message) = @_;
232 Amanda::Debug::debug("simple op '$op' failed: $message");
233 if (exists $params{'finished_cb'}) {
234 $params{'finished_cb'}->($message);
237 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-$op");
244 $self->_simple_op("reset", %params);
251 # note: parameter 'drive' is ignored
252 $self->_simple_op("clean", %params);
259 # note: parameter 'drive' is ignored
260 $self->_simple_op("eject", %params);
267 # TODO: not implemented
268 # -- need to shuffle the driver over every slot
269 if (exists $params{'finished_cb'}) {
270 $params{'finished_cb'}->(undef);
274 # Internal function to call the script's -info, store the results in $self, and
275 # call either $success_cb (with no arguments) or $error_cb (with an error
278 my ($self, $success_cb, $error_cb) = @_;
280 my $run_success_cb = sub {
281 my ($slot, $rest) = @_;
282 # old, unsearchable changers don't return the third result, so it's
283 # optional in the regex
284 $rest =~ /(\d+) (\d+) ?(\d+)?/ or
285 croak("Malformed response from changer -info: $rest");
287 $self->{'nslots'} = $1;
288 $self->{'backward'} = $2;
289 $self->{'searchable'} = $3? 1:0;
293 my $run_fail_cb = sub {
294 my ($exitval, $message) = @_;
295 $error_cb->($message);
297 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-info");
300 # Internal function to create a temporary configuration directory, which persists
301 # for the duration of this changer's lifetime (and beyond, TODO)
303 my ($self, $cc) = @_;
306 my $cfg_name = Amanda::Config::get_config_name();
307 my $changer_name = changer_config_name($cc);
308 my $tapedev = changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
309 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
310 my $changerdev = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERDEV);
311 my $changerfile = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERFILE);
313 my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name";
317 or die("Could not delete '$cfg_dir'");
321 or die("Could not create '$cfg_dir'");
323 # Write an amanda.conf
324 open(my $amconf, ">", "$cfg_dir/amanda.conf")
325 or die ("Could not write '$cfg_dir/amanda.conf'");
327 print $amconf "# automatically generated by Amanda::Changer::compat\n";
328 print $amconf 'org "', getconf($CNF_ORG), "\"\n"
329 if getconf_seen($CNF_ORG);
330 print $amconf 'mailto "', getconf($CNF_MAILTO), "\"\n"
331 if getconf_seen($CNF_MAILTO);
332 print $amconf 'mailer "', getconf($CNF_MAILER), "\"\n"
333 if getconf_seen($CNF_MAILER);
334 print $amconf "tapedev \"$tapedev\"\n"
335 if defined($tapedev);
336 print $amconf "tpchanger \"$tpchanger\"\n"
337 if defined($tpchanger);
338 print $amconf "changerdev \"$changerdev\"\n"
339 if defined($changerdev);
340 print $amconf "changerfile \"",
341 Amanda::Config::config_dir_relative($changerfile),
343 if defined($changerfile);
345 # TODO: device_property, tapetype, and the tapetype def
349 $self->{'cfg_dir'} = $cfg_dir;
351 # for the default changer, we don't need to invent a config..
352 $self->{'cfg_dir'} = Amanda::Config::get_config_dir();
357 # Internal-use function to actually invoke a changer script and parse
360 # @param $success_cb: called with ($slot, $rest) on success
361 # @param $failure_cb: called with ($exitval, $message) on any failure
362 # @params @args: command-line arguments to follow the name of the changer
363 # @returns: array ($error, $slot, $rest), where $error is an error message if
364 # a benign error occurred, or 0 if no error occurred
366 my ($self, $success_cb, $failure_cb, @args) = @_;
368 if ($self->{'busy'}) {
369 croak("Changer is already in use");
372 my ($readfd, $writefd) = POSIX::pipe();
373 if (!defined($writefd)) {
374 croak("Error creating pipe to run changer script: $!");
378 if (!defined($pid) or $pid < 0) {
379 croak("Can't fork to run changer script: $!");
385 # get our file-handle house in order
386 POSIX::close($readfd);
387 POSIX::dup2($writefd, 1);
388 POSIX::close($writefd);
390 # cd into the config dir
391 if (!chdir($self->{'cfg_dir'})) {
392 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n";
396 %ENV = Amanda::Util::safe_env();
398 my $script = $self->{'script'};
399 unless (-x $script) {
400 $script = "$amlibexecdir/$script";
402 { exec { $script } $script, @args; } # braces protect against warning
404 my $err = "<error> Could not exec $script: $!\n";
405 POSIX::write($writefd, $err, length($err));
411 # clean up file descriptors from the fork
412 POSIX::close($writefd);
414 # mark this object as "busy", so we can't begin another operation
415 # until this one is finished.
418 # the callbacks that follow share these lexical variables
420 my $child_output = '';
422 my $child_exit_status = 0;
424 my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
426 # Perl note: we have to use anonymous subs here, as they are instantiated
427 # at runtime, rather than at compile time.
429 $maybe_finished = sub {
430 return unless $child_eof;
431 return unless $child_dead;
433 # everything is finished -- process the results and invoke the callback
436 # mark this object as no longer busy. This frees the
437 # object up to begin the next operation, which may happen
438 # during the invocation of the callback
441 # handle unexpected exit status as a fatal error
442 if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 2) {
443 $failure_cb->(POSIX::WEXITSTATUS($child_exit_status),
444 "Fatal error from changer script: ".$child_output);
448 # parse the child's output
449 my @child_output = split '\n', $child_output;
450 if (@child_output < 1) {
451 $failure_cb->(2, "Malformed output from changer script -- no output");
454 if (@child_output > 1) {
455 $failure_cb->(2, "Malformed output from changer script -- too many lines");
458 if ($child_output[0] !~ /\s*([^\s]+)(?:\s+(.+))?/) {
459 $failure_cb->(2, "Malformed output from changer script: '$child_output[0]'");
462 my ($slot, $rest) = ($1, $2);
464 # let the callback take care of any further interpretation
465 my $exitval = POSIX::WEXITSTATUS($child_exit_status);
467 $success_cb->($slot, $rest);
469 $failure_cb->($exitval, $rest);
473 $fd_source_cb = sub {
476 $len = POSIX::read($readfd, $bytes, 1024);
478 # if we got an EOF, shut things down.
481 POSIX::close($readfd);
483 $fdsrc = undef; # break a reference loop
486 # otherwise, just keep the bytes
487 $child_output .= $bytes;
490 $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
491 $fdsrc->set_callback($fd_source_cb);
493 $child_watch_source_cb = sub {
494 my ($cwsrc, $got_pid, $got_status) = @_;
496 $cwsrc = undef; # break a reference loop
498 $child_exit_status = $got_status;
502 $cwsrc = Amanda::MainLoop::child_watch_source($pid);
503 $cwsrc->set_callback($child_watch_source_cb);
506 package Amanda::Changer::compat::Reservation;
508 @ISA = qw( Amanda::Changer::Reservation );
510 use Amanda::Debug qw( :logging );
514 my ($chg, $slot, $device_name) = @_;
515 my $self = Amanda::Changer::Reservation::new($class);
517 $self->{'chg'} = $chg;
519 $self->{'device_name'} = $device_name;
520 $self->{'this_slot'} = $slot;
521 $self->{'next_slot'} = "next"; # clever, no?
523 # mark the changer as reserved
524 $self->{'chg'}->{'reserved'} = $device_name;
536 $self->{'chg'}->{'reserved'} = 0;
538 if (exists $params{'finished_cb'}) {
539 Amanda::MainLoop::call_later($params{'finished_cb'}, $msg);
543 if (exists $params{'eject'} && $params{'eject'}) {
544 $self->{'chg'}->eject(finished_cb => $finished);
554 # non-searchable changers don't get -label, except that chg-zd-mtx needs
555 # it to maintain its slotinfofile (this is a hack)
556 if (!$self->{'chg'}->{'searchable'}
557 && $self->{'chg'}->{'script'} !~ /chg-zd-mtx$/) {
558 if (exists $params{'finished_cb'}) {
559 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
564 my $run_success_cb = sub {
565 if (exists $params{'finished_cb'}) {
566 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
569 my $run_fail_cb = sub {
570 my ($exitval, $message) = @_;
571 if (exists $params{'finished_cb'}) {
572 Amanda::MainLoop::call_later($params{'finished_cb'}, $message);
575 $self->{'chg'}->_run_tpchanger(
576 $run_success_cb, $run_fail_cb, "-label", $params{'label'});