2 # Copyright (c) 2009-2012 Zmanda, Inc. All Rights Reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU General Public License
6 # as published by the Free Software Foundation; either version 2
7 # of the License, or (at your option) any later version.
9 # This program is distributed in the hope that it will be useful, but
10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 # You should have received a copy of the GNU General Public License along
15 # with this program; if not, write to the Free Software Foundation, Inc.,
16 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
19 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
21 use lib '@amperldir@';
29 use Amanda::Device qw( :constants );
30 use Amanda::Debug qw( :logging );
31 use Amanda::Config qw( :init :getconf config_dir_relative );
32 use Amanda::Util qw( :constants );
34 use Amanda::Constants;
36 use Amanda::Taper::Scan;
37 use Amanda::Recovery::Scan;
38 use Amanda::Interactivity;
50 my ($finished_cb) = @_;
52 $finished_cb = sub { exit(1); } if (!$finished_cb or !(ref($finished_cb) eq "CODE"));
55 Usage: amtape [-o configoption]* <conf> <command> {<args>}
58 local $Text::Wrap::columns = 80 - 20;
59 for my $subcmd (sort keys %subcommands) {
60 my ($syntax, $descr, $code) = @{$subcommands{$subcmd}};
61 $descr = wrap('', ' ' x 20, $descr);
62 printf(" %-15s %s\n", $syntax, $descr);
68 sub subcommand($$$&) {
69 my ($subcmd, $syntax, $descr, $code) = @_;
71 $subcommands{$subcmd} = [ $syntax, $descr, make_cb($subcmd => $code) ];
74 sub invoke_subcommand {
75 my ($subcmd, $finished_cb, @args) = @_;
76 die "invalid subcommand $subcmd" unless exists $subcommands{$subcmd};
78 $subcommands{$subcmd}->[2]->($finished_cb, @args);
84 subcommand("usage", "usage", "this message",
86 my ($finished_cb, @args) = @_;
88 return usage($finished_cb);
91 subcommand("reset", "reset", "reset changer to known state",
93 my ($finished_cb, @args) = @_;
95 my $chg = load_changer($finished_cb) or return;
97 $chg->reset(finished_cb => sub {
100 return failure($err, $finished_cb) if $err;
102 print STDERR "changer is reset\n";
107 subcommand("eject", "eject [<drive>]", "eject the volume in the specified drive",
109 my ($finished_cb, @args) = @_;
112 my $chg = load_changer($finished_cb) or return;
115 @drive_args = (drive => shift @args);
117 $chg->eject(@drive_args,
121 return failure($err, $finished_cb) if $err;
123 print STDERR "drive ejected\n";
128 subcommand("clean", "clean [<drive>]", "clean a drive in the changer",
130 my ($finished_cb, @args) = @_;
133 my $chg = load_changer($finished_cb) or return;
136 @drive_args = (drive => shift @args);
137 } elsif (@args != 0) {
138 return usage($finished_cb);
141 $chg->clean(@drive_args,
145 return failure($err, $finished_cb) if $err;
147 print STDERR "drive cleaned\n";
152 subcommand("show", "show [<slots>]", "scan all slots (or listed slots) in the changer, starting with the current slot",
154 my ($finished_cb, @args) = @_;
160 return usage($finished_cb);
167 my @what1 = split /,/, $what;
168 foreach my $what1 (@what1) {
169 if ($what1 =~ /^(\d*)-(\d*)$/) {
172 $end = $begin if $begin > $end;
173 while ($begin <= $end) {
183 my $use_slots = @slots > 0;
185 $chg = load_changer($finished_cb) or return;
187 my $steps = define_steps
188 cb_ref => \$finished_cb,
189 finalize => sub { $chg->quit() if defined $chg };
192 $chg->info(info => [ 'num_slots' ], info_cb => $steps->{'info_cb'});
195 step info_cb => sub {
196 my ($err, %info) = @_;
197 return failure($err, $finished_cb) if $err;
200 my $slot = shift @slots;
201 $chg->load(slot => $slot,
203 res_cb => $steps->{'loaded'});
206 print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
208 $chg->load(relative_slot => 'current',
210 res_cb => $steps->{'loaded'});
215 my ($err, $res) = @_;
217 if ($err->notfound) {
218 # no more interesting slots
221 } elsif ($err->volinuse and defined $err->{'slot'}) {
222 $last_slot = $err->{'slot'};
223 print STDERR sprintf("slot %3s: in use\n", $last_slot);
224 } elsif ($err->empty and defined $err->{'slot'}) {
225 $last_slot = $err->{'slot'};
226 print STDERR sprintf("slot %3s: empty\n", $last_slot);
228 return failure($err, $finished_cb) if $err;
231 $last_slot = $res->{'this_slot'};
234 $seen_slots{$last_slot} = 1;
237 my $dev = $res->{'device'};
238 my $st = $dev->read_label();
239 if ($st == $DEVICE_STATUS_SUCCESS) {
240 print STDERR sprintf("slot %3s: date %-14s label %s\n",
241 $last_slot, $dev->volume_time(),
242 $dev->volume_label());
243 } elsif ($st == $DEVICE_STATUS_VOLUME_UNLABELED) {
244 print STDERR sprintf("slot %3s: unlabeled volume\n", $last_slot);
246 print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
251 $res->release(finished_cb => $steps->{'released'});
253 $steps->{'released'}->();
257 step released => sub {
259 return $finished_cb->() if @slots == 0;
260 my $slot = shift @slots;
261 $chg->load(slot => $slot,
263 res_cb => $steps->{'loaded'});
266 $chg->load(relative_slot => 'next',
268 except_slots => { %seen_slots },
269 res_cb => $steps->{'loaded'});
274 subcommand("inventory", "inventory", "show inventory of changer slots",
276 my ($finished_cb, @args) = @_;
278 my $chg = load_changer($finished_cb) or return;
281 return usage($finished_cb);
284 # TODO -- support an --xml option
286 my $inventory_cb = make_cb(inventory_cb => sub {
287 my ($err, $inv) = @_;
290 if ($err->{'message'}) {
291 print STDERR "inventory not supported by this changer: $err->{'message'}\n";
293 print STDERR "inventory not supported by this changer\n";
296 print STDERR "$err\n";
300 return $finished_cb->();
304 my $line = "slot $sl->{slot}:";
306 if (!defined($sl->{device_status}) && !defined($sl->{label})) {
307 $line .= " unknown state";
308 } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
311 if (defined $sl->{label}) {
312 $line .= " label $sl->{label}";
313 $tle = $tl->lookup_tapelabel($sl->{label});
315 if ($tle->{'meta'}) {
316 $line .= " ($tle->{'meta'})";
319 } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
321 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
322 if (defined $sl->{'device_error'}) {
323 $line .= " " . $sl->{'device_error'};
325 $line .= "device error";
327 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
333 if ($sl->{'barcode'}) {
334 $line .= " barcode $sl->{barcode}";
336 if ($sl->{'reserved'}) {
337 $line .= " reserved";
339 if (defined $sl->{'loaded_in'}) {
340 $line .= " (in drive $sl->{'loaded_in'})";
342 if ($sl->{'import_export'}) {
343 $line .= " (import/export slot)";
345 if ($sl->{'current'}) {
346 $line .= " (current)";
349 if (defined $sl->{'barcode'} and
350 defined $tle->{'barcode'} and
351 $sl->{'barcode'} ne $tle->{'barcode'}) {
352 $line .= " MISTMATCH barcode in tapelist: $tle->{'barcode'}";
356 # note that inventory goes to stdout
363 $chg->inventory(inventory_cb => $inventory_cb);
366 subcommand("current", "current", "load and show the contents of the current slot",
368 my ($finished_cb, @args) = @_;
370 return usage($finished_cb) if @args;
372 # alias for 'slot current'
373 return invoke_subcommand("slot", $finished_cb, "current");
376 subcommand("slot", "slot <slot>",
377 "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
379 my ($finished_cb, @args) = @_;
383 my $steps = define_steps
384 cb_ref => \$finished_cb,
385 finalize => sub { $chg->quit() if defined $chg };
387 # NOTE: the syntax of this subcommand precludes actual slots named
388 # 'current' or 'next' .. when we have a changer using such slot names,
389 # this subcommand will need to support a --literal flag
391 return usage($finished_cb) unless (@args == 1);
392 my $slot = shift @args;
394 $chg = load_changer($finished_cb) or return;
396 step get_slot => sub {
397 if ($slot eq 'current' or $slot eq 'next') {
398 @slotarg = (relative_slot => $slot);
399 } elsif ($slot eq 'first' or $slot eq 'last') {
400 return $chg->inventory(inventory_cb => $steps->{'inventory_cb'});
402 @slotarg = (slot => $slot);
405 $steps->{'do_load'}->();
408 step inventory_cb => sub {
409 my ($err, $inv) = @_;
411 if ($err->failed and $err->notimpl) {
412 return failed("This changer does not support special slot '$slot'");
418 if ($slot eq 'first') {
419 @slotarg = (slot => $inv->[0]->{'slot'});
421 @slotarg = (slot => $inv->[-1]->{'slot'});
424 $steps->{'do_load'}->();
427 step do_load => sub {
428 $chg->load(@slotarg, set_current => 1,
429 res_cb => $steps->{'done_load'});
432 step done_load => sub {
433 my ($err, $res) = @_;
434 return failure($err, $finished_cb) if ($err);
437 my $gotslot = $res->{'this_slot'};
438 print STDERR "changed to slot $gotslot\n";
440 $res->release(finished_cb => $steps->{'released'});
443 step released => sub {
445 return failure($err, $finished_cb) if ($err);
451 subcommand("label", "label <label>", "load the volume with label <label>",
453 my ($finished_cb, @args) = @_;
458 return usage($finished_cb) unless (@args == 1);
459 my $label = shift @args;
461 my $steps = define_steps
462 cb_ref => \$finished_cb,
463 finalize => sub { $scan->quit() if defined $scan;
464 $chg->quit() if defined $chg };
467 my $_user_msg_fn = sub {
470 if (exists($params{'scan_slot'})) {
471 print "slot $params{'slot'}:";
472 } elsif (exists($params{'slot_result'})) {
473 if (defined($params{'err'})) {
474 print " $params{'err'}\n";
475 } else { # res must be defined
476 my $res = $params{'res'};
477 my $dev = $res->{'device'};
478 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
479 my $volume_label = $res->{device}->volume_label;
480 print " $volume_label\n";
482 my $errmsg = $res->{device}->error_or_status();
489 $interactivity = Amanda::Interactivity->new(name => 'stdin');
490 $chg = load_changer($finished_cb) or return;
491 $scan = Amanda::Recovery::Scan->new(chg => $chg,
492 interactivity => $interactivity);
493 return failure("$scan", $finished_cb)
494 if ($scan->isa("Amanda::Changer::Error"));
496 $scan->find_volume(label => $label,
497 res_cb => $steps->{'done_load'},
498 user_msg_fn => $_user_msg_fn,
502 step done_load => sub {
503 my ($err, $res) = @_;
504 return failure($err, $finished_cb) if ($err);
506 my $gotslot = $res->{'this_slot'};
507 my $devname = $res->{'device'}->device_name;
509 print STDERR "label $label is now loaded from slot $gotslot\n";
511 $res->release(finished_cb => $steps->{'released'});
514 step released => sub {
516 return failure($err, $finished_cb) if ($err);
522 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
524 my ($finished_cb, @args) = @_;
526 my $taper_user_msg_fn = sub {
528 if (exists($params{'text'})) {
529 print STDERR "$params{'text'}\n";
530 } elsif (exists($params{'scan_slot'})) {
531 print STDERR "slot $params{'slot'}:";
532 } elsif (exists($params{'search_label'})) {
533 print STDERR "Searching for label '$params{'label'}':";
534 } elsif (exists($params{'slot_result'}) ||
535 exists($params{'search_result'})) {
536 if (defined($params{'err'})) {
537 if (exists($params{'search_result'}) &&
538 defined($params{'err'}->{'slot'})) {
539 print STDERR "slot $params{'err'}->{'slot'}:";
541 print STDERR " $params{'err'}\n";
542 } else { # res must be defined
543 my $res = $params{'res'};
544 my $dev = $res->{'device'};
545 if (exists($params{'search_result'})) {
546 print STDERR " found in slot $res->{'this_slot'}:";
548 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
549 my $volume_label = $res->{device}->volume_label;
550 if ($params{'active'}) {
551 print STDERR " volume '$volume_label' is still active and cannot be overwritten\n";
552 } elsif ($params{'does_not_match_labelstr'}) {
553 print STDERR " volume '$volume_label' does not match labelstr '$params{'labelstr'}'\n";
554 } elsif ($params{'not_in_tapelist'}) {
555 print STDERR " volume '$volume_label' is not in the tapelist\n"
557 print STDERR " volume '$volume_label'\n";
559 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
560 $dev->volume_header and
561 $dev->volume_header->{'type'} == $Amanda::Header::F_EMPTY) {
562 print STDERR " contains an empty volume\n";
563 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
564 $dev->volume_header and
565 $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
566 my $autolabel = getconf($CNF_AUTOLABEL);
567 if ($autolabel->{'non_amanda'}) {
568 print STDERR " contains a non-Amanda volume\n";
570 print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
572 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
573 my $message = $dev->error_or_status();
574 print STDERR " can't read label: $message\n";
576 my $errmsg = $res->{device}->error_or_status();
577 print STDERR " $errmsg\n";
581 print STDERR "UNKNOWN\n";
585 return usage($finished_cb) unless (@args == 0);
586 my $label = shift @args;
588 my $chg = load_changer($finished_cb) or return;
589 my $interactivity = Amanda::Interactivity->new(name => 'tty');
590 my $scan_name = getconf($CNF_TAPERSCAN);
591 my $taperscan = Amanda::Taper::Scan->new(algorithm => $scan_name,
595 my $result_cb = make_cb(result_cb => sub {
596 my ($err, $res, $label, $mode) = @_;
599 $res->release(finished_cb => sub {
600 $taperscan->quit() if defined $taperscan;
601 return failure($err, $finished_cb);
605 $taperscan->quit() if defined $taperscan;
606 return failure($err, $finished_cb);
610 my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
611 my $slot = $res->{'this_slot'};
612 if (defined $res->{'device'} and defined $res->{'device'}->volume_label()) {
613 print STDERR "Will $modestr to volume '$label' in slot $slot.\n";
615 my $header = $res->{'device'}->volume_header();
616 if ($header->{'type'} == $Amanda::Header::F_WEIRD) {
617 print STDERR "Will $modestr label '$label' to non-Amanda volume in slot $slot.\n";
619 print STDERR "Will $modestr label '$label' to new volume in slot $slot.\n";
622 $res->release(finished_cb => sub {
626 $taperscan->quit() if defined $taperscan;
632 result_cb => $result_cb,
633 user_msg_fn => $taper_user_msg_fn,
637 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
639 my ($finished_cb, @args) = @_;
642 my $chg = load_changer($finished_cb) or return;
645 @changed_args = (changed => shift @args);
647 $chg->update(@changed_args,
649 print STDERR "$_[0]\n";
654 return failure($err, $finished_cb) if $err;
656 print STDERR "update complete\n";
665 my ($finished_cb) = @_;
667 my $chg = Amanda::Changer->new(undef, tapelist => $tl);
668 return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
673 my ($msg, $finished_cb) = @_;
674 if ($msg->isa("Amanda::Changer::Error") and defined $msg->{'slot'}) {
675 print STDERR "ERROR: Slot: $msg->{'slot'}: $msg\n";
677 print STDERR "ERROR: $msg\n";
683 # show the slot contents in the old-fashioned format
687 printf STDERR "slot %3s: ", $res->{'this_slot'};
688 my $dev = $res->{'device'};
689 if ($dev->status != $DEVICE_STATUS_SUCCESS) {
690 print STDERR "Could not open device: "
691 . $dev->error_or_status() . "\n";
695 printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
701 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
703 my $config_overrides = new_config_overrides($#ARGV+1);
705 debug("Arguments: " . join(' ', @ARGV));
706 Getopt::Long::Configure(qw(bundling));
708 'version' => \&Amanda::Util::version_opt,
709 'help|usage|?' => \&usage,
710 'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
713 usage() if (@ARGV < 1);
715 my $config_name = shift @ARGV;
716 set_config_overrides($config_overrides);
717 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
718 my ($cfgerr_level, @cfgerr_errors) = config_errors();
719 if ($cfgerr_level >= $CFGERR_WARNINGS) {
720 config_print_errors();
721 if ($cfgerr_level >= $CFGERR_ERRORS) {
722 die("errors processing config file");
726 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
728 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
729 $tl = Amanda::Tapelist->new($tlf);
731 #make STDOUT not line buffered
732 my $previous_fh = select(STDOUT);
734 select($previous_fh);
737 my ($finished_cb) = @_;
739 my $steps = define_steps
740 cb_ref => \$finished_cb;
743 my $subcmd = shift @ARGV;
744 return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
745 invoke_subcommand($subcmd, $finished_cb, @ARGV);
749 main(\&Amanda::MainLoop::quit);
750 Amanda::MainLoop::run();
751 Amanda::Util::finish_application();