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