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 [<slots>]", "scan all slots (or listed 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 > 1) {
 159         return usage($finished_cb);
 160     }
 161
 162     my $what = $args[0];
 163     my @slots;
 164
 165     if (defined $what) {
 166         my @what1 = split /,/, $what;
 167         foreach my $what1 (@what1) {
 168             if ($what1 =~ /^(\d*)-(\d*)$/) {
 169                 my $begin = $1;
 170                 my $end = $2;
 171                 $end = $begin if $begin > $end;
 172                 while ($begin <= $end) {
 173                     push @slots, $begin;
 174                     $begin++;
 175                 }
 176             } else {
 177                 push @slots, $what1;
 178             }
 179         }
 180     }
 181
 182     my $use_slots = @slots > 0;
 183
 184     $chg = load_changer($finished_cb) or return;
 185
 186     my $steps = define_steps
 187         cb_ref => \$finished_cb,
 188         finalize => sub { $chg->quit() if defined $chg };
 189
 190     step start => sub {
 191         $chg->info(info => [ 'num_slots' ], info_cb => $steps->{'info_cb'});
 192     };
 193
 194     step info_cb => sub {
 195         my ($err, %info) = @_;
 196         return failure($err, $finished_cb) if $err;
 197
 198         if ($use_slots) {
 199            my $slot = shift @slots;
 200            $chg->load(slot => $slot,
 201                       mode => "read",
 202                       res_cb => $steps->{'loaded'});
 203
 204         } else {
 205             print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
 206
 207             $chg->load(relative_slot => 'current',
 208                        mode => "read",
 209                        res_cb => $steps->{'loaded'});
 210         }
 211     };
 212
 213     step loaded => sub {
 214         my ($err, $res) = @_;
 215         if ($err) {
 216             if ($err->notfound) {
 217                 # no more interesting slots
 218                 $finished_cb->();
 219                 return;
 220             } elsif ($err->volinuse and defined $err->{'slot'}) {
 221                 $last_slot = $err->{'slot'};
 222             } else {
 223                 return failure($err, $finished_cb) if $err;
 224             }
 225         } else {
 226             $last_slot = $res->{'this_slot'};
 227         }
 228
 229         $seen_slots{$last_slot} = 1;
 230
 231         if ($res) {
 232             my $dev = $res->{'device'};
 233             my $st = $dev->read_label();
 234             if ($st == $DEVICE_STATUS_SUCCESS) {
 235                 print STDERR sprintf("slot %3s: date %-14s label %s\n",
 236                         $last_slot, $dev->volume_time(),
 237                         $dev->volume_label());
 238             } elsif ($st == $DEVICE_STATUS_VOLUME_UNLABELED) {
 239                 print STDERR sprintf("slot %3s: unlabeled volume\n", $last_slot);
 240             } else {
 241                 print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
 242             }
 243         } else {
 244             print STDERR sprintf("slot %3s: in use\n", $last_slot);
 245         }
 246
 247         if ($res) {
 248             $res->release(finished_cb => $steps->{'released'});
 249         } else {
 250             $steps->{'released'}->();
 251         }
 252     };
 253
 254     step released => sub {
 255         if ($use_slots) {
 256            return $finished_cb->() if @slots == 0;
 257            my $slot = shift @slots;
 258            $chg->load(slot => $slot,
 259                       mode => "read",
 260                       res_cb => $steps->{'loaded'});
 261
 262         } else {
 263             $chg->load(relative_slot => 'next',
 264                        slot => $last_slot,
 265                        except_slots => { %seen_slots },
 266                        res_cb => $steps->{'loaded'});
 267         }
 268     };
 269 });
 270
 271 subcommand("inventory", "inventory", "show inventory of changer slots",
 272 sub {
 273     my ($finished_cb, @args) = @_;
 274
 275     my $chg = load_changer($finished_cb) or return;
 276
 277     if (@args != 0) {
 278         return usage($finished_cb);
 279     }
 280
 281     # TODO -- support an --xml option
 282
 283     my $inventory_cb = make_cb(inventory_cb => sub {
 284         my ($err, $inv) = @_;
 285         if ($err) {
 286             if ($err->notimpl) {
 287                 if ($err->{'message'}) {
 288                     print STDERR "inventory not supported by this changer: $err->{'message'}\n";
 289                 } else {
 290                     print STDERR "inventory not supported by this changer\n";
 291                 }
 292             } else {
 293                 print STDERR "$err\n";
 294             }
 295
 296             $chg->quit();
 297             return $finished_cb->();
 298         }
 299
 300         for my $sl (@$inv) {
 301             my $line = "slot $sl->{slot}:";
 302             if (!defined($sl->{device_status}) && !defined($sl->{label})) {
 303                 $line .= " unknown state";
 304             } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
 305                 $line .= " empty";
 306             } else {
 307                 if (defined $sl->{label}) {
 308                     $line .= " label $sl->{label}";
 309                     my $tle = $tl->lookup_tapelabel($sl->{label});
 310                     if ($tle->{'meta'}) {
 311                         $line .= " ($tle->{'meta'})";
 312                     }
 313                 } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
 314                     $line .= " blank";
 315                 } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
 316                     if (defined $sl->{'device_error'}) {
 317                         $line .= " " . $sl->{'device_error'};
 318                     } else {
 319                         $line .= "device error";
 320                     }
 321                 } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
 322                     $line .= " blank";
 323                 } else {
 324                     $line .= " unknown";
 325                 }
 326             }
 327             if ($sl->{'barcode'}) {
 328                 $line .= " barcode $sl->{barcode}";
 329             }
 330             if ($sl->{'reserved'}) {
 331                 $line .= " reserved";
 332             }
 333             if (defined $sl->{'loaded_in'}) {
 334                 $line .= " (in drive $sl->{'loaded_in'})";
 335             }
 336             if ($sl->{'import_export'}) {
 337                 $line .= " (import/export slot)";
 338             }
 339             if ($sl->{'current'}) {
 340                 $line .= " (current)";
 341             }
 342
 343             # note that inventory goes to stdout
 344             print "$line\n";
 345         }
 346
 347         $chg->quit();
 348         $finished_cb->();
 349     });
 350     $chg->inventory(inventory_cb => $inventory_cb);
 351 });
 352
 353 subcommand("current", "current", "load and show the contents of the current slot",
 354 sub {
 355     my ($finished_cb, @args) = @_;
 356
 357     return usage($finished_cb) if @args;
 358
 359     # alias for 'slot current'
 360     return invoke_subcommand("slot", $finished_cb, "current");
 361 });
 362
 363 subcommand("slot", "slot <slot>",
 364            "load the volume in slot <slot>; <slot> can also be 'current', 'next', 'first', or 'last'",
 365 sub {
 366     my ($finished_cb, @args) = @_;
 367     my @slotarg;
 368     my $chg;
 369
 370     my $steps = define_steps
 371         cb_ref => \$finished_cb,
 372         finalize => sub { $chg->quit() if defined $chg };
 373
 374     # NOTE: the syntax of this subcommand precludes actual slots named
 375     # 'current' or 'next' ..  when we have a changer using such slot names,
 376     # this subcommand will need to support a --literal flag
 377
 378     return usage($finished_cb) unless (@args == 1);
 379     my $slot = shift @args;
 380
 381     $chg = load_changer($finished_cb) or return;
 382
 383     step get_slot => sub {
 384         if ($slot eq 'current' or $slot eq 'next') {
 385             @slotarg = (relative_slot => $slot);
 386         } elsif ($slot eq 'first' or $slot eq 'last') {
 387             return $chg->inventory(inventory_cb => $steps->{'inventory_cb'});
 388         } else {
 389             @slotarg = (slot => $slot);
 390         }
 391
 392         $steps->{'do_load'}->();
 393     };
 394
 395     step inventory_cb => sub {
 396         my ($err, $inv) = @_;
 397         if ($err) {
 398             if ($err->failed and $err->notimpl) {
 399                 return failed("This changer does not support special slot '$slot'");
 400             } else {
 401                 return failed($err);
 402             }
 403         }
 404
 405         if ($slot eq 'first') {
 406             @slotarg = (slot => $inv->[0]->{'slot'});
 407         } else {
 408             @slotarg = (slot => $inv->[-1]->{'slot'});
 409         }
 410
 411         $steps->{'do_load'}->();
 412     };
 413
 414     step do_load => sub {
 415         $chg->load(@slotarg, set_current => 1,
 416             res_cb => $steps->{'done_load'});
 417     };
 418
 419     step done_load => sub {
 420         my ($err, $res) = @_;
 421         return failure($err, $finished_cb) if ($err);
 422
 423         show_slot($res);
 424         my $gotslot = $res->{'this_slot'};
 425         print STDERR "changed to slot $gotslot\n";
 426
 427         $res->release(finished_cb => $steps->{'released'});
 428     };
 429
 430     step released => sub {
 431         my ($err) = @_;
 432         return failure($err, $finished_cb) if ($err);
 433
 434         $finished_cb->();
 435     };
 436 });
 437
 438 subcommand("label", "label <label>", "load the volume with label <label>",
 439 sub {
 440     my ($finished_cb, @args) = @_;
 441     my $interactivity;
 442     my $scan;
 443     my $chg;
 444
 445     return usage($finished_cb) unless (@args == 1);
 446     my $label = shift @args;
 447
 448     my $steps = define_steps
 449         cb_ref => \$finished_cb,
 450         finalize => sub { $scan->quit() if defined $scan;
 451                           $chg->quit() if defined $chg };
 452
 453     step start => sub {
 454         my $_user_msg_fn = sub {
 455             my %params = @_;
 456
 457             if (exists($params{'scan_slot'})) {
 458                 print "slot $params{'slot'}:";
 459             } elsif (exists($params{'slot_result'})) {
 460                 if (defined($params{'err'})) {
 461                     print " $params{'err'}\n";
 462                 } else { # res must be defined
 463                     my $res = $params{'res'};
 464                     my $dev = $res->{'device'};
 465                     if ($dev->status == $DEVICE_STATUS_SUCCESS) {
 466                         my $volume_label = $res->{device}->volume_label;
 467                         print " $volume_label\n";
 468                     } else {
 469                         my $errmsg = $res->{device}->error_or_status();
 470                         print " $errmsg\n";
 471                     }
 472                 }
 473             }
 474         };
 475
 476         $interactivity = Amanda::Interactivity->new(name => 'stdin');
 477         $chg = load_changer($finished_cb) or return;
 478         $scan = Amanda::Recovery::Scan->new(chg => $chg,
 479                                             interactivity => $interactivity);
 480         return failure("$scan", $finished_cb)
 481             if ($scan->isa("Amanda::Changer::Error"));
 482
 483         $scan->find_volume(label  => $label,
 484                            res_cb => $steps->{'done_load'},
 485                            user_msg_fn => $_user_msg_fn,
 486                            set_current => 1);
 487     };
 488
 489     step done_load => sub {
 490         my ($err, $res) = @_;
 491         return failure($err, $finished_cb) if ($err);
 492
 493         my $gotslot = $res->{'this_slot'};
 494         my $devname = $res->{'device'}->device_name;
 495         show_slot($res);
 496         print STDERR "label $label is now loaded from slot $gotslot\n";
 497
 498         $res->release(finished_cb => $steps->{'released'});
 499     };
 500
 501     step released => sub {
 502         my ($err) = @_;
 503         return failure($err, $finished_cb) if ($err);
 504
 505         $finished_cb->();
 506     };
 507 });
 508
 509 subcommand("taper", "taper", "perform the taperscan algorithm and display the result",
 510 sub {
 511     my ($finished_cb, @args) = @_;
 512
 513     my $taper_user_msg_fn = sub {
 514         my %params = @_;
 515         if (exists($params{'text'})) {
 516             print STDERR "$params{'text'}\n";
 517         } elsif (exists($params{'scan_slot'})) {
 518             print STDERR "slot $params{'slot'}:";
 519         } elsif (exists($params{'search_label'})) {
 520             print STDERR "Searching for label '$params{'label'}':";
 521         } elsif (exists($params{'slot_result'}) ||
 522                  exists($params{'search_result'})) {
 523             if (defined($params{'err'})) {
 524                 if (exists($params{'search_result'}) &&
 525                     defined($params{'err'}->{'slot'})) {
 526                     print STDERR "slot $params{'err'}->{'slot'}:";
 527                 }
 528                 print STDERR " $params{'err'}\n";
 529             } else { # res must be defined
 530                 my $res = $params{'res'};
 531                 my $dev = $res->{'device'};
 532                 if (exists($params{'search_result'})) {
 533                     print STDERR " found in slot $res->{'this_slot'}:";
 534                 }
 535                 if ($dev->status == $DEVICE_STATUS_SUCCESS) {
 536                     my $volume_label = $res->{device}->volume_label;
 537                     if ($params{'active'}) {
 538                         print STDERR " volume '$volume_label' is still active and cannot be overwritten\n";
 539                     } elsif ($params{'does_not_match_labelstr'}) {
 540                         print STDERR " volume '$volume_label' does not match labelstr '$params{'labelstr'}'\n";
 541                     } elsif ($params{'not_in_tapelist'}) {
 542                         print STDERR " volume '$volume_label' is not in the tapelist\n"
 543                     } else {
 544                         print STDERR " volume '$volume_label'\n";
 545                     }
 546                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
 547                          $dev->volume_header and
 548                          $dev->volume_header->{'type'} == $Amanda::Header::F_EMPTY) {
 549                     print STDERR " contains an empty volume\n";
 550                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
 551                          $dev->volume_header and
 552                          $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
 553                     print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
 554                 } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
 555                     my $message = $dev->error_or_status();
 556                     print STDERR " can't read label: $message\n";
 557                 } else {
 558                     my $errmsg = $res->{device}->error_or_status();
 559                     print STDERR " $errmsg\n";
 560                 }
 561             }
 562         } else {
 563             print STDERR "UNKNOWN\n";
 564         }
 565     };
 566
 567     return usage($finished_cb) unless (@args == 0);
 568     my $label = shift @args;
 569
 570     my $chg = load_changer($finished_cb) or return;
 571     my $interactivity = Amanda::Interactivity->new(name => 'tty');
 572     my $scan_name = getconf($CNF_TAPERSCAN);
 573     my $taperscan = Amanda::Taper::Scan->new(algorithm => $scan_name,
 574                                              changer => $chg,
 575                                              tapelist => $tl);
 576
 577     my $result_cb = make_cb(result_cb => sub {
 578         my ($err, $res, $label, $mode) = @_;
 579         if ($err) {
 580             if ($res) {
 581                 $res->release(finished_cb => sub {
 582                     $taperscan->quit() if defined $taperscan;
 583                     return failure($err, $finished_cb);
 584                 });
 585                 return;
 586             } else {
 587                 $taperscan->quit() if defined $taperscan;
 588                 return failure($err, $finished_cb);
 589             }
 590         }
 591
 592         my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
 593         my $slot = $res->{'this_slot'};
 594         if (defined $res->{'device'} and defined $res->{'device'}->volume_label()) {
 595             print STDERR "Will $modestr to volume '$label' in slot $slot.\n";
 596         } else {
 597             print STDERR "Will $modestr label '$label' to new volume in slot $slot.\n";
 598         }
 599         $res->release(finished_cb => sub {
 600             my ($err) = @_;
 601             die "$err" if $err;
 602
 603             $taperscan->quit() if defined $taperscan;
 604             $finished_cb->();
 605         });
 606     });
 607
 608     $taperscan->scan(
 609         result_cb => $result_cb,
 610         user_msg_fn => $taper_user_msg_fn,
 611     );
 612 });
 613
 614 subcommand("update", "update [WHAT]", "update the changer's state; see changer docs for syntax of WHAT",
 615 sub {
 616     my ($finished_cb, @args) = @_;
 617     my @changed_args;
 618
 619     my $chg = load_changer($finished_cb) or return;
 620
 621     if (@args) {
 622         @changed_args = (changed => shift @args);
 623     }
 624     $chg->update(@changed_args,
 625         user_msg_fn => sub {
 626             print STDERR "$_[0]\n";
 627         },
 628         finished_cb => sub {
 629             my ($err) = @_;
 630             $chg->quit();
 631             return failure($err, $finished_cb) if $err;
 632
 633             print STDERR "update complete\n";
 634             $finished_cb->();
 635         });
 636 });
 637
 638 ##
 639 # Utilities
 640
 641 sub load_changer {
 642     my ($finished_cb) = @_;
 643
 644     my $chg = Amanda::Changer->new(undef, tapelist => $tl);
 645     return failure($chg, $finished_cb) if ($chg->isa("Amanda::Changer::Error"));
 646     return $chg;
 647 }
 648
 649 sub failure {
 650     my ($msg, $finished_cb) = @_;
 651     print STDERR "ERROR: $msg\n";
 652     $exit_status = 1;
 653     $finished_cb->();
 654 }
 655
 656 # show the slot contents in the old-fashioned format
 657 sub show_slot {
 658     my ($res) = @_;
 659
 660     printf STDERR "slot %3s: ", $res->{'this_slot'};
 661     my $dev = $res->{'device'};
 662     if ($dev->status != $DEVICE_STATUS_SUCCESS) {
 663         print STDERR "Could not open device: "
 664                 . $dev->error_or_status() . "\n";
 665         return;
 666     }
 667
 668     printf STDERR "time %-14s label %s\n", $dev->volume_time, $dev->volume_label;
 669 }
 670
 671 ##
 672 # main
 673
 674 Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
 675
 676 my $config_overrides = new_config_overrides($#ARGV+1);
 677
 678 debug("Arguments: " . join(' ', @ARGV));
 679 Getopt::Long::Configure(qw(bundling));
 680 GetOptions(
 681     'version' => \&Amanda::Util::version_opt,
 682     'help|usage|?' => \&usage,
 683     'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
 684 ) or usage();
 685
 686 usage() if (@ARGV < 1);
 687
 688 my $config_name = shift @ARGV;
 689 set_config_overrides($config_overrides);
 690 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
 691 my ($cfgerr_level, @cfgerr_errors) = config_errors();
 692 if ($cfgerr_level >= $CFGERR_WARNINGS) {
 693     config_print_errors();
 694     if ($cfgerr_level >= $CFGERR_ERRORS) {
 695         die("errors processing config file");
 696     }
 697 }
 698
 699 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 700
 701 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
 702 $tl = Amanda::Tapelist->new($tlf);
 703
 704 #make STDOUT not line buffered
 705 my $previous_fh = select(STDOUT);
 706 $| = 1;
 707 select($previous_fh);
 708
 709 sub main {
 710     my ($finished_cb) = @_;
 711
 712     my $steps = define_steps
 713         cb_ref => \$finished_cb;
 714
 715     step start => sub {
 716         my $subcmd = shift @ARGV;
 717         return usage($finished_cb) unless defined($subcmd) and exists ($subcommands{$subcmd});
 718         invoke_subcommand($subcmd, $finished_cb, @ARGV);
 719     }
 720 }
 721
 722 main(\&Amanda::MainLoop::quit);
 723 Amanda::MainLoop::run();
 724 Amanda::Util::finish_application();
 725 exit($exit_status);