git.gag.com Git - debian/amanda/blob - server-src/amtape.pl

   1 #! @PERL@
   2 # Copyright (c) 2009, 2010 Zmanda, Inc.  All Rights Reserved.
   3 #
   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.
   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 94086, USA, or: http://www.zmanda.com
  19
  20 use lib '@amperldir@';
  21 use strict;
  22 use warnings;
  23
  24 use File::Basename;
  25 use Getopt::Long;
  26 use Text::Wrap;
  27
  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 );
  32 use Amanda::Changer;
  33 use Amanda::Constants;
  34 use Amanda::MainLoop;
  35 use Amanda::Taper::Scan;
  36 use Amanda::Recovery::Scan;
  37 use Amanda::Interactivity;
  38 use Amanda::Tapelist;
  39
  40 my $exit_status = 0;
  41 my $tl;
  42
  43 ##
  44 # Subcommand handling
  45
  46 my %subcommands;
  47
  48 sub usage {
  49     my ($finished_cb) = @_;
  50
  51     $finished_cb = sub { exit(1); } if (!$finished_cb or !(ref($finished_cb) eq "CODE"));
  52
  53     print STDERR <<EOF;
  54 Usage: amtape [-o configoption]* <conf> <command> {<args>}
  55   Valid commands are:
  56 EOF
  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);
  62     }
  63     $exit_status = 1;
  64     $finished_cb->();
  65 }
  66
  67 sub subcommand($$$&) {
  68     my ($subcmd, $syntax, $descr, $code) = @_;
  69
  70     $subcommands{$subcmd} = [ $syntax, $descr, make_cb($subcmd => $code) ];
  71 }
  72
  73 sub invoke_subcommand {
  74     my ($subcmd, $finished_cb, @args) = @_;
  75     die "invalid subcommand $subcmd" unless exists $subcommands{$subcmd};
  76
  77     $subcommands{$subcmd}->[2]->($finished_cb, @args);
  78 }
  79
  80 ##
  81 # subcommands
  82
  83 subcommand("usage", "usage", "this message",
  84 sub {
  85     my ($finished_cb, @args) = @_;
  86
  87     return usage($finished_cb);
  88 });
  89
  90 subcommand("reset", "reset", "reset changer to known state",
  91 sub {
  92     my ($finished_cb, @args) = @_;
  93
  94     my $chg = load_changer($finished_cb) or return;
  95
  96     $chg->reset(finished_cb => sub {
  97             my ($err) = @_;
  98             $chg->quit();
  99             return failure($err, $finished_cb) if $err;
 100
 101             print STDERR "changer is reset\n";
 102             $finished_cb->();
 103         });
 104 });
 105
 106 subcommand("eject", "eject [<drive>]", "eject the volume in the specified drive",
 107 sub {
 108     my ($finished_cb, @args) = @_;
 109     my @drive_args;
 110
 111     my $chg = load_changer($finished_cb) or return;
 112
 113     if (@args) {
 114         @drive_args = (drive => shift @args);
 115     }
 116     $chg->eject(@drive_args,
 117         finished_cb => sub {
 118             my ($err) = @_;
 119             $chg->quit();
 120             return failure($err, $finished_cb) if $err;
 121
 122             print STDERR "drive ejected\n";
 123             $finished_cb->();
 124         });
 125 });
 126
 127 subcommand("clean", "clean [<drive>]", "clean a drive in the changer",
 128 sub {
 129     my ($finished_cb, @args) = @_;
 130     my @drive_args;
 131
 132     my $chg = load_changer($finished_cb) or return;
 133
 134     if (@args == 1) {
 135         @drive_args = (drive => shift @args);
 136     } elsif (@args != 0) {
 137         return usage($finished_cb);
 138     }
 139
 140     $chg->clean(@drive_args,
 141         finished_cb => sub {
 142             my ($err) = @_;
 143             $chg->quit();
 144             return failure($err, $finished_cb) if $err;
 145
 146             print STDERR "drive cleaned\n";
 147             $finished_cb->();
 148         });
 149 });
 150
 151 subcommand("show", "show", "scan all slots in the changer, starting with the current slot",
 152 sub {
 153     my ($finished_cb, @args) = @_;
 154     my $last_slot;
 155     my %seen_slots;
 156     my $chg;
 157
 158     if (@args != 0) {
 159         return usage($finished_cb);
 160     }
 161
 162     $chg = load_changer($finished_cb) or return;
 163
 164     my $steps = define_steps
 165         cb_ref => \$finished_cb,
 166         finalize => sub { $chg->quit() if defined $chg };
 167
 168     step start => sub {
 169         $chg->info(info => [ 'num_slots' ], info_cb => $steps->{'info_cb'});
 170     };
 171
 172     step info_cb => sub {
 173         my ($err, %info) = @_;
 174         return failure($err, $finished_cb) if $err;
 175
 176         print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
 177
 178         $steps->{'load_current'}->();
 179     };
 180
 181     step load_current => sub {
 182         $chg->load(relative_slot => 'current', mode => "read", res_cb => $steps->{'loaded'});
 183     };
 184
 185     step loaded => sub {
 186         my ($err, $res) = @_;
 187         if ($err) {
 188             if ($err->notfound) {
 189                 # no more interesting slots
 190                 $finished_cb->();
 191                 return;
 192             } elsif ($err->volinuse and defined $err->{'slot'}) {
 193                 $last_slot = $err->{'slot'};
 194             } else {
 195                 return failure($err, $finished_cb) if $err;
 196             }
 197         } else {
 198             $last_slot = $res->{'this_slot'};
 199         }
 200
 201         $seen_slots{$last_slot} = 1;
 202
 203         if ($res) {
 204             my $dev = $res->{'device'};
 205             my $st = $dev->read_label();
 206             if ($st == $DEVICE_STATUS_SUCCESS) {
 207                 print STDERR sprintf("slot %3s: date %-14s label %s\n",
 208                         $last_slot, $dev->volume_time(),
 209                         $dev->volume_label());
 210             } elsif ($st == $DEVICE_STATUS_VOLUME_UNLABELED) {
 211                 print STDERR sprintf("slot %3s: unlabeled volume\n", $last_slot);
 212             } else {
 213                 print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
 214             }
 215         } else {
 216             print STDERR sprintf("slot %3s: in use\n", $last_slot);
 217         }
 218
 219         if ($res) {
 220             $res->release(finished_cb => $steps->{'released'});
 221         } else {
 222             $steps->{'released'}->();
 223         }
 224     };
 225
 226     step released => sub {
 227         $chg->load(relative_slot => 'next', slot => $last_slot,
 228                    except_slots => { %seen_slots }, res_cb => $steps->{'loaded'});
 229     };
 230 });
 231
 232 subcommand("inventory", "inventory", "show inventory of changer slots",
 233 sub {
 234     my ($finished_cb, @args) = @_;
 235
 236     my $chg = load_changer($finished_cb) or return;
 237
 238     if (@args != 0) {
 239         return usage($finished_cb);
 240     }
 241
 242     # TODO -- support an --xml option
 243
 244     my $inventory_cb = make_cb(inventory_cb => sub {
 245         my ($err, $inv) = @_;
 246         if ($err) {
 247             if ($err->notimpl) {
 248                 if ($err->{'message'}) {
 249                     print STDERR "inventory not supported by this changer: $err->{'message'}\n";
 250                 } else {
 251                     print STDERR "inventory not supported by this changer\n";
 252                 }
 253             } else {
 254                 print STDERR "$err\n";
 255             }
 256
 257             $chg->quit();
 258             return $finished_cb->();
 259         }
 260
 261         for my $sl (@$inv) {
 262             my $line = "slot $sl->{slot}:";
 263             if (!defined($sl->{device_status}) && !defined($sl->{label})) {
 264                 $line .= " unknown state";
 265             } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
 266                 $line .= " empty";
 267             } else {
 268                 if (defined $sl->{label}) {
 269                     $line .= " label $sl->{label}";
 270                     my $tle = $tl->lookup_tapelabel($sl->{label});
 271                     if ($tle->{'meta'}) {
 272                         $line .= " ($tle->{'meta'})";
 273                     }
 274                 } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
 275                     $line .= " blank";
 276                 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
 277                     $line .= "device error";
 278                 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
 279                     $line .= " blank";
 280                 } else {
 281                     $line .= " unknown";
 282                 }
 283             }
 284             if ($sl->{'barcode'}) {
 285                 $line .= " barcode $sl->{barcode}";
 286             }
 287             if ($sl->{'reserved'}) {
 288                 $line .= " reserved";
 289             }
 290             if (defined $sl->{'loaded_in'}) {
 291                 $line .= " (in drive $sl->{'loaded_in'})";
 292             }
 293             if ($sl->{'import_export'}) {
 294                 $line .= " (import/export slot)";
 295             }
 296             if ($sl->{'current'}) {
 297                 $line .= " (current)";
 298             }
 299
 300             # note that inventory goes to stdout
 301             print "$line\n";
 302         }
 303
 304         $chg->quit();
 305         $finished_cb->();
 306     });
 307     $chg->inventory(inventory_cb => $inventory_cb);
 308 });
 309
 310 subcommand("current", "current", "load and show the contents of the current slot",
 311 sub {
 312     my ($finished_cb, @args) = @_;
 313
 314     return usage($finished_cb) if @args;
 315
 316     # alias for 'slot current'
 317     return invoke_subcommand("slot", $finished_cb, "current");
 318 });
 319
 320 subcommand("slot", "slot <slot>",
 321            "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
 322 sub {
 323     my ($finished_cb, @args) = @_;
 324     my @slotarg;
 325     my $chg;
 326
 327     my $steps = define_steps
 328         cb_ref => \$finished_cb,
 329         finalize => sub { $chg->quit() if defined $chg };
 330
 331     # NOTE: the syntax of this subcommand precludes actual slots named
 332     # 'current' or 'next' ..  when we have a changer using such slot names,
 333     # this subcommand will need to support a --literal flag
 334
 335     return usage($finished_cb) unless (@args == 1);
 336     my $slot = shift @args;
 337
 338     $chg = load_changer($finished_cb) or return;
 339
 340     step get_slot => sub {
 341         if ($slot eq 'current' or $slot eq 'next') {
 342             @slotarg = (relative_slot => $slot);
 343         } elsif ($slot eq 'first' or $slot eq 'last') {
 344             return $chg->inventory(inventory_cb => $steps->{'inventory_cb'});
 345         } else {
 346             @slotarg = (slot => $slot);
 347         }
 348
 349         $steps->{'do_load'}->();
 350     };
 351
 352     step inventory_cb => sub {
 353         my ($err, $inv) = @_;
 354         if ($err) {
 355             if ($err->failed and $err->notimpl) {
 356                 return failed("This changer does not support special slot '$slot'");
 357             } else {
 358                 return failed($err);
 359             }
 360         }
 361
 362         if ($slot eq 'first') {
 363             @slotarg = (slot => $inv->[0]->{'slot'});
 364         } else {
 365             @slotarg = (slot => $inv->[-1]->{'slot'});
 366         }
 367
 368         $steps->{'do_load'}->();
 369     };
 370
 371     step do_load => sub {
 372         $chg->load(@slotarg, set_current => 1,
 373             res_cb => $steps->{'done_load'});
 374     };
 375
 376     step done_load => sub {
 377         my ($err, $res) = @_;
 378         return failure($err, $finished_cb) if ($err);
 379
 380         show_slot($res);
 381         my $gotslot = $res->{'this_slot'};
 382         print STDERR "changed to slot $gotslot\n";
 383
 384         $res->release(finished_cb => $steps->{'released'});
 385     };
 386
 387     step released => sub {
 388         my ($err) = @_;
 389         return failure($err, $finished_cb) if ($err);
 390
 391         $finished_cb->();
 392     };
 393 });
 394
 395 subcommand("label", "label <label>", "load the volume with label <label>",
 396 sub {
 397     my ($finished_cb, @args) = @_;
 398     my $interactivity;
 399     my $scan;
 400     my $chg;
 401
 402     return usage($finished_cb) unless (@args == 1);
 403     my $label = shift @args;
 404
 405     my $steps = define_steps
 406         cb_ref => \$finished_cb,
 407         finalize => sub { $scan->quit() if defined $scan;
 408                           $chg->quit() if defined $chg };
 409
 410     step start => sub {
 411         my $_user_msg_fn = sub {
 412             my %params = @_;
 413
 414             if (exists($params{'scan_slot'})) {
 415                 print "slot $params{'slot'}:";
 416             } elsif (exists($params{'slot_result'})) {
 417                 if (defined($params{'err'})) {
 418                     print " $params{'err'}\n";
 419                 } else { # res must be defined
 420                     my $res = $params{'res'};
 421                     my $dev = $res->{'device'};
 422                     if ($dev->status == $DEVICE_STATUS_SUCCESS) {
 423                         my $volume_label = $res->{device}->volume_label;
 424                         print " $volume_label\n";
 425                     } else {
 426                         my $errmsg = $res->{device}->error_or_status();
 427                         print " $errmsg\n";
 428                     }
 429                 }
 430             }
 431         };
 432
 433         $interactivity = Amanda::Interactivity->new(name => 'stdin');
 434         $chg = load_changer($finished_cb) or return;
 435         $scan = Amanda::Recovery::Scan->new(chg => $chg,
 436                                             interactivity => $interactivity);
 437         return failure("$scan", $finished_cb)
 438             if ($scan->isa("Amanda::Changer::Error"));
 439
 440         $scan->find_volume(label  => $label,
 441                            res_cb => $steps->{'done_load'},
 442                            user_msg_fn => $_user_msg_fn,
 443                            set_current => 1);
 444     };
 445
 446     step done_load => sub {
 447         my ($err, $res) = @_;
 448         return failure($err, $finished_cb) if ($err);
 449
 450         my $gotslot = $res->{'this_slot'};
 451         my $devname = $res->{'device'}->device_name;
 452         show_slot($res);
 453         print STDERR "label $label is now loaded from slot $gotslot\n";
 454
 455         $res->release(finished_cb => $steps->{'released'});
 456     };
 457
 458     step released => sub {
 459         my ($err) = @_;
 460         return failure($err, $finished_cb) if ($err);
 461
 462         $finished_cb->();
 463     };
 464 });
 465
 466 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
 467 sub {
 468     my ($finished_cb, @args) = @_;
 469
 470     my $taper_user_msg_fn = sub {
 471         my %params = @_;
 472         if (exists($params{'text'})) {
 473             print STDERR "$params{'text'}\n";
 474         } elsif (exists($params{'scan_slot'})) {
 475             print STDERR "slot $params{'slot'}:";
 476         } elsif (exists($params{'search_label'})) {
 477             print STDERR "Searching for label '$params{'label'}':";
 478         } elsif (exists($params{'slot_result'}) ||
 479                  exists($params{'search_result'})) {
 480             if (defined($params{'err'})) {
 481                 if (exists($params{'search_result'}) &&
 482                     defined($params{'err'}->{'slot'})) {
 483                     print STDERR "slot $params{'err'}->{'slot'}:";
 484                 }
 485                 print STDERR " $params{'err'}\n";
 486             } else { # res must be defined
 487                 my $res = $params{'res'};
 488                 my $dev = $res->{'device'};
 489                 if (exists($params{'search_result'})) {
 490                     print STDERR " found in slot $res->{'this_slot'}:";
 491                 }
 492                 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
 493                     my $volume_label = $res->{device}->volume_label;
 494                     if ($params{'active'}) {
 495                         print STDERR " volume '$volume_label' is still active and cannot be overwritten\n";
 496                     } elsif ($params{'does_not_match_labelstr'}) {
 497                         print STDERR " volume '$volume_label' does not match labelstr '$params{'labelstr'}'\n";
 498                     } elsif ($params{'not_in_tapelist'}) {
 499                         print STDERR " volume '$volume_label' is not in the tapelist\n"
 500                     } else {
 501                         print STDERR " volume '$volume_label'\n";
 502                     }
 503                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
 504                          $dev->volume_header and
 505                          $dev->volume_header->{'type'} == $Amanda::Header::F_EMPTY) {
 506                     print STDERR " contains an empty volume\n";
 507                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
 508                          $dev->volume_header and
 509                          $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
 510                     print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
 511                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
 512                     my $message = $dev->error_or_status();
 513                     print STDERR " can't read label: $message\n";
 514                 } else {
 515                     my $errmsg = $res->{device}->error_or_status();
 516                     print STDERR " $errmsg\n";
 517                 }
 518             }
 519         } else {
 520             print STDERR "UNKNOWN\n";
 521         }
 522     };
 523
 524     return usage($finished_cb) unless (@args == 0);
 525     my $label = shift @args;
 526
 527     my $chg = load_changer($finished_cb) or return;
 528     my $interactivity = Amanda::Interactivity->new(name => 'tty');
 529     my $scan_name = getconf($CNF_TAPERSCAN);
 530     my $taperscan = Amanda::Taper::Scan->new(algorithm => $scan_name,
 531                                              changer => $chg,
 532                                              tapelist => $tl);
 533
 534     my $result_cb = make_cb(result_cb => sub {
 535         my ($err, $res, $label, $mode) = @_;
 536         if ($err) {
 537             $taperscan->quit() if defined $taperscan;
 538             return failure($err, $finished_cb);
 539         }
 540
 541         my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
 542         my $slot = $res->{'this_slot'};
 543         print STDERR "Will $modestr to volume $label in slot $slot.\n";
 544         $res->release(finished_cb => sub {
 545             my ($err) = @_;
 546             die "$err" if $err;
 547
 548             $taperscan->quit() if defined $taperscan;
 549             $finished_cb->();
 550         });
 551     });
 552
 553     $taperscan->scan(
 554         result_cb => $result_cb,
 555         user_msg_fn => $taper_user_msg_fn,
 556     );
 557 });
 558
 559 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
 560 sub {
 561     my ($finished_cb, @args) = @_;
 562     my @changed_args;
 563
 564     my $chg = load_changer($finished_cb) or return;
 565
 566     if (@args) {
 567         @changed_args = (changed => shift @args);
 568     }
 569     $chg->update(@changed_args,
 570         user_msg_fn => sub {
 571             print STDERR "$_[0]\n";
 572         },
 573         finished_cb => sub {
 574             my ($err) = @_;
 575             return failure($err, $finished_cb) if $err;
 576
 577             print STDERR "update complete\n";
 578             $chg->quit();
 579             $finished_cb->();
 580         });
 581 });
 582
 583 ##
 584 # Utilities
 585
 586 sub load_changer {
 587     my ($finished_cb) = @_;
 588
 589     my $chg = Amanda::Changer->new(undef, tapelist => $tl);
 590     return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
 591     return $chg;
 592 }
 593
 594 sub failure {
 595     my ($msg, $finished_cb) = @_;
 596     print STDERR "ERROR: $msg\n";
 597     $exit_status = 1;
 598     $finished_cb->();
 599 }
 600
 601 # show the slot contents in the old-fashioned format
 602 sub show_slot {
 603     my ($res) = @_;
 604
 605     printf STDERR "slot %3s: ", $res->{'this_slot'};
 606     my $dev = $res->{'device'};
 607     if ($dev->status != $DEVICE_STATUS_SUCCESS) {
 608         print STDERR "Could not open device: "
 609                 . $dev->error_or_status() . "\n";
 610         return;
 611     }
 612
 613     printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
 614 }
 615
 616 ##
 617 # main
 618
 619 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
 620
 621 my $config_overrides = new_config_overrides($#ARGV+1);
 622
 623 Getopt::Long::Configure(qw(bundling));
 624 GetOptions(
 625     'help|usage|?' => \&usage,
 626     'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
 627 ) or usage();
 628
 629 usage() if (@ARGV < 1);
 630
 631 my $config_name = shift @ARGV;
 632 set_config_overrides($config_overrides);
 633 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
 634 my ($cfgerr_level, @cfgerr_errors) = config_errors();
 635 if ($cfgerr_level >= $CFGERR_WARNINGS) {
 636     config_print_errors();
 637     if ($cfgerr_level >= $CFGERR_ERRORS) {
 638         die("errors processing config file");
 639     }
 640 }
 641
 642 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 643
 644 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
 645 $tl = Amanda::Tapelist->new($tlf);
 646
 647 #make STDOUT not line buffered
 648 my $previous_fh = select(STDOUT);
 649 $| = 1;
 650 select($previous_fh);
 651
 652 sub main {
 653     my ($finished_cb) = @_;
 654
 655     my $steps = define_steps
 656         cb_ref => \$finished_cb;
 657
 658     step start => sub {
 659         my $subcmd = shift @ARGV;
 660         return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
 661         invoke_subcommand($subcmd, $finished_cb, @ARGV);
 662     }
 663 }
 664
 665 main(\&Amanda::MainLoop::quit);
 666 Amanda::MainLoop::run();
 667 Amanda::Util::finish_application();
 668 exit($exit_status);