lintian doesn't like orphan packages with uploaders...
[debian/amanda] / server-src / amtape.pl
index 4c8cd36c46c3d11cb1f1300ebc8f05fd20478e14..7a83996dd7f3ab224f2a0be07f099ab1bed7d350 100644 (file)
@@ -1,9 +1,10 @@
 #! @PERL@
-# Copyright (c) 2009, 2010 Zmanda, Inc.  All Rights Reserved.
+# Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
 #
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License version 2 as published
-# by the Free Software Foundation.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
 #
 # This program is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
@@ -148,17 +149,39 @@ sub {
        });
 });
 
-subcommand("show", "show", "scan all slots in the changer, starting with the current slot",
+subcommand("show", "show [<slots>]", "scan all slots (or listed slots) in the changer, starting with the current slot",
 sub {
     my ($finished_cb, @args) = @_;
     my $last_slot;
     my %seen_slots;
     my $chg;
 
-    if (@args != 0) {
+    if (@args > 1) {
        return usage($finished_cb);
     }
 
+    my $what = $args[0];
+    my @slots;
+
+    if (defined $what) {
+       my @what1 = split /,/, $what;
+       foreach my $what1 (@what1) {
+           if ($what1 =~ /^(\d*)-(\d*)$/) {
+               my $begin = $1;
+               my $end = $2;
+               $end = $begin if $begin > $end;
+               while ($begin <= $end) {
+                   push @slots, $begin;
+                   $begin++;
+               }
+           } else {
+               push @slots, $what1;
+           }
+       }
+    }
+
+    my $use_slots = @slots > 0;
+
     $chg = load_changer($finished_cb) or return;
 
     my $steps = define_steps
@@ -173,13 +196,19 @@ sub {
        my ($err, %info) = @_;
        return failure($err, $finished_cb) if $err;
 
-       print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
+       if ($use_slots) {
+          my $slot = shift @slots;
+          $chg->load(slot => $slot,
+                     mode => "read",
+                     res_cb => $steps->{'loaded'});
 
-       $steps->{'load_current'}->();
-    };
+       } else {
+           print STDERR "amtape: scanning all $info{num_slots} slots in changer:\n";
 
-    step load_current => sub {
-       $chg->load(relative_slot => 'current', mode => "read", res_cb => $steps->{'loaded'});
+           $chg->load(relative_slot => 'current',
+                      mode => "read",
+                      res_cb => $steps->{'loaded'});
+       }
     };
 
     step loaded => sub {
@@ -191,6 +220,10 @@ sub {
                return;
            } elsif ($err->volinuse and defined $err->{'slot'}) {
                $last_slot = $err->{'slot'};
+               print STDERR sprintf("slot %3s: in use\n", $last_slot);
+           } elsif ($err->empty and defined $err->{'slot'}) {
+               $last_slot = $err->{'slot'};
+               print STDERR sprintf("slot %3s: empty\n", $last_slot);
            } else {
                return failure($err, $finished_cb) if $err;
            }
@@ -212,8 +245,6 @@ sub {
            } else {
                print STDERR sprintf("slot %3s: %s\n", $last_slot, $dev->error_or_status());
            }
-       } else {
-           print STDERR sprintf("slot %3s: in use\n", $last_slot);
        }
 
        if ($res) {
@@ -224,8 +255,19 @@ sub {
     };
 
     step released => sub {
-       $chg->load(relative_slot => 'next', slot => $last_slot,
-                  except_slots => { %seen_slots }, res_cb => $steps->{'loaded'});
+       if ($use_slots) {
+          return $finished_cb->() if @slots == 0;
+          my $slot = shift @slots;
+          $chg->load(slot => $slot,
+                     mode => "read",
+                     res_cb => $steps->{'loaded'});
+
+       } else {
+           $chg->load(relative_slot => 'next',
+                      slot => $last_slot,
+                      except_slots => { %seen_slots },
+                      res_cb => $steps->{'loaded'});
+       }
     };
 });
 
@@ -260,6 +302,7 @@ sub {
 
        for my $sl (@$inv) {
            my $line = "slot $sl->{slot}:";
+           my $tle;
            if (!defined($sl->{device_status}) && !defined($sl->{label})) {
                $line .= " unknown state";
            } elsif ($sl->{'state'} == Amanda::Changer::SLOT_EMPTY) {
@@ -267,14 +310,20 @@ sub {
            } else {
                if (defined $sl->{label}) {
                    $line .= " label $sl->{label}";
-                   my $tle = $tl->lookup_tapelabel($sl->{label});
-                   if ($tle->{'meta'}) {
-                       $line .= " ($tle->{'meta'})";
+                   $tle = $tl->lookup_tapelabel($sl->{label});
+                   if (defined $tle) {
+                       if ($tle->{'meta'}) {
+                               $line .= " ($tle->{'meta'})";
+                       }
                    }
                } elsif ($sl->{'device_status'} == $DEVICE_STATUS_VOLUME_UNLABELED) {
                    $line .= " blank";
                } elsif ($sl->{'device_status'} != $DEVICE_STATUS_SUCCESS) {
-                   $line .= "device error";
+                   if (defined $sl->{'device_error'}) {
+                       $line .= " " . $sl->{'device_error'};
+                   } else {
+                       $line .= "device error";
+                   }
                } elsif ($sl->{'f_type'} != $Amanda::Header::F_TAPESTART) {
                    $line .= " blank";
                } else {
@@ -296,6 +345,13 @@ sub {
            if ($sl->{'current'}) {
                $line .= " (current)";
            }
+           if (defined $tle) {
+               if (defined $sl->{'barcode'} and
+                   defined $tle->{'barcode'} and
+                   $sl->{'barcode'} ne $tle->{'barcode'}) {
+               $line .= " MISTMATCH barcode in tapelist: $tle->{'barcode'}";
+               }
+           }
 
            # note that inventory goes to stdout
            print "$line\n";
@@ -507,7 +563,12 @@ sub {
                } elsif ($dev->status & $DEVICE_STATUS_VOLUME_UNLABELED and
                         $dev->volume_header and
                         $dev->volume_header->{'type'} == $Amanda::Header::F_WEIRD) {
-                   print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
+                   my $autolabel = getconf($CNF_AUTOLABEL);
+                   if ($autolabel->{'non_amanda'}) {
+                       print STDERR " contains a non-Amanda volume\n";
+                   } else {
+                       print STDERR " contains a non-Amanda volume; check and relabel it with 'amlabel -f'\n";
+                   }
                } elsif ($dev->status & $DEVICE_STATUS_VOLUME_ERROR) {
                    my $message = $dev->error_or_status();
                    print STDERR " can't read label: $message\n";
@@ -534,13 +595,30 @@ sub {
     my $result_cb = make_cb(result_cb => sub {
        my ($err, $res, $label, $mode) = @_;
        if ($err) {
-           $taperscan->quit() if defined $taperscan;
-           return failure($err, $finished_cb);
+           if ($res) {
+               $res->release(finished_cb => sub {
+                   $taperscan->quit() if defined $taperscan;
+                   return failure($err, $finished_cb);
+               });
+               return;
+           } else {
+               $taperscan->quit() if defined $taperscan;
+               return failure($err, $finished_cb);
+           }
        }
 
        my $modestr = ($mode == $ACCESS_APPEND)? "append" : "write";
        my $slot = $res->{'this_slot'};
-       print STDERR "Will $modestr to volume $label in slot $slot.\n";
+       if (defined $res->{'device'} and defined $res->{'device'}->volume_label()) {
+           print STDERR "Will $modestr to volume '$label' in slot $slot.\n";
+       } else {
+           my $header = $res->{'device'}->volume_header();
+           if ($header->{'type'} == $Amanda::Header::F_WEIRD) {
+               print STDERR "Will $modestr label '$label' to non-Amanda volume in slot $slot.\n";
+           } else {
+               print STDERR "Will $modestr label '$label' to new volume in slot $slot.\n";
+           }
+       }
        $res->release(finished_cb => sub {
            my ($err) = @_;
            die "$err" if $err;
@@ -572,10 +650,10 @@ sub {
        },
        finished_cb => sub {
            my ($err) = @_;
+           $chg->quit();
            return failure($err, $finished_cb) if $err;
 
            print STDERR "update complete\n";
-           $chg->quit();
            $finished_cb->();
        });
 });
@@ -593,7 +671,11 @@ sub load_changer {
 
 sub failure {
     my ($msg, $finished_cb) = @_;
-    print STDERR "ERROR: $msg\n";
+    if ($msg->isa("Amanda::Changer::Error") and defined $msg->{'slot'}) {
+       print STDERR "ERROR: Slot: $msg->{'slot'}: $msg\n";
+    } else {
+       print STDERR "ERROR: $msg\n";
+    }
     $exit_status = 1;
     $finished_cb->();
 }
@@ -620,8 +702,10 @@ Amanda::Util::setup_application("amtape", "server", $CONTEXT_CMDLINE);
 
 my $config_overrides = new_config_overrides($#ARGV+1);
 
+debug("Arguments: " . join(' ', @ARGV));
 Getopt::Long::Configure(qw(bundling));
 GetOptions(
+    'version' => \&Amanda::Util::version_opt,
     'help|usage|?' => \&usage,
     'o=s' => sub { add_config_override_opt($config_overrides, $_[1]); },
 ) or usage();