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 );
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'});
136 # search manually, starting with "current". This is complicated, because
137 # it's an event-based loop.
139 # TODO: support the case where nslots == -1
142 my ($err, $res) = @_;
145 # ignore "benign" errors
146 next TRYSLOT if $err;
148 my $device = Amanda::Device->new($res->{'device_name'});
149 next TRYSLOT unless $device;
150 next TRYSLOT if ($device->read_label() != $DEVICE_STATUS_SUCCESS);
151 next TRYSLOT unless ($device->volume_label() eq $params{'label'});
153 # we found the correct slot
154 Amanda::MainLoop::call_later($params{'res_cb'}, undef, $res);
158 # on to the next slot
159 if (++$nchecked >= $self->{'nslots'}) {
160 Amanda::MainLoop::call_later($params{'res_cb'},
161 "Volume '$params{label}' not found", undef);
164 # loop again with the next slot
165 $res->release(); # we know this completes immediately
166 $self->load(slot => "next", res_cb => $check_slot);
170 # kick off the loop with the current slot
171 $self->load(slot => "current", res_cb => $check_slot);
179 die "no info_cb supplied" unless (exists $params{'info_cb'});
180 die "no info supplied" unless (exists $params{'info'});
182 # make sure the info is loaded, and re-call info() if we have to wait
183 if (!defined($self->{'nslots'}) && grep(/^num_slots$/, @{$params{'info'}})) {
187 $self->info(%params);
191 $params{'info_cb'}->($msg);
196 # ok, info is loaded, so call back with the results
197 for my $inf (@{$params{'info'}}) {
198 if ($inf eq 'num_slots') {
199 $results{$inf} = $self->{'nslots'};
201 warn "Ignoring request for info key '$inf'";
205 Amanda::MainLoop::call_later($params{'info_cb'}, undef, %results);
208 # run a simple op -- no arguments, no slot returned
214 my $run_success_cb = sub {
215 if (exists $params{'finished_cb'}) {
216 $params{'finished_cb'}->(undef);
219 my $run_fail_cb = sub {
220 my ($exitval, $message) = @_;
221 if (exists $params{'finished_cb'}) {
222 $params{'finished_cb'}->($message);
225 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-$op");
232 $self->_simple_op("reset", %params);
239 # note: parameter 'drive' is ignored
240 $self->_simple_op("clean", %params);
247 # TODO: not implemented
248 # -- need to shuffle the driver over every slot
249 if (exists $params{'finished_cb'}) {
250 $params{'finished_cb'}->(undef);
254 # Internal function to call the script's -info, store the results in $self, and
255 # call either $success_cb (with no arguments) or $error_cb (with an error
258 my ($self, $success_cb, $error_cb) = @_;
260 my $run_success_cb = sub {
261 my ($slot, $rest) = @_;
262 # old, unsearchable changers don't return the third result, so it's
263 # optional in the regex
264 $rest =~ /(\d+) (\d+) ?(\d+)?/ or
265 croak("Malformed response from changer -info: $rest");
267 $self->{'nslots'} = $1;
268 $self->{'backward'} = $2;
269 $self->{'searchable'} = $3? 1:0;
273 my $run_fail_cb = sub {
274 my ($exitval, $message) = @_;
275 $error_cb->($message);
277 $self->_run_tpchanger($run_success_cb, $run_fail_cb, "-info");
280 # Internal function to create a temporary configuration directory, which persists
281 # for the duration of this changer's lifetime (and beyond, TODO)
283 my ($self, $cc) = @_;
286 my $cfg_name = Amanda::Config::get_config_name();
287 my $changer_name = changer_config_name($cc);
288 my $tapedev = changer_config_getconf($cc, $CHANGER_CONFIG_TAPEDEV);
289 my $tpchanger = changer_config_getconf($cc, $CHANGER_CONFIG_TPCHANGER);
290 my $changerdev = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERDEV);
291 my $changerfile = changer_config_getconf($cc, $CHANGER_CONFIG_CHANGERFILE);
293 my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name";
297 or die("Could not delete '$cfg_dir'");
301 or die("Could not create '$cfg_dir'");
303 # Write an amanda.conf
304 open(my $amconf, ">", "$cfg_dir/amanda.conf")
305 or die ("Could not write '$cfg_dir/amanda.conf'");
307 print $amconf "# automatically generated by Amanda::Changer::compat\n";
308 print $amconf 'org "', getconf($CNF_ORG), "\"\n"
309 if getconf_seen($CNF_ORG);
310 print $amconf 'mailto "', getconf($CNF_MAILTO), "\"\n"
311 if getconf_seen($CNF_MAILTO);
312 print $amconf 'mailer "', getconf($CNF_MAILER), "\"\n"
313 if getconf_seen($CNF_MAILER);
314 print $amconf "tapedev \"$tapedev\"\n"
315 if defined($tapedev);
316 print $amconf "tpchanger \"$tpchanger\"\n"
317 if defined($tpchanger);
318 print $amconf "changerdev \"$changerdev\"\n"
319 if defined($changerdev);
320 print $amconf "changerfile \"",
321 Amanda::Config::config_dir_relative($changerfile),
323 if defined($changerfile);
325 # TODO: device_property, tapetype, and the tapetype def
329 $self->{'cfg_dir'} = $cfg_dir;
331 # for the default changer, we don't need to invent a config..
332 $self->{'cfg_dir'} = Amanda::Config::get_config_dir();
337 # Internal-use function to actually invoke a changer script and parse
340 # @param $success_cb: called with ($slot, $rest) on success
341 # @param $failure_cb: called with ($exitval, $message) on any failure
342 # @params @args: command-line arguments to follow the name of the changer
343 # @returns: array ($error, $slot, $rest), where $error is an error message if
344 # a benign error occurred, or 0 if no error occurred
346 my ($self, $success_cb, $failure_cb, @args) = @_;
348 if ($self->{'busy'}) {
349 croak("Changer is already in use");
352 my ($readfd, $writefd) = POSIX::pipe();
353 if (!defined($writefd)) {
354 croak("Error creating pipe to run changer script: $!");
358 if (!defined($pid) or $pid < 0) {
359 croak("Can't fork to run changer script: $!");
365 # get our file-handle house in order
366 POSIX::close($readfd);
367 POSIX::dup2($writefd, 1);
368 POSIX::close($writefd);
370 # cd into the config dir
371 if (!chdir($self->{'cfg_dir'})) {
372 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n";
376 %ENV = Amanda::Util::safe_env();
378 my $script = $self->{'script'};
379 unless (-x $script) {
380 $script = "$amlibexecdir/$script";
382 { exec { $script } $script, @args; } # braces protect against warning
384 my $err = "<error> Could not exec $script: $!\n";
385 POSIX::write($writefd, $err, length($err));
391 # clean up file descriptors from the fork
392 POSIX::close($writefd);
394 # mark this object as "busy", so we can't begin another operation
395 # until this one is finished.
398 # the callbacks that follow share these lexical variables
400 my $child_output = '';
402 my $child_exit_status = 0;
404 my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
406 # Perl note: we have to use anonymous subs here, as they are instantiated
407 # at runtime, rather than at compile time.
409 $maybe_finished = sub {
410 return unless $child_eof;
411 return unless $child_dead;
413 # everything is finished -- process the results and invoke the callback
416 # handle fatal errors
417 if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 1) {
418 $failure_cb->(POSIX::WEXITSTATUS($child_exit_status),
419 "Fatal error from changer script: ".$child_output);
423 # parse the child's output
424 my @child_output = split '\n', $child_output;
425 $failure_cb->(2, "Malformed output from changer script -- no output")
426 if (@child_output < 1);
427 $failure_cb->(2, "Malformed output from changer script -- too many lines")
428 if (@child_output > 1);
429 $failure_cb->(2, "Malformed output from changer script: '$child_output[0]'")
430 if ($child_output[0] !~ /\s*([^\s]+)(?:\s+(.+))?/);
431 my ($slot, $rest) = ($1, $2);
433 # mark this object as no longer busy. This frees the
434 # object up to begin the next operation, which may happen
435 # during the invocation of the callback
438 # let the callback take care of any further interpretation
439 my $exitval = POSIX::WEXITSTATUS($child_exit_status);
441 $success_cb->($slot, $rest);
443 $failure_cb->($exitval, $rest);
447 $fd_source_cb = sub {
450 $len = POSIX::read($readfd, $bytes, 1024);
452 # if we got an EOF, shut things down.
455 POSIX::close($readfd);
457 $fdsrc = undef; # break a reference loop
460 # otherwise, just keep the bytes
461 $child_output .= $bytes;
464 $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
465 $fdsrc->set_callback($fd_source_cb);
467 $child_watch_source_cb = sub {
468 my ($cwsrc, $got_pid, $got_status) = @_;
470 $cwsrc = undef; # break a reference loop
472 $child_exit_status = $got_status;
476 $cwsrc = Amanda::MainLoop::child_watch_source($pid);
477 $cwsrc->set_callback($child_watch_source_cb);
480 package Amanda::Changer::compat::Reservation;
482 @ISA = qw( Amanda::Changer::Reservation );
486 my ($chg, $slot, $device_name) = @_;
487 my $self = Amanda::Changer::Reservation::new($class);
489 $self->{'chg'} = $chg;
491 $self->{'device_name'} = $device_name;
492 $self->{'this_slot'} = $slot;
493 $self->{'next_slot'} = "next"; # clever, no?
495 # mark the changer as reserved
496 $self->{'chg'}->{'reserved'} = $device_name;
505 $self->{'chg'}->{'reserved'} = 0;
512 # non-searchable changers don't get -label, except that chg-zd-mtx needs
513 # it to maintain its slotinfofile (this is a hack)
514 if (!$self->{'chg'}->{'searchable'}
515 && $self->{'chg'}->{'script'} !~ /chg-zd-mtx$/) {
516 if (exists $params{'finished_cb'}) {
517 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
522 my $run_success_cb = sub {
523 if (exists $params{'finished_cb'}) {
524 Amanda::MainLoop::call_later($params{'finished_cb'}, undef);
527 my $run_fail_cb = sub {
528 my ($exitval, $message) = @_;
529 if (exists $params{'finished_cb'}) {
530 Amanda::MainLoop::call_later($params{'finished_cb'}, $message);
533 $self->{'chg'}->_run_tpchanger(
534 $run_success_cb, $run_fail_cb, "-label", $params{'label'});