1# Copyright (c) 2008-2013 Zmanda, Inc. All Rights Reserved. 2# 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. 7# 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 11# for more details. 12# 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 16# 17# Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300 18# Sunnyvale, CA 94085, USA, or: http://www.zmanda.com 19 20package Amanda::Changer::compat; 21 22use strict; 23use warnings; 24use vars qw( @ISA ); 25@ISA = qw( Amanda::Changer ); 26 27use Carp; 28use File::Glob qw( :glob ); 29use File::Path; 30use Amanda::Paths; 31use Amanda::MainLoop qw( :GIOCondition ); 32use Amanda::Config qw( :getconf ); 33use Amanda::Debug qw( debug ); 34use Amanda::Device qw( :constants ); 35use Amanda::Changer; 36use Amanda::MainLoop; 37 38=head1 NAME 39 40Amanda::Changer::compat -- run "old" changer scripts 41 42=head1 DESCRIPTION 43 44This package calls through to old Changer API shell scripts using the new API. 45If necessary, it writes temporary configurations under C<$AMANDA_TMPDIR> and 46invokes the changer there, allowing multiple distinct changers to run within 47the same Amanda process. 48 49See the amanda-changers(7) manpage for usage information. 50 51=head2 NOTE 52 53In-process reservations are handled correctly - only one device may be used at 54a time. However, the underlying scripts do not support reservations, so 55another application can easily run the script and change the current device. 56Caveat emptor. 57 58=cut 59 60# TODO 61# Clean out old changer temporary directories on object destruction. 62 63sub new { 64 my $class = shift; 65 my ($config, $tpchanger) = @_; 66 my ($script) = ($tpchanger =~ /chg-compat:(.*)/); 67 68 unless (-e $script) { 69 $script = "$amlibexecdir/$script"; 70 } 71 72 if (! -x $script) { 73 return Amanda::Changer->make_error("fatal", undef, 74 message => "'$script' is not executable"); 75 } 76 77 my $self = { 78 script => $script, 79 config => $config, 80 reserved => 0, 81 nslots => undef, 82 backwards => undef, 83 searchable => undef, 84 lock => [], 85 got_info => 0, 86 info_lock => [], 87 }; 88 bless ($self, $class); 89 90 $self->_make_cfg_dir($config); 91 92 debug("$class initialized with script $script, temporary directory $self->{cfg_dir}"); 93 94 return $self; 95} 96 97sub load { 98 my $self = shift; 99 my %params = @_; 100 101 $self->validate_params('load', \%params); 102 return if $self->check_error($params{'res_cb'}); 103 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 . "'"); 108 } 109 110 my $steps = define_steps 111 cb_ref => \$params{'res_cb'}; 112 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'}); 116 }; 117 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); 124 } 125 126 $steps->{'start_load'}->(); 127 }; 128 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'}); 133 } else { 134 # not searchable -- run a manual scan 135 $self->_manual_scan(%params); 136 } 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. 141 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"); 151 } 152 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'}); 156 } 157 }; 158 159 step load_run_done => sub { 160 my ($exitval, $slot, $rest) = @_; 161 if ($exitval == 0) { 162 if (!$rest) { 163 return $self->make_error("fatal", $params{'res_cb'}, 164 message => "changer script did not provide a device name"); 165 } 166 } elsif ($exitval >= 2) { 167 return $self->make_error("fatal", $params{'res_cb'}, 168 message => $rest); 169 } else { 170 return $self->make_error("failed", $params{'res_cb'}, 171 reason => "notfound", 172 message => $rest); 173 } 174 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"); 183 } 184 185 return $self->_make_res($params{'res_cb'}, $slot, $rest, undef); 186 }; 187} 188 189sub _manual_scan { 190 my $self = shift; 191 my %params = @_; 192 my $nchecked = 0; 193 my ($get_info, $got_info, $run_cb, $load_next); 194 my $first_scanned_slot = -1; 195 196 my $user_msg_fn = $params{'user_msg_fn'}; 197 $user_msg_fn ||= sub { Amanda::Debug::info("chg-compat: " . $_[0]); }; 198 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 202 203 $get_info = sub { 204 $self->_get_info($got_info); 205 }; 206 207 $got_info = sub { 208 $user_msg_fn->("beginning manual scan of $self->{nslots} slots"); 209 $self->_run_tpchanger($run_cb, "-slot", "current"); 210 }; 211 $run_cb = sub { 212 my ($exitval, $slot, $rest) = @_; 213 214 if ($slot == $first_scanned_slot) { 215 $nchecked = $self->{'nslots'}; 216 return $load_next->(); 217 } 218 219 $first_scanned_slot = $slot if $first_scanned_slot == -1; 220 221 $user_msg_fn->("updated slot $slot"); 222 if ($exitval == 0) { 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); 231 return; 232 } 233 } 234 235 return $load_next->(); 236 } else { 237 # don't continue scanning after a fatal error 238 if ($exitval >= 2) { 239 return $self->make_error("fatal", $params{'res_cb'}, 240 message => $rest); 241 } 242 243 return $load_next->(); 244 } 245 }; 246 247 $load_next = sub { 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"); 254 } else { 255 return $params{'res_cb'}->(undef, undef); 256 } 257 } 258 259 $self->_run_tpchanger($run_cb, "-slot", "next"); 260 }; 261 262 $get_info->(); 263} 264 265# takes $res_cb, $slot and $rest; creates and configures the device, and calls 266# $res_cb with the results. 267sub _make_res { 268 my $self = shift; 269 my ($res_cb, $slot, $rest, $device) = @_; 270 my $res; 271 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, 276 reason => "device", 277 message => "opening '$rest': " . $device->error_or_status()); 278 } 279 } 280 281 if (my $err = $self->{'config'}->configure_device($device)) { 282 return $self->make_error("failed", $res_cb, 283 reason => "device", 284 message => $err); 285 } 286 287 $res = Amanda::Changer::compat::Reservation->new($self, $slot, $device); 288 $device->read_label(); 289 290 $res_cb->(undef, $res); 291} 292 293sub info_setup { 294 my $self = shift; 295 my %params = @_; 296 297 $self->_get_info(sub { 298 my ($exitval, $message) = @_; 299 if (defined $exitval) { # error 300 if ($exitval >= 2) { 301 return $self->make_error("fatal", $params{'finished_cb'}, 302 message => $message); 303 } else { 304 return $self->make_error("failed", $params{'finished_cb'}, 305 reason => "notfound", 306 message => $message); 307 } 308 } 309 310 # no error, so we're done with setup 311 $params{'finished_cb'}->(); 312 }); 313} 314 315sub info_key { 316 my $self = shift; 317 my ($key, %params) = @_; 318 my %results; 319 320 if ($key eq 'num_slots') { 321 $results{$key} = $self->{'nslots'}; 322 } elsif ($key eq 'fast_search') { 323 $results{$key} = $self->{'searchable'}; 324 } 325 326 $params{'info_cb'}->(undef, %results) if $params{'info_cb'}; 327} 328 329# run a simple op -- no arguments, no slot returned 330sub _simple_op { 331 my $self = shift; 332 my $op = shift; 333 my %params = @_; 334 335 my $run_cb = sub { 336 my ($exitval, $slot, $rest) = @_; 337 if ($exitval == 0) { 338 if (exists $params{'finished_cb'}) { 339 $params{'finished_cb'}->(undef); 340 } 341 } else { 342 if ($exitval >= 2) { 343 return $self->make_error("fatal", $params{'finished_cb'}, 344 message => $rest); 345 } else { 346 return $self->make_error("failed", $params{'finished_cb'}, 347 reason => "unknown", 348 message => $rest); 349 } 350 } 351 }; 352 $self->_run_tpchanger($run_cb, "-$op"); 353} 354 355sub reset { 356 my $self = shift; 357 my %params = @_; 358 359 $self->_simple_op("reset", %params); 360} 361 362sub clean { 363 my $self = shift; 364 my %params = @_; 365 366 # note: parameter 'drive' is ignored 367 $self->_simple_op("clean", %params); 368} 369 370sub eject { 371 my $self = shift; 372 my %params = @_; 373 374 # note: parameter 'drive' is ignored 375 $self->_simple_op("eject", %params); 376} 377 378sub update { 379 my $self = shift; 380 my %params = @_; 381 382 if ($params{'changed'}) { 383 return $self->make_error("failed", $params{'finished_cb'}, 384 reason => 'invalid', 385 message => 'chg-compat does not support specifying what has changed'); 386 } 387 388 my $scan_done_cb = make_cb(scan_done_cb => sub { 389 my ($err, $res) = @_; 390 if ($err) { 391 return $params{'finished_cb'}->($err); 392 } 393 394 # we didn't search for a label, so we don't get a reservation 395 $params{'finished_cb'}->(undef); 396 }); 397 398 # for compat changers, "update" just entails scanning the whole changer 399 $self->_manual_scan( 400 res_cb => $scan_done_cb, 401 label => undef, # search forever 402 user_msg_fn => $params{'user_msg_fn'}, 403 ); 404} 405 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. 409sub _get_info { 410 my ($self, $got_info_cb) = @_; 411 412 Amanda::MainLoop::synchronized($self->{'info_lock'}, $got_info_cb, sub { 413 my ($got_info_cb) = @_; 414 415 # if we've already got info, just call back right away 416 if ($self->{'got_info'}) { 417 return $got_info_cb->(); 418 } 419 420 my $run_cb = sub { 421 my ($exitval, $slot, $rest) = @_; 422 if ($exitval == 0) { 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"); 428 } 429 430 $self->{'nslots'} = $1; 431 $self->{'backward'} = $2; 432 $self->{'searchable'} = $3? 1:0; 433 434 $self->{'got_info'} = 1; 435 return $got_info_cb->(undef, undef); 436 } else { 437 return $got_info_cb->($exitval, $rest); 438 } 439 }; 440 441 $self->_run_tpchanger($run_cb, "-info"); 442 }); 443} 444 445# Internal function to create a temporary configuration directory, which persists 446# for the duration of this changer's lifetime (and beyond, TODO) 447sub _make_cfg_dir { 448 my ($self, $config) = @_; 449 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(); 453 } else { 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'}; 460 461 my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name"; 462 463 if (-d $cfg_dir) { 464 rmtree($cfg_dir) 465 or die("Could not delete '$cfg_dir'"); 466 } 467 468 mkpath($cfg_dir) 469 or die("Could not create '$cfg_dir'"); 470 471 # Write an amanda.conf 472 open(my $amconf, ">", "$cfg_dir/amanda.conf") 473 or die ("Could not write '$cfg_dir/amanda.conf'"); 474 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), 490 "\"\n" 491 if defined($changerfile); 492 493 # TODO: device_property, tapetype, and the tapetype def 494 495 close $amconf; 496 497 $self->{'cfg_dir'} = $cfg_dir; 498 } 499 500} 501 502# Internal-use function to actually invoke a changer script and parse 503# its output. 504# 505# @param $run_cb: called with ($exitval, $slot, $rest) 506# @params @args: command-line arguments to follow the name of the changer 507sub _run_tpchanger { 508 my ($self, $run_cb, @args) = @_; 509 510 Amanda::MainLoop::synchronized($self->{'lock'}, $run_cb, sub { 511 my ($run_cb) = @_; 512 debug("Amanda::Changer::compat: invoking $self->{script} with " . join(" ", @args)); 513 514 my ($readfd, $writefd) = POSIX::pipe(); 515 if (!defined($writefd)) { 516 croak("Error creating pipe to run changer script: $!"); 517 } 518 519 my $pid = fork(); 520 if (!defined($pid) or $pid < 0) { 521 croak("Can't fork to run changer script: $!"); 522 } 523 524 if (!$pid) { 525 ## child 526 527 # get our file-handle house in order 528 POSIX::close($readfd); 529 POSIX::dup2($writefd, 1); 530 POSIX::close($writefd); 531 532 # cd into the config dir 533 if (!chdir($self->{'cfg_dir'})) { 534 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n"; 535 exit(2); 536 } 537 538 %ENV = Amanda::Util::safe_env(); 539 540 my $script = $self->{'script'}; 541 { exec { $script } $script, @args; } # braces protect against warning 542 543 my $err = "<error> Could not exec $script: $!\n"; 544 POSIX::write($writefd, $err, length($err)); 545 exit 2; 546 } 547 548 ## parent 549 550 # clean up file descriptors from the fork 551 POSIX::close($writefd); 552 553 # the callbacks that follow share these lexical variables 554 my $child_eof = 0; 555 my $child_output = ''; 556 my $child_dead = 0; 557 my $child_exit_status = 0; 558 my ($fdsrc, $cwsrc); 559 my ($maybe_finished, $fd_source_cb, $child_watch_source_cb); 560 561 # Perl note: we have to use anonymous subs here, as they are instantiated 562 # at runtime, rather than at compile time. 563 564 $maybe_finished = sub { 565 return unless $child_eof; 566 return unless $child_dead; 567 568 # everything is finished -- process the results and invoke the callback 569 chomp $child_output; 570 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); 575 return; 576 } 577 578 # parse the child's output 579 my @child_output = split '\n', $child_output; 580 my $exitval = POSIX::WEXITSTATUS($child_exit_status); 581 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"); 585 return; 586 } 587 my $slotline = shift @child_output; 588 if ($slotline !~ /\s*([^\s]+)(?:\s+(.+))?/) { 589 $run_cb->(2, undef, "Malformed output from changer script: '$slotline'"); 590 return; 591 } 592 my ($slot, $rest) = ($1, $2); 593 594 # append any additional lines to $rest 595 if (@child_output) { 596 $rest .= "\n" . join("\n", @child_output); 597 } 598 599 # let the callback take care of any further interpretation 600 $run_cb->($exitval, $slot, $rest); 601 }; 602 603 $fd_source_cb = sub { 604 my ($fdsrc) = @_; 605 my ($len, $bytes); 606 $len = POSIX::read($readfd, $bytes, 1024); 607 608 # if we got an EOF, shut things down. 609 if ($len == 0) { 610 $child_eof = 1; 611 POSIX::close($readfd); 612 $fdsrc->remove(); 613 $fdsrc = undef; # break a reference loop 614 $maybe_finished->(); 615 } else { 616 # otherwise, just keep the bytes 617 $child_output .= $bytes; 618 } 619 }; 620 $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP); 621 $fdsrc->set_callback($fd_source_cb); 622 623 $child_watch_source_cb = sub { 624 my ($cwsrc, $got_pid, $got_status) = @_; 625 $cwsrc->remove(); 626 $cwsrc = undef; # break a reference loop 627 $child_dead = 1; 628 $child_exit_status = $got_status; 629 630 $maybe_finished->(); 631 }; 632 $cwsrc = Amanda::MainLoop::child_watch_source($pid); 633 $cwsrc->set_callback($child_watch_source_cb); 634 }); 635} 636 637package Amanda::Changer::compat::Reservation; 638use vars qw( @ISA ); 639use Amanda::Debug qw( debug ); 640@ISA = qw( Amanda::Changer::Reservation ); 641 642sub new { 643 my $class = shift; 644 my ($chg, $slot, $device) = @_; 645 my $self = Amanda::Changer::Reservation::new($class); 646 647 $self->{'chg'} = $chg; 648 649 $self->{'device'} = $device; 650 $self->{'this_slot'} = $slot; 651 652 # mark the changer as reserved 653 $self->{'chg'}->{'reserved'} = $device; 654 655 return $self; 656} 657 658sub do_release { 659 my $self = shift; 660 my %params = @_; 661 662 my $finished = sub { 663 my ($message) = @_; 664 665 $self->{'chg'}->{'reserved'} = 0; 666 667 # unref the device, for good measure 668 $self->{'device'} = undef; 669 670 $params{'finished_cb'}->($message) if $params{'finished_cb'}; 671 }; 672 673 if (exists $params{'eject'} && $params{'eject'}) { 674 $self->{'chg'}->eject(finished_cb => $finished); 675 } else { 676 $finished->(undef); 677 } 678} 679 680sub set_label { 681 my $self = shift; 682 my %params = @_; 683 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'}; 690 return; 691 } 692 693 if (!defined $params{'label'}) { 694 $params{'finished_cb'}->(undef) if $params{'finished_cb'}; 695 return; 696 } 697 698 my $run_cb = sub { 699 my ($exitval, $slot, $rest) = @_; 700 if ($exitval == 0) { 701 $params{'finished_cb'}->(undef) if $params{'finished_cb'}; 702 } else { 703 if ($exitval >= 2) { 704 return $self->{'chg'}->make_error("fatal", $params{'finished_cb'}, 705 message => $rest); 706 } else { 707 return $self->{'chg'}->make_error("failed", $params{'finished_cb'}, 708 reason => "unknown", 709 message => $rest); 710 } 711 } 712 }; 713 $self->{'chg'}->_run_tpchanger( 714 $run_cb, "-label", $params{'label'}); 715} 716 7171; 718