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::Interactive;
47 my ($finished_cb) = @_;
49 $finished_cb = sub { exit(1); } if (!$finished_cb or !(ref($finished_cb) eq "CODE"));
52 Usage: amtape [-o configoption]* <conf> <command> {<args>}
55 local $Text::Wrap::columns = 80 - 20;
56 for my $subcmd (sort keys %subcommands) {
57 my ($syntax, $descr, $code) = @{$subcommands{$subcmd}};
58 $descr = wrap('', ' ' x 20, $descr);
59 printf(" %-15s %s\n", $syntax, $descr);
65 sub subcommand($$$&) {
66 my ($subcmd, $syntax, $descr, $code) = @_;
68 $subcommands{$subcmd} = [ $syntax, $descr, make_cb($subcmd => $code) ];
71 sub invoke_subcommand {
72 my ($subcmd, $finished_cb, @args) = @_;
73 die "invalid subcommand $subcmd" unless exists $subcommands{$subcmd};
75 $subcommands{$subcmd}->[2]->($finished_cb, @args);
81 subcommand("usage", "usage", "this message",
83 my ($finished_cb, @args) = @_;
85 return usage($finished_cb);
88 subcommand("reset", "reset", "reset changer to known state",
90 my ($finished_cb, @args) = @_;
92 my $chg = load_changer($finished_cb) or return;
94 $chg->reset(finished_cb => sub {
96 return failure($err, $finished_cb) if $err;
98 print STDERR "changer is reset\n";
103 subcommand("eject", "eject [<drive>]", "eject the volume in the specified drive",
105 my ($finished_cb, @args) = @_;
108 my $chg = load_changer($finished_cb) or return;
111 @drive_args = (drive => shift @args);
113 $chg->eject(@drive_args,
116 return failure($err, $finished_cb) if $err;
118 print STDERR "drive ejected\n";
123 subcommand("clean", "clean [<drive>]", "clean a drive in the changer",
125 my ($finished_cb, @args) = @_;
128 my $chg = load_changer($finished_cb) or return;
131 @drive_args = (drive => shift @args);
132 } elsif (@args != 0) {
133 return usage($finished_cb);
136 $chg->clean(@drive_args,
139 return failure($err, $finished_cb) if $err;
141 print STDERR "drive cleaned\n";
146 subcommand("show", "show", "scan all slots in the changer, starting with the current slot",
148 my ($finished_cb, @args) = @_;
153 my $steps = define_steps
154 cb_ref => \$finished_cb;
157 return usage($finished_cb);
160 my $chg = load_changer($finished_cb) or return;
163 $chg->info(info => [ 'num_slots' ], info_cb => $steps->{'info_cb'});
166 step info_cb => sub {
167 my ($err, %info) = @_;
168 return failure($err, $finished_cb) if $err;
170 print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
172 $steps->{'load_current'}->();
175 step load_current => sub {
176 $chg->load(relative_slot => 'current', mode => "read", res_cb => $steps->{'loaded'});
180 my ($err, $res) = @_;
182 if ($err->notfound) {
183 # no more interesting slots
186 } elsif ($err->volinuse and defined $err->{'slot'}) {
187 $last_slot = $err->{'slot'};
189 return failure($err, $finished_cb) if $err;
192 $last_slot = $res->{'this_slot'};
195 $seen_slots{$last_slot} = 1;
198 my $dev = $res->{'device'};
199 my $st = $dev->read_label();
200 if ($st == $DEVICE_STATUS_SUCCESS) {
201 print STDERR sprintf("slot %3s: date %-14s label %s\n",
202 $last_slot, $dev->volume_time(),
203 $dev->volume_label());
205 return $res->set_label(label => $dev->volume_label(),
206 finished_cb => $steps->{'set_labeled'});
207 } elsif ($st == $DEVICE_STATUS_VOLUME_UNLABELED) {
208 print STDERR sprintf("slot %3s: unlabeled volume\n", $last_slot);
210 print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
213 print STDERR sprintf("slot %3s: in use\n", $last_slot);
217 $res->release(finished_cb => $steps->{'released'});
219 $steps->{'released'}->();
223 step set_labeled => sub {
224 $gres->release(finished_cb => $steps->{'released'});
227 step released => sub {
228 $chg->load(relative_slot => 'next', slot => $last_slot,
229 except_slots => { %seen_slots }, res_cb => $steps->{'loaded'});
233 subcommand("inventory", "inventory", "show inventory of changer slots",
235 my ($finished_cb, @args) = @_;
237 my $chg = load_changer($finished_cb) or return;
240 return usage($finished_cb);
243 # TODO -- support an --xml option
245 my $inventory_cb = make_cb(inventory_cb => sub {
246 my ($err, $inv) = @_;
249 print STDERR "inventory not supported by this changer\n";
251 print STDERR "$err\n";
254 return $finished_cb->();
258 my $line = "slot $sl->{slot}:";
259 if (!defined($sl->{device_status}) && !defined($sl->{label})) {
260 $line .= " unknown state";
261 } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
264 if (defined $sl->{label}) {
265 $line .= " label $sl->{label}";
266 } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
268 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
269 $line .= "device error";
270 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
276 if ($sl->{'barcode'}) {
277 $line .= " barcode $sl->{barcode}";
279 if ($sl->{'reserved'}) {
280 $line .= " reserved";
282 if (defined $sl->{'loaded_in'}) {
283 $line .= " (in drive $sl->{'loaded_in'})";
285 if ($sl->{'import_export'}) {
286 $line .= " (import/export slot)";
289 # note that inventory goes to stdout
295 $chg->inventory(inventory_cb => $inventory_cb);
298 subcommand("current", "current", "load and show the contents of the current slot",
300 my ($finished_cb, @args) = @_;
302 return usage($finished_cb) if @args;
304 # alias for 'slot current'
305 return invoke_subcommand("slot", $finished_cb, "current");
308 subcommand("slot", "slot <slot>",
309 "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
311 my ($finished_cb, @args) = @_;
315 my $steps = define_steps
316 cb_ref => \$finished_cb;
318 # NOTE: the syntax of this subcommand precludes actual slots named
319 # 'current' or 'next' .. when we have a changer using such slot names,
320 # this subcommand will need to support a --literal flag
322 return usage($finished_cb) unless (@args == 1);
323 my $slot = shift @args;
325 my $chg = load_changer($finished_cb) or return;
327 step get_slot => sub {
328 if ($slot eq 'current' or $slot eq 'next') {
329 @slotarg = (relative_slot => $slot);
330 } elsif ($slot eq 'first' or $slot eq 'last') {
331 return $chg->inventory(inventory_cb => $steps->{'inventory_cb'});
333 @slotarg = (slot => $slot);
336 $steps->{'do_load'}->();
339 step inventory_cb => sub {
340 my ($err, $inv) = @_;
342 if ($err->failed and $err->notimpl) {
343 return failed("This changer does not support special slot '$slot'");
349 if ($slot eq 'first') {
350 @slotarg = (slot => $inv->[0]->{'slot'});
352 @slotarg = (slot => $inv->[-1]->{'slot'});
355 $steps->{'do_load'}->();
358 step do_load => sub {
359 $chg->load(@slotarg, set_current => 1,
360 res_cb => $steps->{'done_load'});
363 step done_load => sub {
364 my ($err, $res) = @_;
365 return failure($err, $finished_cb) if ($err);
368 my $gotslot = $res->{'this_slot'};
369 print STDERR "changed to slot $gotslot\n";
371 if ($res->{device}->volume_label) {
373 $res->set_label(label => $res->{device}->volume_label(),
374 finished_cb => $steps->{'set_labeled'});
376 $res->release(finished_cb => $steps->{'released'});
380 step set_labeled => sub {
381 $gres->release(finished_cb => $steps->{'released'});
384 step released => sub {
386 return failure($err, $finished_cb) if ($err);
392 subcommand("label", "label <label>", "load the volume with label <label>",
394 my ($finished_cb, @args) = @_;
399 return usage($finished_cb) unless (@args == 1);
400 my $label = shift @args;
402 my $steps = define_steps
403 cb_ref => \$finished_cb;
406 my $_user_msg_fn = sub {
409 if (exists($params{'scan_slot'})) {
410 print "slot $params{'slot'}:";
411 } elsif (exists($params{'slot_result'})) {
412 if (defined($params{'err'})) {
413 print " $params{'err'}\n";
414 } else { # res must be defined
415 my $res = $params{'res'};
416 my $dev = $res->{'device'};
417 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
418 my $volume_label = $res->{device}->volume_label;
419 print " $volume_label\n";
421 my $errmsg = $res->{device}->error_or_status();
428 $inter = Amanda::Interactive->new(name => 'stdin');
429 $scan = Amanda::Recovery::Scan->new(interactive => $inter);
430 return failure("$scan", $finished_cb)
431 if ($scan->isa("Amanda::Changer::Error"));
433 $scan->find_volume(label => $label,
434 res_cb => $steps->{'done_load'},
435 user_msg_fn => $_user_msg_fn,
439 step done_load => sub {
440 my ($err, $res) = @_;
441 return failure($err, $finished_cb) if ($err);
443 my $gotslot = $res->{'this_slot'};
444 my $devname = $res->{'device'}->device_name;
446 print STDERR "label $label is now loaded from slot $gotslot\n";
448 if ($res->{device}->volume_label) {
450 $res->set_label(label => $res->{device}->volume_label(),
451 finished_cb => $steps->{'set_labeled'});
453 $res->release(finished_cb => $steps->{'released'});
457 step set_labeled => sub {
458 $gres->release(finished_cb => $steps->{'released'});
461 step released => sub {
463 return failure($err, $finished_cb) if ($err);
469 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
471 my ($finished_cb, @args) = @_;
473 my $taper_user_msg_fn = sub {
475 if (exists($params{'text'})) {
476 print STDERR "$params{'text'}\n";
477 } elsif (exists($params{'scan_slot'})) {
478 print STDERR "slot $params{'slot'}:";
479 } elsif (exists($params{'search_label'})) {
480 print STDERR "Searching for label '$params{'label'}':";
481 } elsif (exists($params{'slot_result'}) ||
482 exists($params{'search_result'})) {
483 if (defined($params{'err'})) {
484 if (exists($params{'search_result'}) &&
485 defined($params{'err'}->{'slot'})) {
486 print STDERR "slot $params{'err'}->{'slot'}:";
488 print STDERR " $params{'err'}\n";
489 } else { # res must be defined
490 my $res = $params{'res'};
491 my $dev = $res->{'device'};
492 if (exists($params{'search_result'})) {
493 print STDERR " found in slot $res->{'this_slot'}:";
495 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
496 my $volume_label = $res->{device}->volume_label;
497 if ($params{'active'}) {
498 print STDERR " volume '$volume_label' is still active and cannot be overwritten\n";
499 } elsif ($params{'does_not_match_labelstr'}) {
500 print STDERR " volume '$volume_label' does not match labelstr '$params{'labelstr'}'\n";
501 } elsif ($params{'not_in_tapelist'}) {
502 print STDERR " volume '$volume_label' is not in the tapelist\n"
504 print STDERR " volume '$volume_label'\n";
506 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
507 $dev->volume_header and
508 $dev->volume_header->{'type'} == $Amanda::Header::F_EMPTY) {
509 print STDERR " contains an empty volume\n";
510 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
511 $dev->volume_header and
512 $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
513 print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
514 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
515 my $message = $dev->error_or_status();
516 print STDERR " can't read label: $message\n";
518 my $errmsg = $res->{device}->error_or_status();
519 print STDERR " $errmsg\n";
523 print STDERR "UNKNOWN\n";
527 return usage($finished_cb) unless (@args == 0);
528 my $label = shift @args;
530 my $chg = load_changer($finished_cb) or return;
532 my $result_cb = make_cb(result_cb => sub {
533 my ($err, $res, $label, $mode) = @_;
534 return failure($err, $finished_cb) if $err;
536 my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
537 my $slot = $res->{'this_slot'};
538 print STDERR "Will $modestr to volume $label in slot $slot.\n";
539 $res->release(finished_cb => sub {
547 my $taperscan = Amanda::Taper::Scan->new(changer => $chg);
549 result_cb => $result_cb,
550 user_msg_fn => $taper_user_msg_fn,
554 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
556 my ($finished_cb, @args) = @_;
559 my $chg = load_changer($finished_cb) or return;
562 @changed_args = (changed => shift @args);
564 $chg->update(@changed_args,
566 print STDERR "$_[0]\n";
570 return failure($err, $finished_cb) if $err;
572 print STDERR "update complete\n";
581 my ($finished_cb) = @_;
583 my $chg = Amanda::Changer->new();
584 return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
589 my ($msg, $finished_cb) = @_;
590 print STDERR "ERROR: $msg\n";
595 # show the slot contents in the old-fashioned format
599 printf STDERR "slot %3s: ", $res->{'this_slot'};
600 my $dev = $res->{'device'};
601 if ($dev->status != $DEVICE_STATUS_SUCCESS) {
602 print STDERR "Could not open device: "
603 . $dev->error_or_status() . "\n";
607 printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
613 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
615 my $config_overrides = new_config_overrides($#ARGV+1);
617 Getopt::Long::Configure(qw(bundling));
619 'help|usage|?' => \&usage,
620 'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
623 usage() if (@ARGV < 1);
625 my $config_name = shift @ARGV;
626 set_config_overrides($config_overrides);
627 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
628 my ($cfgerr_level, @cfgerr_errors) = config_errors();
629 if ($cfgerr_level >= $CFGERR_WARNINGS) {
630 config_print_errors();
631 if ($cfgerr_level >= $CFGERR_ERRORS) {
632 die("errors processing config file");
636 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
638 #make STDOUT not line buffered
639 my $previous_fh = select(STDOUT);
641 select($previous_fh);
644 my ($finished_cb) = @_;
646 my $steps = define_steps
647 cb_ref => \$finished_cb;
650 my $subcmd = shift @ARGV;
651 return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
652 invoke_subcommand($subcmd, $finished_cb, @ARGV);
656 main(\&Amanda::MainLoop::quit);
657 Amanda::MainLoop::run();
658 Amanda::Util::finish_application();