2 # Copyright (c) 2009, 2010 Zmanda, Inc. All Rights Reserved.
4 # This program is free software; you can redistribute it and/or modify it
5 # under the terms of the GNU General Public License version 2 as published
6 # by the Free Software Foundation.
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
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
17 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use lib '@amperldir@';
28 use Amanda::Device qw( :constants );
29 use Amanda::Debug qw( :logging );
30 use Amanda::Config qw( :init :getconf config_dir_relative );
31 use Amanda::Util qw( :constants );
33 use Amanda::Constants;
35 use Amanda::Taper::Scan;
36 use Amanda::Recovery::Scan;
37 use Amanda::Interactivity;
49 my ($finished_cb) = @_;
51 $finished_cb = sub { exit(1); } if (!$finished_cb or !(ref($finished_cb) eq "CODE"));
54 Usage: amtape [-o configoption]* <conf> <command> {<args>}
57 local $Text::Wrap::columns = 80 - 20;
58 for my $subcmd (sort keys %subcommands) {
59 my ($syntax, $descr, $code) = @{$subcommands{$subcmd}};
60 $descr = wrap('', ' ' x 20, $descr);
61 printf(" %-15s %s\n", $syntax, $descr);
67 sub subcommand($$$&) {
68 my ($subcmd, $syntax, $descr, $code) = @_;
70 $subcommands{$subcmd} = [ $syntax, $descr, make_cb($subcmd => $code) ];
73 sub invoke_subcommand {
74 my ($subcmd, $finished_cb, @args) = @_;
75 die "invalid subcommand $subcmd" unless exists $subcommands{$subcmd};
77 $subcommands{$subcmd}->[2]->($finished_cb, @args);
83 subcommand("usage", "usage", "this message",
85 my ($finished_cb, @args) = @_;
87 return usage($finished_cb);
90 subcommand("reset", "reset", "reset changer to known state",
92 my ($finished_cb, @args) = @_;
94 my $chg = load_changer($finished_cb) or return;
96 $chg->reset(finished_cb => sub {
99 return failure($err, $finished_cb) if $err;
101 print STDERR "changer is reset\n";
106 subcommand("eject", "eject [<drive>]", "eject the volume in the specified drive",
108 my ($finished_cb, @args) = @_;
111 my $chg = load_changer($finished_cb) or return;
114 @drive_args = (drive => shift @args);
116 $chg->eject(@drive_args,
120 return failure($err, $finished_cb) if $err;
122 print STDERR "drive ejected\n";
127 subcommand("clean", "clean [<drive>]", "clean a drive in the changer",
129 my ($finished_cb, @args) = @_;
132 my $chg = load_changer($finished_cb) or return;
135 @drive_args = (drive => shift @args);
136 } elsif (@args != 0) {
137 return usage($finished_cb);
140 $chg->clean(@drive_args,
144 return failure($err, $finished_cb) if $err;
146 print STDERR "drive cleaned\n";
151 subcommand("show", "show [<slots>]", "scan all slots (or listed slots) in the changer, starting with the current slot",
153 my ($finished_cb, @args) = @_;
159 return usage($finished_cb);
166 my @what1 = split /,/, $what;
167 foreach my $what1 (@what1) {
168 if ($what1 =~ /^(\d*)-(\d*)$/) {
171 $end = $begin if $begin > $end;
172 while ($begin <= $end) {
182 my $use_slots = @slots > 0;
184 $chg = load_changer($finished_cb) or return;
186 my $steps = define_steps
187 cb_ref => \$finished_cb,
188 finalize => sub { $chg->quit() if defined $chg };
191 $chg->info(info => [ 'num_slots' ], info_cb => $steps->{'info_cb'});
194 step info_cb => sub {
195 my ($err, %info) = @_;
196 return failure($err, $finished_cb) if $err;
199 my $slot = shift @slots;
200 $chg->load(slot => $slot,
202 res_cb => $steps->{'loaded'});
205 print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
207 $chg->load(relative_slot => 'current',
209 res_cb => $steps->{'loaded'});
214 my ($err, $res) = @_;
216 if ($err->notfound) {
217 # no more interesting slots
220 } elsif ($err->volinuse and defined $err->{'slot'}) {
221 $last_slot = $err->{'slot'};
223 return failure($err, $finished_cb) if $err;
226 $last_slot = $res->{'this_slot'};
229 $seen_slots{$last_slot} = 1;
232 my $dev = $res->{'device'};
233 my $st = $dev->read_label();
234 if ($st == $DEVICE_STATUS_SUCCESS) {
235 print STDERR sprintf("slot %3s: date %-14s label %s\n",
236 $last_slot, $dev->volume_time(),
237 $dev->volume_label());
238 } elsif ($st == $DEVICE_STATUS_VOLUME_UNLABELED) {
239 print STDERR sprintf("slot %3s: unlabeled volume\n", $last_slot);
241 print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
244 print STDERR sprintf("slot %3s: in use\n", $last_slot);
248 $res->release(finished_cb => $steps->{'released'});
250 $steps->{'released'}->();
254 step released => sub {
256 return $finished_cb->() if @slots == 0;
257 my $slot = shift @slots;
258 $chg->load(slot => $slot,
260 res_cb => $steps->{'loaded'});
263 $chg->load(relative_slot => 'next',
265 except_slots => { %seen_slots },
266 res_cb => $steps->{'loaded'});
271 subcommand("inventory", "inventory", "show inventory of changer slots",
273 my ($finished_cb, @args) = @_;
275 my $chg = load_changer($finished_cb) or return;
278 return usage($finished_cb);
281 # TODO -- support an --xml option
283 my $inventory_cb = make_cb(inventory_cb => sub {
284 my ($err, $inv) = @_;
287 if ($err->{'message'}) {
288 print STDERR "inventory not supported by this changer: $err->{'message'}\n";
290 print STDERR "inventory not supported by this changer\n";
293 print STDERR "$err\n";
297 return $finished_cb->();
301 my $line = "slot $sl->{slot}:";
302 if (!defined($sl->{device_status}) && !defined($sl->{label})) {
303 $line .= " unknown state";
304 } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
307 if (defined $sl->{label}) {
308 $line .= " label $sl->{label}";
309 my $tle = $tl->lookup_tapelabel($sl->{label});
310 if ($tle->{'meta'}) {
311 $line .= " ($tle->{'meta'})";
313 } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
315 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
316 if (defined $sl->{'device_error'}) {
317 $line .= " " . $sl->{'device_error'};
319 $line .= "device error";
321 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
327 if ($sl->{'barcode'}) {
328 $line .= " barcode $sl->{barcode}";
330 if ($sl->{'reserved'}) {
331 $line .= " reserved";
333 if (defined $sl->{'loaded_in'}) {
334 $line .= " (in drive $sl->{'loaded_in'})";
336 if ($sl->{'import_export'}) {
337 $line .= " (import/export slot)";
339 if ($sl->{'current'}) {
340 $line .= " (current)";
343 # note that inventory goes to stdout
350 $chg->inventory(inventory_cb => $inventory_cb);
353 subcommand("current", "current", "load and show the contents of the current slot",
355 my ($finished_cb, @args) = @_;
357 return usage($finished_cb) if @args;
359 # alias for 'slot current'
360 return invoke_subcommand("slot", $finished_cb, "current");
363 subcommand("slot", "slot <slot>",
364 "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
366 my ($finished_cb, @args) = @_;
370 my $steps = define_steps
371 cb_ref => \$finished_cb,
372 finalize => sub { $chg->quit() if defined $chg };
374 # NOTE: the syntax of this subcommand precludes actual slots named
375 # 'current' or 'next' .. when we have a changer using such slot names,
376 # this subcommand will need to support a --literal flag
378 return usage($finished_cb) unless (@args == 1);
379 my $slot = shift @args;
381 $chg = load_changer($finished_cb) or return;
383 step get_slot => sub {
384 if ($slot eq 'current' or $slot eq 'next') {
385 @slotarg = (relative_slot => $slot);
386 } elsif ($slot eq 'first' or $slot eq 'last') {
387 return $chg->inventory(inventory_cb => $steps->{'inventory_cb'});
389 @slotarg = (slot => $slot);
392 $steps->{'do_load'}->();
395 step inventory_cb => sub {
396 my ($err, $inv) = @_;
398 if ($err->failed and $err->notimpl) {
399 return failed("This changer does not support special slot '$slot'");
405 if ($slot eq 'first') {
406 @slotarg = (slot => $inv->[0]->{'slot'});
408 @slotarg = (slot => $inv->[-1]->{'slot'});
411 $steps->{'do_load'}->();
414 step do_load => sub {
415 $chg->load(@slotarg, set_current => 1,
416 res_cb => $steps->{'done_load'});
419 step done_load => sub {
420 my ($err, $res) = @_;
421 return failure($err, $finished_cb) if ($err);
424 my $gotslot = $res->{'this_slot'};
425 print STDERR "changed to slot $gotslot\n";
427 $res->release(finished_cb => $steps->{'released'});
430 step released => sub {
432 return failure($err, $finished_cb) if ($err);
438 subcommand("label", "label <label>", "load the volume with label <label>",
440 my ($finished_cb, @args) = @_;
445 return usage($finished_cb) unless (@args == 1);
446 my $label = shift @args;
448 my $steps = define_steps
449 cb_ref => \$finished_cb,
450 finalize => sub { $scan->quit() if defined $scan;
451 $chg->quit() if defined $chg };
454 my $_user_msg_fn = sub {
457 if (exists($params{'scan_slot'})) {
458 print "slot $params{'slot'}:";
459 } elsif (exists($params{'slot_result'})) {
460 if (defined($params{'err'})) {
461 print " $params{'err'}\n";
462 } else { # res must be defined
463 my $res = $params{'res'};
464 my $dev = $res->{'device'};
465 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
466 my $volume_label = $res->{device}->volume_label;
467 print " $volume_label\n";
469 my $errmsg = $res->{device}->error_or_status();
476 $interactivity = Amanda::Interactivity->new(name => 'stdin');
477 $chg = load_changer($finished_cb) or return;
478 $scan = Amanda::Recovery::Scan->new(chg => $chg,
479 interactivity => $interactivity);
480 return failure("$scan", $finished_cb)
481 if ($scan->isa("Amanda::Changer::Error"));
483 $scan->find_volume(label => $label,
484 res_cb => $steps->{'done_load'},
485 user_msg_fn => $_user_msg_fn,
489 step done_load => sub {
490 my ($err, $res) = @_;
491 return failure($err, $finished_cb) if ($err);
493 my $gotslot = $res->{'this_slot'};
494 my $devname = $res->{'device'}->device_name;
496 print STDERR "label $label is now loaded from slot $gotslot\n";
498 $res->release(finished_cb => $steps->{'released'});
501 step released => sub {
503 return failure($err, $finished_cb) if ($err);
509 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
511 my ($finished_cb, @args) = @_;
513 my $taper_user_msg_fn = sub {
515 if (exists($params{'text'})) {
516 print STDERR "$params{'text'}\n";
517 } elsif (exists($params{'scan_slot'})) {
518 print STDERR "slot $params{'slot'}:";
519 } elsif (exists($params{'search_label'})) {
520 print STDERR "Searching for label '$params{'label'}':";
521 } elsif (exists($params{'slot_result'}) ||
522 exists($params{'search_result'})) {
523 if (defined($params{'err'})) {
524 if (exists($params{'search_result'}) &&
525 defined($params{'err'}->{'slot'})) {
526 print STDERR "slot $params{'err'}->{'slot'}:";
528 print STDERR " $params{'err'}\n";
529 } else { # res must be defined
530 my $res = $params{'res'};
531 my $dev = $res->{'device'};
532 if (exists($params{'search_result'})) {
533 print STDERR " found in slot $res->{'this_slot'}:";
535 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
536 my $volume_label = $res->{device}->volume_label;
537 if ($params{'active'}) {
538 print STDERR " volume '$volume_label' is still active and cannot be overwritten\n";
539 } elsif ($params{'does_not_match_labelstr'}) {
540 print STDERR " volume '$volume_label' does not match labelstr '$params{'labelstr'}'\n";
541 } elsif ($params{'not_in_tapelist'}) {
542 print STDERR " volume '$volume_label' is not in the tapelist\n"
544 print STDERR " volume '$volume_label'\n";
546 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
547 $dev->volume_header and
548 $dev->volume_header->{'type'} == $Amanda::Header::F_EMPTY) {
549 print STDERR " contains an empty volume\n";
550 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
551 $dev->volume_header and
552 $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
553 print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
554 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
555 my $message = $dev->error_or_status();
556 print STDERR " can't read label: $message\n";
558 my $errmsg = $res->{device}->error_or_status();
559 print STDERR " $errmsg\n";
563 print STDERR "UNKNOWN\n";
567 return usage($finished_cb) unless (@args == 0);
568 my $label = shift @args;
570 my $chg = load_changer($finished_cb) or return;
571 my $interactivity = Amanda::Interactivity->new(name => 'tty');
572 my $scan_name = getconf($CNF_TAPERSCAN);
573 my $taperscan = Amanda::Taper::Scan->new(algorithm => $scan_name,
577 my $result_cb = make_cb(result_cb => sub {
578 my ($err, $res, $label, $mode) = @_;
581 $res->release(finished_cb => sub {
582 $taperscan->quit() if defined $taperscan;
583 return failure($err, $finished_cb);
587 $taperscan->quit() if defined $taperscan;
588 return failure($err, $finished_cb);
592 my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
593 my $slot = $res->{'this_slot'};
594 if (defined $res->{'device'} and defined $res->{'device'}->volume_label()) {
595 print STDERR "Will $modestr to volume '$label' in slot $slot.\n";
597 print STDERR "Will $modestr label '$label' to new volume in slot $slot.\n";
599 $res->release(finished_cb => sub {
603 $taperscan->quit() if defined $taperscan;
609 result_cb => $result_cb,
610 user_msg_fn => $taper_user_msg_fn,
614 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
616 my ($finished_cb, @args) = @_;
619 my $chg = load_changer($finished_cb) or return;
622 @changed_args = (changed => shift @args);
624 $chg->update(@changed_args,
626 print STDERR "$_[0]\n";
631 return failure($err, $finished_cb) if $err;
633 print STDERR "update complete\n";
642 my ($finished_cb) = @_;
644 my $chg = Amanda::Changer->new(undef, tapelist => $tl);
645 return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
650 my ($msg, $finished_cb) = @_;
651 print STDERR "ERROR: $msg\n";
656 # show the slot contents in the old-fashioned format
660 printf STDERR "slot %3s: ", $res->{'this_slot'};
661 my $dev = $res->{'device'};
662 if ($dev->status != $DEVICE_STATUS_SUCCESS) {
663 print STDERR "Could not open device: "
664 . $dev->error_or_status() . "\n";
668 printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
674 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
676 my $config_overrides = new_config_overrides($#ARGV+1);
678 debug("Arguments: " . join(' ', @ARGV));
679 Getopt::Long::Configure(qw(bundling));
681 'version' => \&Amanda::Util::version_opt,
682 'help|usage|?' => \&usage,
683 'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
686 usage() if (@ARGV < 1);
688 my $config_name = shift @ARGV;
689 set_config_overrides($config_overrides);
690 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
691 my ($cfgerr_level, @cfgerr_errors) = config_errors();
692 if ($cfgerr_level >= $CFGERR_WARNINGS) {
693 config_print_errors();
694 if ($cfgerr_level >= $CFGERR_ERRORS) {
695 die("errors processing config file");
699 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
701 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
702 $tl = Amanda::Tapelist->new($tlf);
704 #make STDOUT not line buffered
705 my $previous_fh = select(STDOUT);
707 select($previous_fh);
710 my ($finished_cb) = @_;
712 my $steps = define_steps
713 cb_ref => \$finished_cb;
716 my $subcmd = shift @ARGV;
717 return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
718 invoke_subcommand($subcmd, $finished_cb, @ARGV);
722 main(\&Amanda::MainLoop::quit);
723 Amanda::MainLoop::run();
724 Amanda::Util::finish_application();