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 [-o configoption]* <conf> <command> {<args>}
  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->{'state'} == 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_VOLUME_UNLABELED) {
 267                     $line .= " blank";
 268                 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
 269                     $line .= "device error";
 270                 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
 271                     $line .= " blank";
 272                 } else {
 273                     $line .= " unknown";
 274                 }
 275             }
 276             if ($sl->{'barcode'}) {
 277                 $line .= " barcode $sl->{barcode}";
 278             }
 279             if ($sl->{'reserved'}) {
 280                 $line .= " reserved";
 281             }
 282             if (defined $sl->{'loaded_in'}) {
 283                 $line .= " (in drive $sl->{'loaded_in'})";
 284             }
 285             if ($sl->{'import_export'}) {
 286                 $line .= " (import/export slot)";
 287             }
 288
 289             # note that inventory goes to stdout
 290             print "$line\n";
 291         }
 292
 293         $finished_cb->();
 294     });
 295     $chg->inventory(inventory_cb => $inventory_cb);
 296 });
 297
 298 subcommand("current", "current", "load and show the contents of the current slot",
 299 sub {
 300     my ($finished_cb, @args) = @_;
 301
 302     return usage($finished_cb) if @args;
 303
 304     # alias for 'slot current'
 305     return invoke_subcommand("slot", $finished_cb, "current");
 306 });
 307
 308 subcommand("slot", "slot <slot>",
 309            "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
 310 sub {
 311     my ($finished_cb, @args) = @_;
 312     my @slotarg;
 313     my $gres;
 314
 315     my $steps = define_steps
 316         cb_ref => \$finished_cb;
 317
 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
 321
 322     return usage($finished_cb) unless (@args == 1);
 323     my $slot = shift @args;
 324
 325     my $chg = load_changer($finished_cb) or return;
 326
 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'});
 332         } else {
 333             @slotarg = (slot => $slot);
 334         }
 335
 336         $steps->{'do_load'}->();
 337     };
 338
 339     step inventory_cb => sub {
 340         my ($err, $inv) = @_;
 341         if ($err) {
 342             if ($err->failed and $err->notimpl) {
 343                 return failed("This changer does not support special slot '$slot'");
 344             } else {
 345                 return failed($err);
 346             }
 347         }
 348
 349         if ($slot eq 'first') {
 350             @slotarg = (slot => $inv->[0]->{'slot'});
 351         } else {
 352             @slotarg = (slot => $inv->[-1]->{'slot'});
 353         }
 354
 355         $steps->{'do_load'}->();
 356     };
 357
 358     step do_load => sub {
 359         $chg->load(@slotarg, set_current => 1,
 360             res_cb => $steps->{'done_load'});
 361     };
 362
 363     step done_load => sub {
 364         my ($err, $res) = @_;
 365         return failure($err, $finished_cb) if ($err);
 366
 367         show_slot($res);
 368         my $gotslot = $res->{'this_slot'};
 369         print STDERR "changed to slot $gotslot\n";
 370
 371         if ($res->{device}->volume_label) {
 372             $gres = $res;
 373             $res->set_label(label => $res->{device}->volume_label(),
 374                             finished_cb => $steps->{'set_labeled'});
 375         } else {
 376             $res->release(finished_cb => $steps->{'released'});
 377         }
 378     };
 379
 380     step set_labeled => sub {
 381         $gres->release(finished_cb => $steps->{'released'});
 382     };
 383
 384     step released => sub {
 385         my ($err) = @_;
 386         return failure($err, $finished_cb) if ($err);
 387
 388         $finished_cb->();
 389     };
 390 });
 391
 392 subcommand("label", "label <label>", "load the volume with label <label>",
 393 sub {
 394     my ($finished_cb, @args) = @_;
 395     my $gres;
 396     my $inter;
 397     my $scan;
 398
 399     return usage($finished_cb) unless (@args == 1);
 400     my $label = shift @args;
 401
 402     my $steps = define_steps
 403         cb_ref => \$finished_cb;
 404
 405     step start => sub {
 406         my $_user_msg_fn = sub {
 407             my %params = @_;
 408
 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";
 420                     } else {
 421                         my $errmsg = $res->{device}->error_or_status();
 422                         print " $errmsg\n";
 423                     }
 424                 }
 425             }
 426         };
 427
 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"));
 432
 433         $scan->find_volume(label  => $label,
 434                            res_cb => $steps->{'done_load'},
 435                            user_msg_fn => $_user_msg_fn,
 436                            set_current => 1);
 437     };
 438
 439     step done_load => sub {
 440         my ($err, $res) = @_;
 441         return failure($err, $finished_cb) if ($err);
 442
 443         my $gotslot = $res->{'this_slot'};
 444         my $devname = $res->{'device'}->device_name;
 445         show_slot($res);
 446         print STDERR "label $label is now loaded from slot $gotslot\n";
 447
 448         if ($res->{device}->volume_label) {
 449             $gres = $res;
 450             $res->set_label(label => $res->{device}->volume_label(),
 451                             finished_cb => $steps->{'set_labeled'});
 452         } else {
 453             $res->release(finished_cb => $steps->{'released'});
 454         }
 455     };
 456
 457     step set_labeled => sub {
 458         $gres->release(finished_cb => $steps->{'released'});
 459     };
 460
 461     step released => sub {
 462         my ($err) = @_;
 463         return failure($err, $finished_cb) if ($err);
 464
 465         $finished_cb->();
 466     };
 467 });
 468
 469 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
 470 sub {
 471     my ($finished_cb, @args) = @_;
 472
 473     my $taper_user_msg_fn = sub {
 474         my %params = @_;
 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'}:";
 487                 }
 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'}:";
 494                 }
 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"
 503                     } else {
 504                         print STDERR " volume '$volume_label'\n";
 505                     }
 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";
 517                 } else {
 518                     my $errmsg = $res->{device}->error_or_status();
 519                     print STDERR " $errmsg\n";
 520                 }
 521             }
 522         } else {
 523             print STDERR "UNKNOWN\n";
 524         }
 525     };
 526
 527     return usage($finished_cb) unless (@args == 0);
 528     my $label = shift @args;
 529
 530     my $chg = load_changer($finished_cb) or return;
 531
 532     my $result_cb = make_cb(result_cb => sub {
 533         my ($err, $res, $label, $mode) = @_;
 534         return failure($err, $finished_cb) if $err;
 535
 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 {
 540             my ($err) = @_;
 541             die "$err" if $err;
 542
 543             $finished_cb->();
 544         });
 545     });
 546
 547     my $taperscan = Amanda::Taper::Scan->new(changer => $chg);
 548     $taperscan->scan(
 549         result_cb => $result_cb,
 550         user_msg_fn => $taper_user_msg_fn,
 551     );
 552 });
 553
 554 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
 555 sub {
 556     my ($finished_cb, @args) = @_;
 557     my @changed_args;
 558
 559     my $chg = load_changer($finished_cb) or return;
 560
 561     if (@args) {
 562         @changed_args = (changed => shift @args);
 563     }
 564     $chg->update(@changed_args,
 565         user_msg_fn => sub {
 566             print STDERR "$_[0]\n";
 567         },
 568         finished_cb => sub {
 569             my ($err) = @_;
 570             return failure($err, $finished_cb) if $err;
 571
 572             print STDERR "update complete\n";
 573             $finished_cb->();
 574         });
 575 });
 576
 577 ##
 578 # Utilities
 579
 580 sub load_changer {
 581     my ($finished_cb) = @_;
 582
 583     my $chg = Amanda::Changer->new();
 584     return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
 585     return $chg;
 586 }
 587
 588 sub failure {
 589     my ($msg, $finished_cb) = @_;
 590     print STDERR "ERROR: $msg\n";
 591     $exit_status = 1;
 592     $finished_cb->();
 593 }
 594
 595 # show the slot contents in the old-fashioned format
 596 sub show_slot {
 597     my ($res) = @_;
 598
 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";
 604         return;
 605     }
 606
 607     printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
 608 }
 609
 610 ##
 611 # main
 612
 613 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
 614
 615 my $config_overrides = new_config_overrides($#ARGV+1);
 616
 617 Getopt::Long::Configure(qw(bundling));
 618 GetOptions(
 619     'help|usage|?' => \&usage,
 620     'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
 621 ) or usage();
 622
 623 usage() if (@ARGV < 1);
 624
 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");
 633     }
 634 }
 635
 636 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 637
 638 #make STDOUT not line buffered
 639 my $previous_fh = select(STDOUT);
 640 $| = 1;
 641 select($previous_fh);
 642
 643 sub main {
 644     my ($finished_cb) = @_;
 645
 646     my $steps = define_steps
 647         cb_ref => \$finished_cb;
 648
 649     step start => sub {
 650         my $subcmd = shift @ARGV;
 651         return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
 652         invoke_subcommand($subcmd, $finished_cb, @ARGV);
 653     }
 654 }
 655
 656 main(\&Amanda::MainLoop::quit);
 657 Amanda::MainLoop::run();
 658 Amanda::Util::finish_application();
 659 exit($exit_status);