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