git.gag.com Git - debian/amanda/blob - perl/Amanda/Changer/robot.pm

   1 # Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This library is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU Lesser General Public
   5 #* License as published by the Free Software Foundation; either
   6 # version 2.1 of the License, or (at your option) any later version.
   7 #
   8 # This library 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 Lesser General Public
  11 # License for more details.
  12 #
  13 # You should have received a copy of the GNU Lesser General Public License
  14 # along with this library; if not, write to the Free Software Foundation,
  15 # Inc., 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 package Amanda::Changer::robot;
  21
  22 use strict;
  23 use warnings;
  24 use Carp;
  25 use vars qw( @ISA );
  26 @ISA = qw( Amanda::Changer );
  27
  28 use Data::Dumper;
  29 use File::Path;
  30 use Amanda::Paths;
  31 use Amanda::Config qw( :init );
  32 use Amanda::MainLoop qw( :GIOCondition make_cb define_steps step );
  33 use Amanda::Config qw( :getconf );
  34 use Amanda::Debug qw( debug warning );
  35 use Amanda::Device qw( :constants );
  36 use Amanda::Changer;
  37 use Amanda::Constants;
  38
  39 =head1 NAME
  40
  41 Amanda::Changer::robot -- control a physical tape changer
  42
  43 =head1 DESCRIPTION
  44
  45 This package controls a physical tape changer via 'mtx'.
  46
  47 See the amanda-changers(7) manpage for usage information.
  48
  49 =cut
  50
  51 # NOTES
  52 #
  53 # This is one of the more sophisticated changers.  Here are some notes that may
  54 # help while reading the source code.
  55
  56 # STATE
  57 #
  58 # The device state is shared between all changers accessing the same library.
  59 # It is a hash with keys:
  60 #   slots - see below
  61 #   drives - see below
  62 #   drive_lru - recently used drives, least recent first
  63 #   bc2lb - hash mapping known barcodes to known labels
  64 #   current_slot - hash of the current slot
  65 #   last_operation_time - time the last operation finished
  66 #   last_operation_delay - required delay for that operation
  67 #   last_status - last time a 'status' command finished
  68 #
  69 # The 'slots' key is a hash, with slot numbers as keys and hashes
  70 # as values.  Each slot's hash has keys
  71 #   state - SLOT_FULL/SLOT_EMPTY/SLOT_UNKNOWN
  72 #   device_status - the status of the device
  73 #   device_error - the error message of the device
  74 #   f_type - The f_type of the header
  75 #   label - volume label, if known
  76 #   barcode - volume barcode, if available
  77 #   loaded_in - drive this volume is loaded in
  78 #   ie - 1 if this is an import/export slot
  79 # note that this state pretends that a tape physically located
  80 # in a tape drive is still located in its original slot.
  81 #
  82 # The 'drives' key is also a hash by drive numbere, the values of
  83 # which are hashes with keys
  84 #   state - SLOT_FULL/SLOT_EMPTY/SLOT_UNKNOWN
  85 #   label - volume label
  86 #   barcode - volume barcode
  87 #   orig_slot - slot from which this tape was loaded
  88 #
  89 ## The 'current_slot' key is also a hash by config name, the values of
  90 # which are the current slot for the config.
  91 # #
  92 # LOCKING
  93 #
  94 # This package uses Amanda::Changer's with_locked_state to lock a statefile and
  95 # load its contents.  Every time the state is locked, the package also
  96 # considers running 'status' to update the state; the status_interval protects
  97 # against running status too often.
  98 #
  99 # Each changer method has an "_unlocked" version that does the actual work, and
 100 # is called with an additional 'state' parameter containing the locked state.
 101 # This is particularly useful when the load method calls the eject method to
 102 # empty a drive that it wants to use.
 103
 104 # RESERVATIONS
 105 #
 106 # Reservations are currently represented by a PID in the state file.  If that
 107 # pid is no longer running, then the reservation is considered stale and is
 108 # discarded (with a warning).
 109 #
 110 # Reservation objects defer most of the interesting operations back to the
 111 # changer itself, since the operations require locked access to the state.
 112
 113 # INTERFACE
 114 #
 115 # All of the operating-system-specific functionality is abstracted into the
 116 # Interface class.  This is written in such a way that it could be replaced
 117 # by a direct SCSI interface.
 118
 119 sub new {
 120     my $class = shift;
 121     my ($config, $tpchanger) = @_;
 122
 123     # strip the "chg-foo:" prefix from $tpchanger
 124     my $device_name = $tpchanger;
 125     $device_name =~ s/^[^:]*://;
 126
 127     # get the 'chg-foo' form of this changer script
 128     my $class_name = $class;
 129     $class_name =~ s/Amanda::Changer::/chg-/;
 130
 131     my $self = {
 132         interface => undef,
 133         device_name => $device_name,
 134         config => $config,
 135
 136         # set below from properties
 137         statefile => undef,
 138         'lock-timeout' => undef,
 139         drive2device => {}, # { drive => device name }
 140         driveorder => [], # order of tape-device properties
 141         drive_choice => 'lru',
 142         eject_before_unload => 0,
 143         fast_search => 1,
 144         use_slots => undef,
 145         status_interval => 2, # in seconds
 146         load_poll => [0, 2, 120], # delay, poll, until
 147         eject_delay => 0, # in seconds
 148         unload_delay => 0, # in seconds
 149         class_name => $class_name,
 150     };
 151     bless ($self, $class);
 152
 153     # handle some config and properties
 154     my $properties = $config->{'properties'};
 155
 156     if (defined $config->{'changerdev'} and $config->{'changerdev'} ne '') {
 157         return Amanda::Changer->make_error("fatal", undef,
 158             message => "'changerdev' is not allowed with $self->{class_name}");
 159     }
 160
 161     if ($config->{'changerfile'}) {
 162         $self->{'statefile'} = Amanda::Config::config_dir_relative($config->{'changerfile'});
 163     } else {
 164         my $safe_filename = "$self->{class_name}:$device_name";
 165         $safe_filename =~ tr/a-zA-Z0-9/-/cs;
 166         $safe_filename =~ s/^-*//;
 167         $self->{'statefile'} = "$localstatedir/amanda/$safe_filename";
 168     }
 169     $self->_debug("using statefile '$self->{statefile}'");
 170     $self->{'lock-timeout'} = $config->{'lock-timeout'};
 171     # figure out the drive number to device name mapping
 172     if (exists $config->{'tapedev'}
 173             and $config->{'tapedev'} ne ''
 174             and !exists $properties->{'tape-device'}) {
 175         # if the tapedev points to us (the changer), then give an error
 176         if ($config->{'tapedev'} eq $tpchanger) {
 177             return Amanda::Changer->make_error("fatal", undef,
 178                 message => "must specify a tape-device property");
 179         }
 180         $self->{'drive2device'} = { '0' => $config->{'tapedev'} };
 181         push @{$self->{'driveorder'}}, '0';
 182     } else {
 183         if (!exists $properties->{'tape-device'}) {
 184             return Amanda::Changer->make_error("fatal", undef,
 185                 message => "no 'tape-device' property specified");
 186         }
 187         for my $pval (@{$properties->{'tape-device'}->{'values'}}) {
 188             my ($drive, $device);
 189             unless (($drive, $device) = ($pval =~ /(\d+)=(.*)/)) {
 190                 return Amanda::Changer->make_error("fatal", undef,
 191                     message => "invalid 'tape-device' property '$pval'");
 192             }
 193             if (exists $self->{'drive2device'}->{$drive}) {
 194                 return Amanda::Changer->make_error("fatal", undef,
 195                     message => "tape-device drive $drive defined more than once");
 196             }
 197             $self->{'drive2device'}->{$drive} = $device;
 198             push @{$self->{'driveorder'}}, $drive;
 199         }
 200     }
 201
 202     # eject-before-unload
 203     my $ebu = $self->{'config'}->get_boolean_property(
 204                                             "eject-before-unload", 0);
 205     if (!defined $ebu) {
 206         return Amanda::Changer->make_error("fatal", undef,
 207             message => "invalid 'eject-before-unload' value");
 208     }
 209     $self->{'eject_before_unload'} = $ebu;
 210
 211     # fast-search
 212     my $fast_search = $self->{'config'}->get_boolean_property(
 213                                                 "fast-search", 1);
 214     if (!defined $fast_search) {
 215         return Amanda::Changer->make_error("fatal", undef,
 216             message => "invalid 'fast-search' value");
 217     }
 218     $self->{'fast_search'} = $fast_search;
 219
 220     # use-slots
 221     if (exists $properties->{'use-slots'}) {
 222         $self->{'use_slots'} = join ",", @{$properties->{'use-slots'}->{'values'}};
 223         if ($self->{'use_slots'} !~ /\d+(-\d+)?(,\d+(-\d+)?)*/) {
 224             return Amanda::Changer->make_error("fatal", undef,
 225                 message => "invalid 'use-slots' value '$self->{use_slots}'");
 226         }
 227     }
 228
 229     # drive-choice
 230     if (exists $properties->{'drive-choice'}) {
 231         my $pval = $properties->{'drive-choice'}->{'values'}->[0];
 232         if (!grep { lc($_) eq $pval } ('lru', 'firstavail')) {
 233             return Amanda::Changer->make_error("fatal", undef,
 234                 message => "invalid 'drive-choice' value '$pval'");
 235         }
 236         $self->{'drive_choice'} = $pval;
 237     }
 238
 239     # load-poll
 240     {
 241         next unless exists $config->{'properties'}->{'load-poll'};
 242         if (@{$config->{'properties'}->{'load-poll'}->{'values'}} > 1) {
 243             return Amanda::Changer->make_error("fatal", undef,
 244                 message => "only one value allowed for 'load-poll'");
 245         }
 246         my $propval = $config->{'properties'}->{'load-poll'}->{'values'}->[0];
 247         my ($delay, $delayu, $poll, $pollu, $until, $untilu) = ($propval =~ /^
 248                 (\d+)\s*([ms]?)
 249                 (?:
 250                   \s+poll\s+
 251                   (\d+)\s*([ms]?)
 252                   (?:
 253                     \s+until\s+
 254                     (\d+)\s*([ms]?)
 255                   )?
 256                 )?
 257                 $/ix);
 258
 259         if (!defined $delay) {
 260             return Amanda::Changer->make_error("fatal", undef,
 261                 message => "invalid delay value '$propval' for 'load-poll'");
 262         }
 263
 264         $delay *= 60 if (defined $delayu and $delayu =~ /m/i);
 265
 266         $poll = 0 unless defined $poll;
 267         $poll *= 60 if (defined $pollu and $pollu =~ /m/i);
 268
 269         $until = 0 unless defined $until;
 270         $until *= 60 if (defined $untilu and $untilu =~ /m/i);
 271
 272         $self->{'load_poll'} = [ $delay, $poll, $until ];
 273     }
 274
 275     # status-interval, eject-delay, unload-delay
 276     for my $propname (qw(status-interval eject-delay unload-delay)) {
 277         next unless exists $config->{'properties'}->{$propname};
 278         if (@{$config->{'properties'}->{$propname}->{'values'}} > 1) {
 279             return Amanda::Changer->make_error("fatal", undef,
 280                 message => "only one value allowed for $propname");
 281         }
 282         my $propval = $config->{'properties'}->{$propname}->{'values'}->[0];
 283         my ($time, $timeu) = ($propval =~ /^(\d+)([ms]?)/ix);
 284
 285         if (!defined $time) {
 286             return Amanda::Changer->make_error("fatal", undef,
 287                 message => "invalid time value '$propval' for '$propname'");
 288         }
 289
 290         $time *= 60 if (defined $timeu and $timeu =~ /m/i);
 291
 292         my $key = $propname;
 293         $key =~ s/-/_/;
 294         $self->{$key} = $time;
 295     }
 296
 297     my $ignore_barcodes = $self->{'config'}->get_boolean_property(
 298                                             "ignore-barcodes", 0);
 299     if (!defined $ignore_barcodes) {
 300         return Amanda::Changer->make_error("fatal", undef,
 301             message => "invalid 'ignore-barcodes' value");
 302     }
 303
 304     # get the interface, returning an error if we get one
 305     $self->{'interface'} = $self->get_interface($device_name, $ignore_barcodes);
 306     return $self->{'interface'}
 307         if ($self->{'interface'}->isa("Amanda::Changer::Error"));
 308
 309     return $self;
 310 }
 311
 312 sub load {
 313     my $self = shift;
 314     my %params = @_;
 315     $self->validate_params('load', \%params);
 316
 317     return if $self->check_error($params{'res_cb'});
 318
 319     $self->_with_updated_state(\%params, 'res_cb', sub { $self->load_unlocked(@_) });
 320 }
 321
 322 sub load_unlocked {
 323     my $self = shift;
 324     my %params = @_;
 325     my ($slot, $drive, $need_unload);
 326     my $state = $params{'state'};
 327
 328     my $steps = define_steps
 329         cb_ref => \$params{'res_cb'};
 330
 331     step calculate_slot => sub {
 332         # make sure the slot is numeric
 333         if (exists $params{'slot'}) {
 334             if ($params{'slot'} =~ /^\d+$/) {
 335                 $params{'slot'} = $params{'slot'}+0;
 336             } else {
 337                 return $self->make_error("failed", $params{'res_cb'},
 338                         reason => "invalid",
 339                         message => "invalid slot '$params{slot}'");
 340             }
 341         }
 342
 343         if (exists $params{'relative_slot'}) {
 344             if ($params{'relative_slot'} eq "next") {
 345                 if (exists $params{'slot'}) {
 346                     $slot = $self->_get_next_slot($state, $params{'slot'}, $params{'except_slots'});
 347                     if (defined $slot) {
 348                         $self->_debug("loading next relative to $params{slot}: $slot");
 349                     } else {
 350                         $self->_debug("no next slot relative to $params{slot}");
 351                     }
 352                 } else {
 353                     $slot = $self->_get_next_slot($state, $state->{'current_slot'}{get_config_name()}, $params{'except_slots'});
 354                     if (defined $slot) {
 355                         $self->_debug("loading next relative to current slot: $slot");
 356                     } else {
 357                         $self->_debug("no next relative to current slot");
 358                     }
 359                 }
 360                 if (defined $slot && $slot == -1) {
 361                     return $self->make_error("failed", $params{'res_cb'},
 362                             reason => "invalid",
 363                             message => "could not find next slot");
 364                 }
 365             } elsif ($params{'relative_slot'} eq "current") {
 366                 $slot = $state->{'current_slot'}{get_config_name()};
 367                 if (defined $slot && $slot == -1) {
 368                     # seek to the first slot
 369                     $slot = $self->_get_next_slot($state, $state->{'current_slot'}{get_config_name()}, $params{'except_slots'});
 370                 }
 371                 if (defined $slot && $slot == -1) {
 372                     return $self->make_error("failed", $params{'res_cb'},
 373                             reason => "invalid",
 374                             message => "no current slot");
 375                 }
 376             } else {
 377                 return $self->make_error("failed", $params{'res_cb'},
 378                         reason => "invalid",
 379                         message => "invalid relative_slot '$params{relative_slot}'");
 380             }
 381
 382         } elsif (exists $params{'slot'}) {
 383             $slot = $params{'slot'};
 384             $self->_debug("loading slot '$params{slot}'");
 385
 386             if (!defined $slot or !exists $state->{'slots'}->{$slot}) {
 387                 return $self->make_error("failed", $params{'res_cb'},
 388                         reason => "invalid",
 389                         message => "invalid slot '$slot'");
 390             }
 391
 392         } elsif (exists $params{'label'}) {
 393             $self->_debug("loading label '$params{label}'");
 394             while (my ($sl, $info) = each(%{$state->{'slots'}})) {
 395                 if (defined $info->{'label'} and $info->{'label'} eq $params{'label'}) {
 396                     $slot = $sl;
 397                     last;
 398                 }
 399             }
 400
 401             if (!defined $slot) {
 402                 return $self->make_error("failed", $params{'res_cb'},
 403                         reason => "notfound",
 404                         message => "label '$params{label}' not recognized or not found");
 405             }
 406
 407         } else {
 408             return $self->make_error("failed", $params{'res_cb'},
 409                     reason => "invalid",
 410                     message => "no 'slot' or 'label' specified to load()");
 411         }
 412
 413         if (defined $slot and !exists $state->{'slots'}->{$slot}) {
 414             return $self->make_error("failed", $params{'res_cb'},
 415                     reason => "invalid",
 416                     message => "invalid slot '$slot'");
 417         }
 418
 419         if (!defined $slot) {
 420             my $all_empty = 1;
 421             if (exists $params{'except_slots'}) {
 422                 for my $xslot (keys %{ $params{'except_slots'} }) {
 423                     if ($state->{'slots'}->{$xslot}->{'state'} ne Amanda::Changer::SLOT_EMPTY) {
 424                         $all_empty = 0;
 425                     }
 426                 }
 427                 if ($all_empty) {
 428                     return $self->make_error("failed", $params{'res_cb'},
 429                         reason => "notfound",
 430                         message => "all slots are empty");
 431                 }
 432             }
 433             return $self->make_error("failed", $params{'res_cb'},
 434                     reason => "notfound",
 435                     message => "all slots have been loaded");
 436         }
 437         if (!$self->_is_slot_allowed($slot)) {
 438             if (exists $params{'label'}) {
 439                 return $self->make_error("failed", $params{'res_cb'},
 440                         reason => "invalid",
 441                         message => "label '$params{label}' is in slot $slot, which is " .
 442                                    "not in use-slots ($self->{use_slots})");
 443             } else {
 444                 return $self->make_error("failed", $params{'res_cb'},
 445                         reason => "invalid",
 446                         message => "slot $slot not in use-slots ($self->{use_slots})");
 447             }
 448         }
 449
 450         if (exists $params{'except_slots'} and exists $params{'except_slots'}->{$slot}) {
 451             # if all slots in except_slots are EMPTY
 452             my $all_empty = 1;
 453             for my $xslot (keys %{ $params{'except_slots'} }) {
 454                 if ($state->{'slots'}->{$xslot}->{'state'} ne Amanda::Changer::SLOT_EMPTY) {
 455                     $all_empty = 0;
 456                 }
 457             }
 458             if ($all_empty) {
 459                 return $self->make_error("failed", $params{'res_cb'},
 460                     reason => "notfound",
 461                     message => "all slots are empty");
 462             } else {
 463                 return $self->make_error("failed", $params{'res_cb'},
 464                     reason => "notfound",
 465                     message => "all slots have been loaded");
 466             }
 467         }
 468
 469         if ($state->{'slots'}->{$slot}->{'state'} eq Amanda::Changer::SLOT_EMPTY) {
 470             return $self->make_error("failed", $params{'res_cb'},
 471                     reason => "empty",
 472                     slot   => $slot,
 473                     message => "slot $slot is empty");
 474         }
 475
 476         return $steps->{'calculate_drive'}->();
 477     };
 478
 479     step calculate_drive => sub {
 480         # $slot is set
 481         $need_unload = 0;
 482
 483         # see if the tape is already in a drive
 484         $drive = $state->{'slots'}->{$slot}->{'loaded_in'};
 485         if (defined $drive) {
 486             $self->_debug("requested volume is already in drive $drive");
 487             my $info = $state->{'drives'}->{$drive};
 488
 489             # if it's reserved, it can't be used
 490             if ($info->{'res_info'} and $self->_res_info_verify($info->{'res_info'})) {
 491                 return $self->make_error("failed", $params{'res_cb'},
 492                         reason => "volinuse",
 493                         slot => $slot,
 494                         message => "the requested volume is in use (drive $drive)");
 495             }
 496
 497             # if it's not reserved, but not in our list of drives, well, it still
 498             # can't be used
 499             if (!exists $self->{'drive2device'}->{$drive}) {
 500                 return $self->make_error("failed", $params{'res_cb'},
 501                         # not 'volinuse' because we can't expect the tape to be magically
 502                         # unloaded any time soon -- it's not actually in use, just inaccessible
 503                         reason => "invalid",
 504                         message => "the requested volume is in drive $drive, which this " .
 505                                    "changer instance cannot access");
 506             }
 507
 508             # otherwise, we can jump all the way to the end of this process
 509             return $steps->{'start_polling'}->();
 510         }
 511
 512         # here is where we implement each of the drive-selection algorithms
 513         my @check_order;
 514         if ($self->{'drive_choice'} eq 'lru') {
 515             my %lru = map { $_, 1 } @{$state->{'drive_lru'}};
 516             my @unused = grep { ! exists $lru{$_} } @{$self->{'driveorder'}};
 517
 518             # search through unused drives, then the LRU list
 519             @check_order = (@unused, @{$state->{'drive_lru'}});
 520         } elsif ($self->{'drive_choice'} eq 'firstavail') {
 521             # just the drive order, so we tend to prefer the first drive in
 522             # this order
 523             @check_order = (@{$self->{'driveorder'}});
 524         } else {
 525             # the constructor should detect this circumstance
 526             confess "invalid drive_choice";
 527         }
 528
 529         my %checked;
 530         for my $dr (@check_order) {
 531             my $info = $state->{'drives'}->{$dr};
 532             next unless defined $info;
 533             next if exists $checked{$dr}; # don't check drives repeatedly
 534             $checked{$dr} = 1;
 535
 536             # skip drives we don't have rights to use
 537             next unless exists $self->{'drive2device'}->{$dr};
 538
 539             # skip reserved drives
 540             if ($info->{'res_info'}) {
 541                 if ($self->_res_info_verify($info->{'res_info'})) {
 542                     # this is a valid reservation -> skip this drive
 543                     $self->_debug("skipping drive $dr - already reserved");
 544                     next;
 545                 } else {
 546                     warning("invalidating stale reservation on drive $dr");
 547                     $info->{'res_info'} = undef;
 548                 }
 549             }
 550
 551             # otherwise, the drive is available, so use it (whether it contains
 552             # a volume or not)
 553             $drive = $dr;
 554             if ($info->{'state'} != Amanda::Changer::SLOT_EMPTY) {
 555                 $need_unload = 1;
 556             }
 557             last;
 558         }
 559
 560         if (!defined $drive) {
 561             return $self->make_error("failed", $params{'res_cb'},
 562                     reason => "driveinuse",
 563                     message => "no drives available");
 564         }
 565
 566         # remove this drive from the lru and put it at the end
 567         $state->{'drive_lru'} = [ grep { $_ ne $drive } @{$state->{'drive_lru'}} ];
 568         push @{$state->{'drive_lru'}}, $drive;
 569
 570         $self->_debug("using drive $drive");
 571
 572         $steps->{'wait_to_start'}->();
 573     };
 574
 575     step wait_to_start => sub {
 576         $self->_after_delay($state, $steps->{'start_operation'});
 577     };
 578
 579     step start_operation => sub {
 580         # $need_unload is set in $steps->{calculate_drive}
 581         if ($need_unload) {
 582             $steps->{'start_eject'}->();
 583         } else {
 584             $steps->{'start_load'}->();
 585         }
 586     };
 587
 588     step start_eject => sub {
 589         # we use the 'eject' method to unload here -- it ejects the volume
 590         # if the configuration calls for it, then puts the volume away in its
 591         # original slot.
 592         $self->eject_unlocked(
 593                 finished_cb => $steps->{'eject_finished'},
 594                 drive => $drive,
 595                 state => $state);
 596     };
 597
 598     step eject_finished => sub {
 599         my ($err) = @_;
 600
 601         if ($err) {
 602            return $params{'res_cb'}->($err);
 603         }
 604
 605         $steps->{'wait_to_load'}->();
 606     };
 607
 608     step wait_to_load => sub {
 609         $self->_after_delay($state, $steps->{'start_load'});
 610     };
 611
 612     step start_load => sub {
 613         # $slot and $drive are set
 614         $self->{'interface'}->load($slot, $drive, $steps->{'load_finished'});
 615     };
 616
 617     step load_finished => sub {
 618         # $slot and $drive are set
 619         my ($err) = @_;
 620
 621         if ($err) {
 622             return $self->make_error("failed", $params{'res_cb'},
 623                     reason => "unknown",
 624                     message => $err);
 625         }
 626
 627         $steps->{'start_polling'}->();
 628     };
 629
 630     my ($next_poll, $last_poll);
 631     step start_polling => sub {
 632         my ($delay, $poll, $until) = @{ $self->{'load_poll'} };
 633         my $now = time;
 634         $next_poll = $now + $delay;
 635         $last_poll = $now + $until;
 636
 637         return Amanda::MainLoop::call_after(1000 * ($next_poll - $now), $steps->{'check_device'});
 638     };
 639
 640     step check_device => sub {
 641         my $device_name = $self->{'drive2device'}->{$drive};
 642         confess "drive $drive not found in drive2device" unless $device_name; # shouldn't happen
 643
 644         $self->_debug("polling '$device_name' to see if it's ready");
 645
 646         my $device = $self->get_device($device_name);
 647         return $params{'res_cb'}->($device) if $device->isa("Amanda::Changer::Error");
 648
 649         my $label;
 650         $device->read_label();
 651
 652         # see if the device thinks it's possible it's busy or empty
 653         if ($device->status & $DEVICE_STATUS_VOLUME_MISSING
 654             or $device->status & $DEVICE_STATUS_DEVICE_BUSY) {
 655             # device is not ready -- set up for the next polling step
 656             my ($delay, $poll, $until) = @{ $self->{'load_poll'} };
 657             my $now = time;
 658             $next_poll += $poll;
 659             $next_poll = $now + 1 if ($next_poll < $now);
 660             if ($poll != 0 and $next_poll < $last_poll) {
 661                 return Amanda::MainLoop::call_after(
 662                         1000 * ($next_poll - $now), $steps->{'check_device'});
 663             }
 664
 665             # (fall through if we're done polling)
 666         }
 667
 668         if ($device->status == $DEVICE_STATUS_SUCCESS) {
 669             $label = $device->volume_label;
 670         } elsif ($device->status & $DEVICE_STATUS_VOLUME_UNLABELED) {
 671             $label = undef;
 672         } else {
 673             $label = undef;
 674         }
 675
 676         # success!
 677         $steps->{'make_res'}->($device, $label);
 678     };
 679
 680     step make_res => sub {
 681         my ($device, $label) = @_;
 682
 683         # check the label against the desired label, in case this isn't the
 684         # desired volume
 685         if ($label and $params{'label'} and $label ne $params{'label'}) {
 686             $self->_debug("Expected label '$params{label}', but got '$label'");
 687
 688             # update metadata with this new information
 689             $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
 690             $state->{'slots'}->{$slot}->{'device_status'} = $device->status;
 691             if ($device->status == $DEVICE_STATUS_SUCCESS) {
 692                 $state->{'slots'}->{$slot}->{'device_error'} = undef;
 693             } else {
 694                 $state->{'slots'}->{$slot}->{'device_error'} = $device->error;
 695             }
 696             if (defined $device->volume_header) {
 697                 $state->{'slots'}->{$slot}->{'f_type'} = $device->volume_header->{type};
 698             } else {
 699                 $state->{'slots'}->{$slot}->{'f_type'} = undef;
 700             }
 701             $state->{'slots'}->{$slot}->{'label'} = $label;
 702             if ($state->{'slots'}->{$slot}->{'barcode'}) {
 703                 my $barcode = $state->{'slots'}->{$slot}->{'barcode'};
 704                 my $old_label = $state->{'bc2lb'}->{$barcode};
 705                 if ($label ne $old_label) {
 706                     $self->_debug("make_res: slot $slot");
 707                     $self->_debug("update label '$label' for barcode '$barcode', old label was '$old_label'");
 708                 }
 709                 $state->{'bc2lb'}->{$barcode} = $label;
 710             }
 711
 712             return $self->make_error("failed", $params{'res_cb'},
 713                     reason => "notfound",
 714                     message => "Found unexpected tape '$label' while looking " .
 715                                "for '$params{label}'");
 716         }
 717
 718         if (!$label and $params{'label'}) {
 719             $self->_debug("Expected label '$params{label}', but got an unlabeled tape");
 720
 721             # update metadata with this new information
 722             $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
 723             $state->{'slots'}->{$slot}->{'device_status'} = $device->status;
 724             if ($device->status == $DEVICE_STATUS_SUCCESS) {
 725                 $state->{'slots'}->{$slot}->{'device_error'} = undef;
 726             } else {
 727                 $state->{'slots'}->{$slot}->{'device_error'} = $device->error;
 728             }
 729             if (defined $device->volume_header) {
 730                 $state->{'slots'}->{$slot}->{'f_type'} = $device->volume_header->{type};
 731             } else {
 732                 $state->{'slots'}->{$slot}->{'f_type'} = undef;
 733             }
 734             $state->{'slots'}->{$slot}->{'label'} = undef;
 735             if ($state->{'slots'}->{$slot}->{'barcode'}) {
 736                 delete $state->{'bc2lb'}->{$state->{'slots'}->{$slot}->{'barcode'}};
 737             }
 738
 739             return $self->make_error("failed", $params{'res_cb'},
 740                     reason => "notfound",
 741                     message => "Found unlabeled tape while looking for '$params{label}'");
 742         }
 743
 744         if (defined $self->{'tapelist'}) {
 745             my $tle = $self->{'tapelist'}->lookup_tapelabel($label);
 746             if (defined $tle and defined $tle->{'barcode'} and
 747                 defined $state->{'slots'}->{$slot}->{'barcode'} and
 748                 $state->{'slots'}->{$slot}->{'barcode'} ne $tle->{'barcode'}) {
 749                 return $self->make_error("failed", $params{'res_cb'},
 750                     reason => "device",
 751                     message => "Slot $slot, label '$label', mismatch barcode between changer '$state->{'slots'}->{$slot}->{'barcode'}' and tapelist file '$tle->{'barcode'}'");
 752             }
 753         }
 754         my $res = Amanda::Changer::robot::Reservation->new($self, $slot, $drive,
 755                                 $device, $state->{'slots'}->{$slot}->{'barcode'});
 756
 757         # mark this as reserved
 758         $state->{'drives'}->{$drive}->{'res_info'} = $self->_res_info_new();
 759
 760         # update our state before returning
 761         $state->{'slots'}->{$slot}->{'loaded_in'} = $drive;
 762         $state->{'drives'}->{$drive}->{'orig_slot'} = $slot;
 763         $state->{'slots'}->{$slot}->{'label'} = $label;
 764         $state->{'drives'}->{$drive}->{'label'} = $label;
 765         $state->{'drives'}->{$drive}->{'state'} = Amanda::Changer::SLOT_FULL;
 766         $state->{'drives'}->{$drive}->{'barcode'} = $state->{'slots'}->{$slot}->{'barcode'};
 767         $state->{'slots'}->{$slot}->{'device_status'} = $device->status;
 768         if ($device->status == $DEVICE_STATUS_SUCCESS) {
 769             $state->{'slots'}->{$slot}->{'device_error'} = undef;
 770         } else {
 771             $state->{'slots'}->{$slot}->{'device_error'} = $device->error;
 772         }
 773         if (defined $device->volume_header) {
 774             $state->{'slots'}->{$slot}->{'f_type'} = $device->volume_header->{type};
 775         } else {
 776             $state->{'slots'}->{$slot}->{'f_type'} = undef;
 777         }
 778         my $barcode = $state->{'slots'}->{$slot}->{'barcode'};
 779         if ($label and $barcode) {
 780             my $old_label = $state->{'bc2lb'}->{$barcode};
 781             if (defined $old_label and $old_label ne $label) {
 782                 $self->_debug("load drive $drive slot $slot");
 783                 $self->_debug("update label '$label' for barcode '$barcode', old label was '$old_label'");
 784             }
 785             $state->{'bc2lb'}->{$barcode} = $label;
 786         }
 787         if ($params{'set_current'}) {
 788             $self->_debug("setting current slot to $slot");
 789             $state->{'current_slot'}{get_config_name()} = $slot;
 790         }
 791
 792         return $params{'res_cb'}->(undef, $res);
 793     };
 794 }
 795
 796 sub info_key {
 797     my $self = shift;
 798     my ($key, %params) = @_;
 799
 800     if ($key eq 'fast_search') {
 801         $self->info_key_fast_search(%params);
 802     } elsif ($key eq 'vendor_string') {
 803         $self->info_key_vendor_string(%params);
 804     } elsif ($key eq 'num_slots') {
 805         $self->info_key_num_slots(%params);
 806     }
 807 }
 808
 809 sub info_key_fast_search {
 810     my $self = shift;
 811     my %params = @_;
 812
 813     $params{'info_cb'}->(undef,
 814         fast_search => $self->{'fast_search'},
 815     );
 816 }
 817
 818 sub info_key_vendor_string {
 819     my $self = shift;
 820     my %params = @_;
 821
 822     $self->{'interface'}->inquiry(make_cb(inquiry_cb => sub {
 823         my ($err, $info) = @_;
 824         return $self->make_error("fatal", $params{'info_cb'},
 825                 message => "$err") if $err;
 826
 827         my $vendor_string = sprintf "%s %s",
 828             ($info->{'vendor id'} or "<unknown>"),
 829             ($info->{'product id'} or "<unknown>");
 830
 831         $params{'info_cb'}->(undef,
 832             vendor_string => $vendor_string,
 833         );
 834     }));
 835 }
 836
 837 sub info_key_num_slots {
 838     my $self = shift;
 839     my %params = @_;
 840
 841     $self->_with_updated_state(\%params, 'info_cb',
 842         sub { $self->info_key_num_slots_unlocked(@_) });
 843 }
 844
 845 sub info_key_num_slots_unlocked {
 846     my $self = shift;
 847     my %params = @_;
 848     my $state = $params{'state'};
 849
 850     my @allowed_slots = grep { $self->_is_slot_allowed($_) }
 851                         keys %{$state->{'slots'}};
 852
 853     $params{'info_cb'}->(undef, num_slots => scalar @allowed_slots);
 854 }
 855
 856 sub get_interface { # (overridden by subclasses)
 857     my $self = shift;
 858     my ($device_name, $ignore_barcodes) = @_;
 859
 860     my $mtx;
 861     if (exists $self->{'config'}->{'properties'}->{'mtx'}) {
 862         if (@{$self->{'config'}->{'properties'}->{'mtx'}->{'values'}} > 1) {
 863             return Amanda::Changer->make_error("fatal", undef,
 864                 message => "only one value allowed for 'mtx'");
 865         }
 866         $mtx = $self->{'config'}->{'properties'}->{'mtx'}->{'values'}->[0];
 867     } else {
 868         $mtx = $Amanda::Constants::MTX;
 869     }
 870
 871     if (!$mtx) {
 872         return Amanda::Changer->make_error("fatal", undef,
 873             message => "no default value for property MTX");
 874     }
 875
 876     return Amanda::Changer::robot::Interface::MTX->new($device_name, $mtx, $ignore_barcodes),
 877 }
 878
 879 # get, configure, and return a new device, or return a changer error
 880 sub get_device { # (overridden by subclasses)
 881     my $self = shift;
 882     my ($device_name) = @_;
 883
 884     my $device = Amanda::Device->new($device_name);
 885     if ($device->status != $DEVICE_STATUS_SUCCESS) {
 886         return Amanda::Changer->make_error("fatal", undef,
 887                 reason => "device",
 888                 message => "opening '$device_name': " . $device->error_or_status());
 889     }
 890
 891     if (my $err = $self->{'config'}->configure_device($device)) {
 892         return Amanda::Changer->make_error("fatal", undef,
 893                 reason => "device",
 894                 message => $err);
 895     }
 896
 897     return $device;
 898 }
 899
 900 sub _set_label {
 901     my $self = shift;
 902     my %params = @_;
 903
 904     return if $self->check_error($params{'finished_cb'});
 905
 906     $self->_with_updated_state(\%params, 'finished_cb',
 907         sub { $self->_set_label_unlocked(@_); });
 908 }
 909
 910 sub _set_label_unlocked {
 911     my $self = shift;
 912     my %params = @_;
 913     my $state = $params{'state'};
 914
 915     # update all of the various pieces of cached information
 916     my $drive = $params{'drive'};
 917     my $slot = $state->{'drives'}->{$drive}->{'orig_slot'};
 918     my $label = $params{'label'};
 919     my $barcode = $state->{'drives'}->{$drive}->{'barcode'};
 920     my $dev = $params{dev};
 921
 922     $state->{'drives'}->{$drive}->{'label'} = $label;
 923     if (defined $slot) {
 924         $state->{'slots'}->{$slot}->{'state'} = Amanda::Changer::SLOT_FULL;
 925         $state->{'slots'}->{$slot}->{'device_status'} = "".$dev->status;
 926         if ($dev->status != $DEVICE_STATUS_SUCCESS) {
 927             $state->{'slots'}->{$slot}->{'device_error'} = $dev->error;
 928         } else {
 929             $state->{'slots'}->{$slot}->{'device_error'} = undef;
 930         }
 931         my $volume_header = $dev->volume_header;
 932         if (defined $volume_header) {
 933             $state->{'slots'}->{$slot}->{'f_type'} = "".$volume_header->{type};
 934         } else {
 935             $state->{'slots'}->{$slot}->{'f_type'} = undef;
 936         }
 937         $state->{'slots'}->{$slot}->{'label'} = $label;
 938     }
 939     if (defined $barcode) {
 940         if (defined $state->{'bc2lb'}->{$barcode} and
 941             $state->{'bc2lb'}->{$barcode} ne $label) {
 942             my $old_label = $state->{'bc2lb'}->{$barcode};
 943             $self->_debug("update barcode '$barcode' to label '$label', old label was '$old_label'");
 944         }
 945         $state->{'bc2lb'}->{$barcode} = $label;
 946     }
 947
 948     $params{'finished_cb'}->(undef);
 949 }
 950
 951 sub _release {
 952     my $self = shift;
 953     my %params = @_;
 954
 955     return if $self->check_error($params{'finished_cb'});
 956
 957     $self->_with_updated_state(\%params, 'finished_cb',
 958         sub { $self->_release_unlocked(@_); });
 959 }
 960
 961 sub _release_unlocked {
 962     my $self = shift;
 963     my %params = @_;
 964     my $state = $params{'state'};
 965     my $drive = $params{'drive'};
 966
 967     # delete the reservation and save the statefile
 968     if (!$self->_res_info_is_mine($state->{'drives'}->{$drive}->{'res_info'})) {
 969         # this should *never* happen
 970         return $self->make_error("fatal", $params{'finished_cb'},
 971                 message => "reservation belongs to another instance");
 972     }
 973     $state->{'drives'}->{$drive}->{'res_info'} = undef;
 974
 975     # bounce off to eject if the user has requested it, using the xx_unlocked
 976     # variant since we've already got the statefile open
 977     if ($params{'eject'}) {
 978         $self->eject_unlocked(
 979             drive => $drive,
 980             finished_cb => $params{'finished_cb'},
 981             state => $state,
 982         );
 983     } else {
 984         $params{'finished_cb'}->();
 985     }
 986 }
 987
 988 sub reset {
 989     my $self = shift;
 990     my %params = @_;
 991
 992     return if $self->check_error($params{'finished_cb'});
 993
 994     $self->_with_updated_state(\%params, 'finished_cb',
 995         sub { $self->reset_unlocked(@_); });
 996 }
 997
 998 sub reset_unlocked {
 999     my $self = shift;
1000     my %params = @_;
1001     my $state = $params{'state'};
1002
1003     $state->{'current_slot'}{get_config_name()} = $self->_get_next_slot($state, -1);
1004
1005     $params{'finished_cb'}->();
1006 }
1007
1008 sub eject {
1009     my $self = shift;
1010     my %params = @_;
1011
1012     return if $self->check_error($params{'finished_cb'});
1013
1014     $self->_with_updated_state(\%params, 'finished_cb',
1015         sub { $self->eject_unlocked(@_); });
1016 }
1017
1018 sub eject_unlocked {
1019     my $self = shift;
1020     my %params = @_;
1021     my $state = $params{'state'};
1022     my ($drive, $drive_info);
1023
1024     return if $self->check_error($params{'finished_cb'});
1025
1026     my $steps = define_steps
1027         cb_ref => \$params{'finished_cb'};
1028
1029     # note that this changer treats "eject" as "unload", which may also require an eject
1030     # operation if the eject_before_unload property is set
1031
1032     step start => sub {
1033         # if drive isn't specified, see if we only have one
1034         if (!exists $params{'drive'}) {
1035             if ((keys %{$self->{'drive2device'}}) == 1) {
1036                 $params{'drive'} = (keys %{$self->{'drive2device'}})[0];
1037             } else {
1038                 return $self->make_error("failed", $params{'finished_cb'},
1039                         reason => "invalid",
1040                         message => "no drive specified");
1041             }
1042         }
1043         $drive = $params{'drive'};
1044
1045         $self->_debug("unloading drive $drive");
1046         $drive_info = $state->{'drives'}->{$drive};
1047         if (!$drive_info) {
1048             return $self->make_error("failed", $params{'finished_cb'},
1049                     reason => "invalid",
1050                     message => "invalid drive '$drive'");
1051         }
1052
1053         # if the drive exists, but not configured in this changer, then
1054         # bail out.
1055         if (!defined $self->{'drive2device'}->{$drive}) {
1056             return $self->make_error("failed", $params{'finished_cb'},
1057                     reason => "invalid",
1058                     message => "this changer instance is not configured to access drive $drive");
1059         }
1060
1061
1062         # check for a reservation
1063         if ($drive_info->{'res_info'}
1064                     and $self->_res_info_verify($drive_info->{'res_info'})) {
1065             return $self->make_error("failed", $params{'finished_cb'},
1066                     reason => "volinuse",
1067                     message => "tape in drive '$drive' is in use");
1068         }
1069
1070         if ($self->{'eject_before_unload'}) {
1071             $steps->{'wait_to_eject'}->();
1072         } else {
1073             $steps->{'wait_to_unload'}->();
1074         }
1075     };
1076
1077     step wait_to_eject => sub {
1078         $self->_after_delay($state, $steps->{'eject'});
1079     };
1080
1081     step eject => sub {
1082         my $device_name = $self->{'drive2device'}->{$drive};
1083         $self->_debug("ejecting $device_name before unload");
1084
1085         my $device = $self->get_device($device_name);
1086         return $device if $device->isa("Amanda::Changer::Error");
1087
1088         if (!$device->eject()) {
1089             return $self->make_error("failed", $params{'finished_cb'},
1090                     reason => "unknown",
1091                     message => "while ejecting volume: " . $device->error_or_status);
1092         }
1093         undef $device;
1094
1095         $self->_set_delay($state, $self->{'eject_delay'});
1096
1097         $steps->{'wait_to_unload'}->();
1098     };
1099
1100     step wait_to_unload => sub {
1101         $self->_after_delay($state, $steps->{'unload'});
1102     };
1103
1104     step unload => sub {
1105         # find target slot and unload it - note that the target slot may not be
1106         # in the USE-SLOTS list, as it may belong to another config
1107         my $orig_slot = $drive_info->{'orig_slot'};
1108         $self->{'interface'}->unload($drive, $orig_slot, $steps->{'unload_finished'});
1109     };
1110
1111     step unload_finished => sub {
1112         my ($err) = @_;
1113
1114         if ($err) {
1115             return $self->make_error("failed", $params{'finished_cb'},
1116                     reason => "unknown",
1117                     message => $err);
1118         }
1119
1120         $self->_debug("unload complete");
1121         my $orig_slot = $state->{'drives'}->{$drive}->{'orig_slot'};
1122         $state->{'slots'}->{$orig_slot}->{'state'} = $state->{'drives'}->{$drive}->{'state'};
1123         $state->{'slots'}->{$orig_slot}->{'label'} = $state->{'drives'}->{$drive}->{'label'};
1124         $state->{'slots'}->{$orig_slot}->{'barcode'} = $state->{'drives'}->{$drive}->{'barcode'};
1125         $state->{'slots'}->{$orig_slot}->{'loaded_in'} = undef;
1126         $state->{'drives'}->{$drive}->{'state'} = Amanda::Changer::SLOT_EMPTY;
1127         $state->{'drives'}->{$drive}->{'label'} = undef;
1128         $state->{'drives'}->{$drive}->{'barcode'} = undef;
1129         $state->{'drives'}->{$drive}->{'orig_slot'} = undef;
1130
1131         $self->_set_delay($state, $self->{'unload_delay'});
1132         $params{'finished_cb'}->();
1133     };
1134 }
1135
1136 sub update {
1137     my $self = shift;
1138     my %params = @_;
1139
1140     return if $self->check_error($params{'finished_cb'});
1141
1142     $self->_with_updated_state(\%params, 'finished_cb',
1143         sub { $self->update_unlocked(@_); });
1144 }
1145
1146 sub update_unlocked {
1147     my $self = shift;
1148     my %params = @_;
1149     my @slots_to_check;
1150     my $state = $params{'state'};
1151     my $set_to_unknown = 0;
1152
1153     return if $self->check_error($params{'finished_cb'});
1154
1155     my $user_msg_fn = $params{'user_msg_fn'};
1156     $user_msg_fn ||= sub { $self->_debug($_[0]); };
1157
1158     my $steps = define_steps
1159         cb_ref => \$params{'finished_cb'};
1160
1161     step handle_assignment => sub {
1162         # check for the SL=LABEL format, and handle it here
1163         if (exists $params{'changed'} and $params{'changed'} =~ /^\d+=\S+$/) {
1164             my ($slot, $label) = ($params{'changed'} =~ /^(\d+)=(\S+)$/);
1165
1166             # let's list the reasons we *can't* do what the user has asked
1167             my $whynot;
1168             if (!exists $state->{'slots'}) {
1169                 $whynot = "slot $slot does not exist";
1170             } elsif (!$self->_is_slot_allowed($slot)) {
1171                 $whynot = "slot $slot is not used by this changer";
1172             } elsif ($state->{'slots'}->{$slot}->{'state'} ==
1173                      Amanda::Changer::SLOT_EMPTY) {
1174                 $whynot = "slot $slot is empty";
1175             } elsif (defined $state->{'slots'}->{$slot}->{'loaded_in'}) {
1176                 $whynot = "slot $slot is currently loaded";
1177             }
1178
1179             if ($whynot) {
1180                 return $self->make_error("failed", $params{'finished_cb'},
1181                         reason => "unknown", message => $whynot);
1182             }
1183
1184             $user_msg_fn->("recoding volume '$label' in slot $slot");
1185             # ok, now erase all knowledge of that label
1186             while (my ($bc, $lb) = each %{$state->{'bc2lb'}}) {
1187                 if ($lb eq $label) {
1188                     delete $state->{'bc2lb'}->{$bc};
1189                     last;
1190                 }
1191             }
1192             while (my ($sl, $inf) = each %{$state->{'slots'}}) {
1193                 if ($inf->{'label'} and $inf->{'label'} eq $label) {
1194                     delete $inf->{'device_status'};
1195                     delete $inf->{'device_error'};
1196                     delete $inf->{'f_type'};
1197                     delete $inf->{'label'};
1198                 }
1199             }
1200
1201             # and add knowledge of the label to the given slot
1202             #$state->{'slots'}->{$slot}->{'device_status'} = $DEVICE_STATUS_SUCCESS;
1203             #$state->{'slots'}->{$slot}->{'f_type'} = $Amanda::Header::F_TAPESTART;
1204             $state->{'slots'}->{$slot}->{'label'} = $label;
1205             if ($state->{'slots'}->{$slot}->{'barcode'}) {
1206                 my $bc = $state->{'slots'}->{$slot}->{'barcode'};
1207                 $state->{'bc2lb'}->{$bc} = $label;
1208             }
1209
1210             # that's it -- no changer motion required
1211             return $params{'finished_cb'}->(undef);
1212         } elsif (exists $params{'changed'} and
1213                  $params{'changed'} =~ /^(.+)=$/) {
1214             $params{'changed'} = $1;
1215             $set_to_unknown = 1;
1216             $steps->{'calculate_slots'}->($steps->{'set_to_unknown'});
1217         } else {
1218             $steps->{'calculate_slots'}->($steps->{'update_slot'});
1219         }
1220     };
1221
1222     step calculate_slots => sub {
1223         my ($update_slot_cb) = shift @_;
1224         if (exists $params{'changed'}) {
1225             # parse the string just like use-slots, using a hash for uniqueness
1226             my %changed;
1227             for my $range (split ',', $params{'changed'}) {
1228                 my ($first, $last) = ($range =~ /(\d+)(?:-(\d+))?/);
1229                 $last = $first unless defined($last);
1230                 for ($first .. $last) {
1231                     $changed{$_} = undef;
1232                 }
1233             }
1234
1235             @slots_to_check = keys %changed;
1236             @slots_to_check = grep { exists $state->{'slots'}->{$_} } @slots_to_check;
1237         } else {
1238             @slots_to_check = keys %{ $state->{'slots'} };
1239         }
1240
1241         # limit the update to allowed slots, and sort them so we don't confuse
1242         # the user with a "random" order
1243         @slots_to_check = grep { $self->_is_slot_allowed($_) } @slots_to_check;
1244         @slots_to_check = grep { $state->{'slots'}->{$_}->{'state'} == Amanda::Changer::SLOT_FULL} @slots_to_check;
1245         @slots_to_check = sort { $a <=> $b } @slots_to_check;
1246
1247         $update_slot_cb->();
1248     };
1249
1250     step set_to_unknown => sub {
1251         return $steps->{'done'}->() if (!@slots_to_check);
1252
1253         my $slot = shift @slots_to_check;
1254         $user_msg_fn->("Removing entry for slot $slot");
1255         if (!defined $state->{'slots'}->{$slot}->{'barcode'}) {
1256             $state->{'slots'}->{$slot}->{'label'} = undef;
1257             $state->{'slots'}->{$slot}->{'device_status'} = undef;
1258             $state->{'slots'}->{$slot}->{'device_error'} = undef;
1259             $state->{'slots'}->{$slot}->{'f_type'} = undef;
1260             if (defined $state->{'slots'}->{$slot}->{'loaded_in'}) {
1261                 my $drive = $state->{'slots'}->{$slot}->{'loaded_in'};
1262                 $state->{'drives'}->{$drive}->{'label'} = undef;
1263                 $state->{'drives'}->{$drive}->{'state'} =
1264                                         Amanda::Changer::SLOT_FULL;
1265             }
1266         }
1267         $steps->{'set_to_unknown'}->();
1268     };
1269
1270     # TODO: parallelize this if multiple drives are available
1271
1272     step update_slot => sub {
1273         return $steps->{'done'}->() if (!@slots_to_check);
1274
1275         my $slot = shift @slots_to_check;
1276         $user_msg_fn->("scanning slot $slot");
1277
1278         $self->load_unlocked(
1279                 slot => $slot,
1280                 res_cb => $steps->{'slot_loaded'},
1281                 state => $state);
1282     };
1283
1284     step slot_loaded => sub {
1285         my ($err, $res) = @_;
1286         if ($err) {
1287             return $params{'finished_cb'}->($err);
1288         }
1289
1290         # load() already fixed up the metadata, so just release; but we have to
1291         # be careful to do an unlocked release.
1292         $res->release(
1293             finished_cb => $steps->{'released'},
1294             unlocked => 1,
1295             state => $state);
1296     };
1297
1298     step released => sub {
1299         my ($err) = @_;
1300         if ($err) {
1301             return $params{'finished_cb'}->($err);
1302         }
1303
1304         $steps->{'update_slot'}->();
1305     };
1306
1307     step done => sub {
1308         $params{'finished_cb'}->(undef);
1309     };
1310 }
1311
1312 sub inventory {
1313     my $self = shift;
1314     my %params = @_;
1315
1316     return if $self->check_error($params{'inventory_cb'});
1317
1318     $self->_with_updated_state(\%params, 'inventory_cb',
1319         sub { $self->inventory_unlocked(@_); });
1320 }
1321
1322 sub inventory_unlocked {
1323     my $self = shift;
1324     my %params = @_;
1325     my $state = $params{'state'};
1326
1327     my @slot_names = sort { $a <=> $b } keys %{ $state->{'slots'} };
1328     my @inv;
1329     for my $slot_name (@slot_names) {
1330         my $i = {};
1331         next unless $self->_is_slot_allowed($slot_name);
1332         my $slot = $state->{'slots'}->{$slot_name};
1333
1334         $i->{'slot'} = $slot_name;
1335         $i->{'state'} = $slot->{'state'};
1336         $i->{'device_status'} = $slot->{'device_status'};
1337         $i->{'device_error'} = $slot->{'device_error'};
1338         $i->{'f_type'} = $slot->{'f_type'};
1339         $i->{'label'} = $slot->{'label'};
1340         $i->{'barcode'} = $slot->{'barcode'}
1341                 if ($slot->{'barcode'});
1342         if (defined $slot->{'loaded_in'}) {
1343             $i->{'loaded_in'} = $slot->{'loaded_in'};
1344             my $drive = $state->{'drives'}->{$slot->{'loaded_in'}};
1345             if ($drive->{'res_info'} and $self->_res_info_verify($drive->{'res_info'})) {
1346                 $i->{'reserved'} = 1;
1347             }
1348         }
1349         $i->{'import_export'} = 1
1350             if $slot->{'ie'};
1351
1352         $i->{'current'} = 1
1353             if $slot_name eq $state->{'current_slot'}{get_config_name()};
1354
1355         push @inv, $i;
1356     }
1357
1358     $params{'inventory_cb'}->(undef, \@inv);
1359 }
1360
1361 sub move {
1362     my $self = shift;
1363     my %params = @_;
1364
1365     return if $self->check_error($params{'finished_cb'});
1366
1367     $self->_with_updated_state(\%params, 'finished_cb',
1368         sub { $self->move_unlocked(@_); });
1369 }
1370
1371 sub move_unlocked {
1372     my $self = shift;
1373     my %params = @_;
1374     my $state = $params{'state'};
1375
1376     my $from_slot = $params{'from_slot'};
1377     my $to_slot = $params{'to_slot'};
1378
1379     # make sure this is OK
1380     for ($from_slot, $to_slot) {
1381         if (!$self->_is_slot_allowed($_)) {
1382             return $self->make_error("failed", $params{'finished_cb'},
1383                     reason => "invalid",
1384                     message => "invalid slot $_");
1385         }
1386     }
1387
1388     if ($state->{'slots'}->{$from_slot}->{'state'} == Amanda::Changer::SLOT_EMPTY) {
1389         return $self->make_error("failed", $params{'finished_cb'},
1390                 reason => "invalid",
1391                 message => "slot $from_slot is empty");
1392     }
1393
1394     my $in_drive = $state->{'slots'}->{$from_slot}->{'loaded_in'};
1395     if (defined $in_drive) {
1396         my $info = $state->{'drives'}->{$in_drive};
1397         if ($info->{'res_info'} and $self->_res_info_verify($info->{'res_info'})) {
1398             return $self->make_error("failed", $params{'finished_cb'},
1399                     reason => "invalid",
1400                     message => "slot $from_slot is currently loaded and reserved");
1401         }
1402     }
1403
1404     if ($state->{'slots'}->{$to_slot}->{'state'} == Amanda::Changer::SLOT_FULL) {
1405         return $self->make_error("failed", $params{'finished_cb'},
1406                 reason => "invalid",
1407                 message => "slot $to_slot is not empty");
1408     }
1409
1410     # if the destination slot is loaded, then we could do an "exchange", but
1411     # should we?
1412
1413     my $transfer_complete = make_cb(transfer_complete => sub {
1414         my ($err) = @_;
1415         return $params{'finished_cb'}->($err) if $err;
1416
1417         # update metadata
1418         if ($from_slot ne $to_slot) {
1419             my $f = $state->{'slots'}->{$from_slot};
1420             my $t = $state->{'slots'}->{$to_slot};
1421
1422             $t->{'device_status'} = $f->{'device_status'};
1423             $f->{'device_status'} = undef;
1424
1425             $t->{'state'} = $f->{'state'};
1426             $f->{'state'} = Amanda::Changer::SLOT_EMPTY;
1427
1428             $t->{'f_type'} = $f->{'f_type'};
1429             $f->{'f_type'} = undef;
1430
1431             $t->{'label'} = $f->{'label'};
1432             $f->{'label'} = undef;
1433
1434             $t->{'barcode'} = $f->{'barcode'};
1435             $f->{'barcode'} = undef;
1436         }
1437
1438         # properly represent the unload operation, if it was performed
1439         if (defined $in_drive) {
1440             $state->{'slots'}->{$from_slot}->{'loaded_in'} = undef;
1441             $state->{'slots'}->{$to_slot}->{'loaded_in'} = undef;
1442
1443             $state->{'drives'}->{$in_drive}->{'state'} =
1444                                                     Amanda::Changer::SLOT_EMPTY;
1445             $state->{'drives'}->{$in_drive}->{'label'} = undef;
1446             $state->{'drives'}->{$in_drive}->{'barcode'} = undef;
1447             $state->{'drives'}->{$in_drive}->{'orig_slot'} = undef;
1448         }
1449
1450         $params{'finished_cb'}->();
1451     });
1452
1453     # if the source slot is loaded, then this is just a directed unload operation;
1454     # otherwise, it's a transfer.
1455     if (defined $in_drive) {
1456         Amanda::Debug::debug("move(): unloading drive $in_drive to slot $to_slot");
1457         $self->{'interface'}->unload($in_drive, $to_slot, $transfer_complete);
1458     } else {
1459         $self->{'interface'}->transfer($from_slot, $to_slot, $transfer_complete);
1460     }
1461 }
1462
1463 ##
1464 # Utilities
1465
1466 # calculate the next highest non-empty slot after $slot (assuming that
1467 # the changer status has been updated)
1468 sub _get_next_slot {
1469     my $self = shift;
1470     my ($state, $slot, $except_slots) = @_;
1471
1472     my @nonempty = sort { $a <=> $b } grep {
1473         $state->{'slots'}->{$_}->{'state'} == Amanda::Changer::SLOT_FULL
1474         and $self->_is_slot_allowed($_)
1475         and (!$except_slots || !$except_slots->{$_})
1476     } keys(%{$state->{'slots'}});
1477
1478     my @higher = grep { $_ > $slot } @nonempty;
1479
1480     # return the next higher slot, or the first nonempty slot (to loop around)
1481     return $higher[0] if (@higher);
1482     return $nonempty[0];
1483 }
1484
1485 # is $slot in the slots specified by the use-slots property?
1486 sub _is_slot_allowed {
1487     my $self = shift;
1488     my ($slot) = @_;
1489
1490     # if use-slots is not specified, all slots are available
1491     return 1 unless ($self->{'use_slots'});
1492
1493     for my $range (split ',', $self->{'use_slots'}) {
1494         my ($first, $last) = ($range =~ /(\d+)(?:-(\d+))?/);
1495         $last = $first unless defined($last);
1496         return 1 if ($slot >= $first and $slot <= $last);
1497     }
1498
1499     return 0;
1500 }
1501
1502 sub _debug {
1503     my $self = shift;
1504     my ($msg) = @_;
1505     # chg_name is not set until *after* the constructor finishes
1506     my $chg_name = $self->{'chg_name'} || $self->{'class_name'};
1507     debug("$chg_name: $msg");
1508 }
1509
1510 ##
1511 # Timing management
1512
1513 # Wait until the delay from the last operation has expired, and call the
1514 # given callback with the given arguments
1515 sub _after_delay {
1516     my $self = shift;
1517     my ($state, $cb, @args) = @_;
1518
1519     confess("undefined \$cb") unless (defined $cb);
1520
1521     # if the current time is before $start, then we'll perform the action anyway; this
1522     # saves us from long delays when clocks fall out of sync or run backward, but delays
1523     # are short.
1524     my ($start, $end, $now);
1525     $start = $state->{'last_operation_time'};
1526     if (!defined $start) {
1527         return $cb->(@args);
1528     }
1529
1530     $end = $start + $state->{'last_operation_delay'};
1531     $now = time;
1532
1533     if ($now >= $start and $now < $end) {
1534         Amanda::MainLoop::call_after(1000 * ($end - $now), $cb, @args);
1535     } else {
1536         return $cb->(@args);
1537     }
1538 }
1539
1540 # set the delay parameters in the statefile
1541 sub _set_delay {
1542     my $self = shift;
1543     my ($state, $delay) = @_;
1544
1545     $state->{'last_operation_time'} = time;
1546     $state->{'last_operation_delay'} = $delay;
1547 }
1548
1549 ##
1550 # Statefile management
1551
1552 # wrapper around Amanda::Changer's with_locked_state to lock the statefile and
1553 # then update the state with the results of the 'status' command.
1554 #
1555 # Like with_locked_state, this method assumes the keyword-based parameter
1556 # style, and adds a 'state' parameter with the new state.  Also like
1557 # with_locked_state, it replaces the $cbname key with a wrapped version of that
1558 # callback.  It then calls $sub.
1559 sub _with_updated_state {
1560     my $self = shift;
1561     my ($paramsref, $cbname, $sub) = @_;
1562     my %params = %$paramsref;
1563     my $state;
1564
1565     my $steps = define_steps
1566         cb_ref => \$paramsref->{$cbname};
1567
1568     step start => sub {
1569         $self->with_locked_state($self->{'statefile'},
1570             $params{$cbname}, $steps->{'got_lock'});
1571     };
1572
1573     step got_lock => sub {
1574         ($state, my $new_cb) = @_;
1575
1576         # set up params for calling through to $sub later
1577         $params{'state'} = $state;
1578         $params{$cbname} = $new_cb;
1579
1580         if (!keys %$state) {
1581             $state->{'slots'} = {};
1582             $state->{'drives'} = {};
1583             $state->{'drive_lru'} = [];
1584             $state->{'bc2lb'} = {};
1585             $state->{'current_slot'}{get_config_name()} = -1;
1586         }
1587
1588         if (defined $state->{'current_slot'} &&
1589             ref(\$state->{'current_slot'}) eq "SCALAR") {
1590             my $current_slot = $state->{'current_slot'};
1591             $state->{'current_slot'} = {get_config_name() => $current_slot};
1592         }
1593
1594         # this is for testing ONLY!
1595         $self->{'__last_state'} = $state;
1596
1597         # if it's not time for another run of the status command yet, then just skip to
1598         # the end.
1599         if (defined $state->{'last_status'}
1600             and time < $state->{'last_status'} + $self->{'status_interval'}) {
1601             $self->_debug("too early for another 'status' invocation");
1602             $steps->{'done'}->();
1603         } else {
1604             $steps->{'wait'}->();
1605         }
1606     };
1607
1608     step wait => sub {
1609         $self->_after_delay($state, $steps->{'call_status'});
1610     };
1611
1612     step call_status => sub {
1613         $self->{'interface'}->status($steps->{'status_cb'});
1614     };
1615
1616     step status_cb => sub {
1617         my ($err, $status) = @_;
1618         if ($err) {
1619             return $self->make_error("fatal", $params{$cbname},
1620                 message => $err);
1621         }
1622
1623         $state->{'last_status'} = time;
1624         $self->_debug("updating state");
1625
1626         # process the results; $status can update our slot->label
1627         # mapping, but the barcode->label mapping stays the same.
1628
1629         my $new_slots = {};
1630         my ($drv, $slot, $info);
1631
1632         # note that loaded_in is always undef; it will be set correctly
1633         # when the drives are scanned
1634         while (($slot, $info) = each %{$status->{'slots'}}) {
1635             if ($info->{'empty'}) {
1636                 # empty slot
1637                 $new_slots->{$slot} = {
1638                     state => Amanda::Changer::SLOT_EMPTY,
1639                     device_status => undef,
1640                     device_error => undef,
1641                     f_type => undef,
1642                     label => undef,
1643                     barcode => undef,
1644                     loaded_in => undef,
1645                     ie => $info->{'ie'},
1646                 };
1647                 next;
1648             }
1649
1650             if (defined $info->{'barcode'}) {
1651
1652                 my $label = $state->{'bc2lb'}->{$info->{'barcode'}};
1653
1654                 $new_slots->{$slot} = {
1655                     state => Amanda::Changer::SLOT_FULL,
1656                     device_status => $state->{'slots'}->{$slot}->{device_status},
1657                     device_error => $state->{'slots'}->{$slot}->{device_error},
1658                     f_type => $state->{'slots'}->{$slot}->{f_type},
1659                     label => $label,
1660                     barcode => $info->{'barcode'},
1661                     loaded_in => undef,
1662                     ie => $info->{'ie'},
1663                 };
1664             } else {
1665                 # assume the status of this slot has not changed since the last
1666                 # time we looked at it, although mark it as not loaded in a slot
1667                 if (exists $state->{'slots'}->{$slot}) {
1668                     $new_slots->{$slot} = $state->{'slots'}->{$slot};
1669                     $new_slots->{$slot}->{'loaded_in'} = undef;
1670                 } else {
1671                     $new_slots->{$slot} = {
1672                         state => Amanda::Changer::SLOT_FULL,
1673                         device_status => undef,
1674                         device_error => undef,
1675                         f_type => undef,
1676                         label => undef,
1677                         barcode => undef,
1678                         loaded_in => undef,
1679                         ie => $info->{'ie'},
1680                     };
1681                 }
1682             }
1683         }
1684         my $old_slots_state = $state->{'slots'};
1685         $state->{'slots'} = $new_slots;
1686
1687         # now handle the drives
1688         my $new_drives = {};
1689         while (($drv, $info) = each %{$status->{'drives'}}) {
1690             my $old_drive = $state->{'drives'}->{$drv};
1691
1692             # if this drive still has a valid reservation, don't change it
1693             if (defined $old_drive->{'res_info'}
1694                         and $self->_res_info_verify($old_drive->{'res_info'})) {
1695                 $new_drives->{$drv} = $old_drive;
1696                 next;
1697             }
1698
1699             # if the drive is empty, this is pretty easy
1700             if (!defined $info) {
1701                 $new_drives->{$drv} = {
1702                     state => Amanda::Changer::SLOT_EMPTY,
1703                     label => undef,
1704                     barcode => undef,
1705                     orig_slot => undef,
1706                 };
1707                 next;
1708             }
1709
1710             # trust our own orig_slot over that from the changer, if possible,
1711             # as some changers do not report this information accurately
1712             my ($orig_slot, $label);
1713             if (defined $old_drive->{'orig_slot'}) {
1714                 $orig_slot = $old_drive->{'orig_slot'};
1715                 $label = $old_drive->{'label'};
1716             }
1717
1718             # but don't trust it if the barcode has changed
1719             if (defined $info->{'barcode'}
1720                     and defined $old_drive->{'barcode'}
1721                     and $info->{'barcode'} ne $old_drive->{'barcode'}) {
1722                 $orig_slot = undef;
1723                 $label = undef;
1724             }
1725
1726             # get the robot's notion of the original slot if we don't know ourselves
1727             if (!defined $orig_slot) {
1728                 $orig_slot = $info->{'orig_slot'};
1729             }
1730
1731             # but if there's a tape in that slot, then we've got a problem
1732             if (defined $orig_slot
1733                     and $state->{'slots'}->{$orig_slot}->{'state'} != Amanda::Changer::SLOT_EMPTY) {
1734                 warning("mtx indicates tape in drive $drv should go to slot $orig_slot, " .
1735                         "but that slot is not empty.");
1736                 $orig_slot = undef;
1737                 for my $slot (keys %{ $state->{'slots'} }) {
1738                     if ($state->{'slots'}->{$slot}->{'state'} == Amanda::Changer::SLOT_EMPTY) {
1739                         $orig_slot = $slot;
1740                         last;
1741                     }
1742                 }
1743                 if (!defined $orig_slot) {
1744                     warning("cannot find an empty slot for the tape in drive $drv");
1745                 }
1746             }
1747
1748             # and look up the label by barcode if possible
1749             if (!defined $label && defined $info->{'barcode'}) {
1750                 $label = $state->{'bc2lb'}->{$info->{'barcode'}};
1751             }
1752
1753             $new_drives->{$drv} = {
1754                 state => Amanda::Changer::SLOT_FULL,
1755                 label => $label,
1756                 barcode => $info->{'barcode'},
1757                 orig_slot => $orig_slot,
1758             };
1759         }
1760         $state->{'drives'} = $new_drives;
1761
1762         # update the loaded_in info for the relevant slots
1763         while (($drv, $info) = each %$new_drives) {
1764             # also update the slots with the relevant 'loaded_in' info
1765             if (defined $info->{'orig_slot'}) {
1766                 my $old_state = $old_slots_state->{$info->{'orig_slot'}};
1767                 $state->{'slots'}->{$info->{'orig_slot'}} = {
1768                     state => $info->{'state'},
1769                     device_status => $old_state->{'device_status'},
1770                     device_error => $old_state->{'device_error'},
1771                     f_type => $old_state->{'f_type'},
1772                     label => $info->{'label'},
1773                     barcode => $info->{'barcode'},
1774                     loaded_in => $drv,
1775                 };
1776             }
1777         }
1778
1779         # sanity check that we don't have tape-device info for nonexistent drives
1780         for my $dr (@{$self->{'driveorder'}}) {
1781             if (!exists $state->{'drives'}->{$dr}) {
1782                 warning("tape-device property specified for drive $dr, but no such " .
1783                         "drive exists in the library");
1784             }
1785         }
1786
1787         if (!defined $state->{'current_slot'}{get_config_name()} ||
1788             $state->{'current_slot'}{get_config_name()} == -1) {
1789             $state->{'current_slot'}{get_config_name()} = $self->_get_next_slot($state, -1);
1790         }
1791
1792         $steps->{'done'}->();
1793     };
1794
1795     step done => sub {
1796         # finally, call through to the user's method; $params{$cbname} has been
1797         # properly patched to release the state lock when this method is done.
1798         $sub->(%params);
1799     };
1800 }
1801
1802 ##
1803 # reservation records
1804
1805 # A reservation record is recorded in the statefile, and is distinct from an
1806 # Amanda::Changer::robot:Reservation object in that it is seen by all users of
1807 # the tape device, whether in this process or another.
1808 #
1809 # This is abstracted out to enable support for a more robust mechanism than
1810 # caching a pid.
1811
1812 sub _res_info_new {
1813     my $self = shift;
1814     return { pid => $$, };
1815 }
1816
1817 sub _res_info_verify {
1818     my $self = shift;
1819     my ($res_info) = @_;
1820
1821     # true if this is our reservation
1822     return 1 if ($res_info->{'pid'} == $$);
1823
1824     # or if the process is dead
1825     return kill 0, $res_info->{'pid'};
1826 }
1827
1828 sub _res_info_is_mine {
1829     my $self = shift;
1830     my ($res_info) = @_;
1831
1832     return 1 if ($res_info and $res_info->{'pid'} == $$);
1833 }
1834
1835 package Amanda::Changer::robot::Reservation;
1836 use vars qw( @ISA );
1837 use Amanda::Debug qw( debug warning );
1838 @ISA = qw( Amanda::Changer::Reservation );
1839
1840 sub new {
1841     my $class = shift;
1842     my ($chg, $slot, $drive, $device, $barcode) = @_;
1843     my $self = Amanda::Changer::Reservation::new($class);
1844
1845     $self->{'chg'} = $chg;
1846
1847     $self->{'drive'} = $drive;
1848     $self->{'device'} = $device;
1849     $self->{'this_slot'} = $slot;
1850     $self->{'barcode'} = $barcode;
1851
1852     return $self;
1853 }
1854
1855 sub do_release {
1856     my $self = shift;
1857     my %params = @_;
1858
1859     # if we're in global cleanup and the changer is already dead,
1860     # then never mind
1861     return unless $self->{'chg'};
1862
1863     # unref the device, for good measure
1864     $self->{'device'} = undef;
1865
1866     # punt this method off to the changer itself, optionally calling
1867     # the unlocked version if we have the 'state' parameter
1868     if (exists $params{'unlocked'} and exists $params{'state'}) {
1869         $self->{'chg'}->_release_unlocked(drive => $self->{'drive'}, %params);
1870     } else {
1871         $self->{'chg'}->_release(drive => $self->{'drive'}, %params);
1872     }
1873 }
1874
1875 sub set_label {
1876     my $self = shift;
1877     my %params = @_;
1878
1879     return unless $self->{'chg'};
1880     $self->{'chg'}->_set_label(drive => $self->{'drive'},
1881                                dev => $self->{device}, %params);
1882 }
1883
1884 package Amanda::Changer::robot::Interface;
1885
1886 # The physical interface to the changer is abstracted out to allow several
1887 # implementations (see chg-ndmp for one of them).  This API is "reasonably
1888 # stable", but is really only known to this changer and its subclasses, so it's
1889 # not documented in POD.  The methods are:
1890 #
1891 #   $iface->inquiry($inquiry_cb);
1892 #
1893 # Inquire as to the relevant information about the changer.  The result is a
1894 # hash table of lowercased key names and values, $info.  The inquiry_cb is
1895 # called as $inquiry_cb->($errmsg, $info).  The resulting strings have quotes
1896 # and whitespace stripped.  Keys include 'vendor id' and 'product id'.
1897 #
1898 #   $iface->status($status_cb)
1899 #
1900 # Get the READ ELEMENT STATUS output for the changer.  The status_cb is called
1901 # as $status_cb->($errmsg, $status).  $status is a hash with keys 'drives' and
1902 # 'slots', each of which is a hash indexed by the element address (note that drive
1903 # element addresses can and usually do overlap with slots.  The values of the slots
1904 # hash are hashes with keys
1905 #  - 'empty' (1 if the slot is empty)
1906 #  - 'barcode' (which may be undef if the changer does not support barcodes)
1907 #  - 'ie' (a boolean indicating whether this is an import/export slot).
1908 # The values of the drives are undef for empty drive, or hashes with keys
1909 #  - 'barcode' (which may be undef if the changer does not support barcodes)
1910 #  - 'orig_slot' (slot from which this volume was taken, if known)
1911 #
1912 #   $iface->load($slot, $drive, $finished_cb)
1913 #
1914 # Load $slot into $drive.  The finished_cb gets a single argument, $error,
1915 # which is only defined if an error occurred.  Note that this does not
1916 # necessarily wait until the load operation is complete (most drives give
1917 # no such indication) (this method also implements unload, if $un=1)
1918 #
1919 #   $iface->unload($drive, $slot, $finished_cb);
1920 #
1921 # Unload $drive into $slot.  Finished_cb is just as for load().
1922 #
1923 #   $iface->eject($drive_name, $finished_cb);
1924 #
1925 # Eject $drive_name (named /dev/whatever, not the drive number), and call finished_cb.
1926 #
1927 #   $iface->transfer($src_slot, $dst_slot, $finished_cb);
1928 #
1929 # Move the tape in $src_slot into $dst_slot.  The finished_cb gets a single
1930 # argument, $error, which is only defined if an error occurred.  Note that this
1931 # does not necessarily wait until the load operation is complete.
1932
1933 package Amanda::Changer::robot::Interface::MTX;
1934
1935 use Amanda::Paths;
1936 use Amanda::Config qw( :getconf );
1937 use Amanda::Debug qw( debug warning );
1938 use Amanda::MainLoop qw( :GIOCondition synchronized make_cb define_steps step );
1939 use Amanda::Device qw( :constants );
1940
1941 sub new {
1942     my $class = shift;
1943     my ($device_name, $mtx, $ignore_barcodes) = @_;
1944
1945     unless (-e $device_name) {
1946         return Amanda::Changer->make_error("fatal", undef,
1947             message => "'$device_name' not found");
1948     }
1949
1950     return bless {
1951         # This object uses a big lock to block *all* operations, not just mtx
1952         # invocations.  This allows us to add delays to certain operations, while still
1953         # holding the lock.
1954         lock => [],
1955         device_name => $device_name,
1956         mtx => $mtx,
1957         ignore_barcodes => $ignore_barcodes,
1958     }, $class;
1959 }
1960
1961 sub inquiry {
1962     my $self = shift;
1963     my ($inquiry_cb) = @_;
1964
1965     synchronized($self->{'lock'}, $inquiry_cb, sub {
1966         my ($inquiry_cb) = @_;
1967         my $sys_cb = make_cb(sys_cb => sub {
1968             my ($exitstatus, $output) = @_;
1969             if ($exitstatus != 0) {
1970                 return $inquiry_cb->("error from mtx: " . $output, {});
1971             } else {
1972                 my %info;
1973                 for my $line (split '\n', $output) {
1974                     if (my ($k, $v) = ($line =~ /^(.*):\s*(.*)$/)) {
1975                         $v =~ s/^'(.*)'$/$1/;
1976                         $v =~ s/\s*$//;
1977                         $info{lc $k} = $v;
1978                     }
1979                 }
1980                 return $inquiry_cb->(undef, \%info);
1981             }
1982
1983         });
1984         $self->_run_system_command($sys_cb,
1985             $self->{'mtx'}, "-f", $self->{'device_name'}, 'inquiry');
1986     });
1987 }
1988
1989 sub status {
1990     my $self = shift;
1991     my ($status_cb) = @_;
1992
1993     synchronized($self->{'lock'}, $status_cb, sub {
1994         my ($status_cb) = @_;
1995         my ($counter) = 120;
1996
1997         my $sys_cb;
1998         my $run_mtx = make_cb(run_mtx => sub {
1999             my @nobarcode = ('nobarcode') if $self->{'ignore_barcodes'};
2000             $self->_run_system_command($sys_cb,
2001                     $self->{'mtx'}, "-f", $self->{'device_name'}, @nobarcode,
2002                     'status');
2003         });
2004
2005         $sys_cb = make_cb(sys_cb => sub {
2006             my ($exitstatus, $output) = @_;
2007             if ($exitstatus != 0) {
2008                 my $err = $output;
2009                 # if it's a regular SCSI error, just show the sense key
2010                 my ($sensekey) = ($err =~ /mtx: Request Sense: Sense Key=(.*)\n/);
2011                 $err = "SCSI error; Sense Key=$sensekey" if $sensekey;
2012                 $counter--;
2013                 if ($sensekey eq "Not Ready" and $counter > 0) {
2014                     debug("$output");
2015                     return Amanda::MainLoop::call_after(1000, $run_mtx);
2016                 }
2017                 return $status_cb->("error from mtx: " . $err, {});
2018             } else {
2019                 my %status;
2020                 for my $line (split '\n', $output) {
2021                     debug("mtx: $line");
2022                     my ($slot, $ie, $slinfo);
2023
2024                     # drives (data transfer elements)
2025                     if (($slot, $slinfo) = ($line =~
2026                                 /^Data Transfer Element\s*(\d+)?\s*:\s*(.*)/i)) {
2027                         # assume 0 when not given a drive #
2028                         $slot = 0 unless defined $slot;
2029                         if ($slinfo =~ /^Empty/i) {
2030                             $status{'drives'}->{$slot} = undef;
2031                         } elsif ($slinfo =~ /^Full/i) {
2032                             my ($barcode, $orig_slot);
2033                             ($barcode) = ($slinfo =~ /:VolumeTag\s*=\s*(\S+)/i);
2034                             ($orig_slot) = ($slinfo =~ /\(Storage Element (\d+) Loaded\)/i);
2035                             $status{'drives'}->{$slot} = {
2036                                 barcode => $barcode,
2037                                 orig_slot => $orig_slot,
2038                             };
2039                         }
2040
2041                     # slots (storage elements)
2042                     } elsif (($slot, $ie, $slinfo) = ($line =~
2043                                 /^\s*Storage Element\s*(\d+)\s*(IMPORT\/EXPORT)?\s*:\s*(.*)/i)) {
2044                         $ie = $ie? 1 : 0;
2045                         if ($slinfo =~ /^Empty/i) {
2046                             $status{'slots'}->{$slot} = {
2047                                 empty => 1,
2048                                 ie => $ie,
2049                             };
2050                         } elsif ($slinfo =~ /^Full/i) {
2051                             my $barcode;
2052                             ($barcode) = ($slinfo =~ /:VolumeTag\s*=\s*(\S+)/i)
2053                                 unless ($self->{'ignore_barcodes'});
2054                             $status{'slots'}->{$slot} = {
2055                                 barcode => $barcode,
2056                                 ie => $ie,
2057                             };
2058                         }
2059                     }
2060                 }
2061
2062                 return $status_cb->(undef, \%status);
2063             }
2064
2065         });
2066         $run_mtx->();
2067     });
2068 }
2069
2070 sub load {
2071     my $self = shift;
2072     my ($slot, $drive, $finished_cb, $un) = @_;
2073
2074     synchronized($self->{'lock'}, $finished_cb, sub {
2075         my ($finished_cb) = @_;
2076
2077         my $sys_cb = make_cb(sys_cb => sub {
2078             my ($exitstatus, $output) = @_;
2079             if ($exitstatus != 0) {
2080                 return $finished_cb->("error from mtx: " . $output);
2081             } else {
2082                 return $finished_cb->(undef);
2083             }
2084
2085         });
2086
2087         $self->_run_system_command($sys_cb,
2088             $self->{'mtx'}, "-f", $self->{'device_name'},
2089                             $un? 'unload':'load', $slot, $drive);
2090     });
2091 }
2092
2093 sub unload {
2094     my $self = shift;
2095     my ($drive, $slot, $finished_cb) = @_;
2096     return $self->load($slot, $drive, $finished_cb, 1);
2097 }
2098
2099 sub transfer {
2100     my $self = shift;
2101     my ($src_slot, $dst_slot, $finished_cb) = @_;
2102
2103     synchronized($self->{'lock'}, $finished_cb, sub {
2104         my ($finished_cb) = @_;
2105
2106         my $sys_cb = make_cb(sys_cb => sub {
2107             my ($exitstatus, $output) = @_;
2108             if ($exitstatus != 0) {
2109                 return $finished_cb->("error from mtx: " . $output);
2110             } else {
2111                 return $finished_cb->(undef);
2112             }
2113
2114         });
2115         $self->_run_system_command($sys_cb,
2116             $self->{'mtx'}, "-f", $self->{'device_name'},
2117                             'transfer', $src_slot, $dst_slot);
2118     });
2119 }
2120
2121 # Run 'mtx' and capture the output.  Standard output and error
2122 # are lumped together.
2123 #
2124 # @param $sys_cb: called with ($exitstatus, $output)
2125 # @param @args: args to pass to exec()
2126 sub _run_system_command {
2127     my ($self, $sys_cb, @args) = @_;
2128
2129     debug("invoking " . join(" ", @args));
2130
2131     my ($readfd, $writefd) = POSIX::pipe();
2132     if (!defined($writefd)) {
2133         confess("Error creating pipe: $!");
2134     }
2135
2136     my $pid = fork();
2137     if (!defined($pid) or $pid < 0) {
2138         confess("Can't fork to run changer script: $!");
2139     }
2140
2141     if (!$pid) {
2142         ## child
2143
2144         # get our file-handle house in order
2145         POSIX::close($readfd);
2146         POSIX::dup2($writefd, 1);
2147         POSIX::dup2($writefd, 2);
2148         POSIX::close($writefd);
2149
2150         %ENV = Amanda::Util::safe_env();
2151
2152         { exec { $args[0] } @args; } # braces protect against warning
2153         exit 127;
2154     }
2155
2156     ## parent
2157
2158     # clean up file descriptors from the fork
2159     POSIX::close($writefd);
2160
2161     # the callbacks that follow share these lexical variables
2162     my $child_eof = 0;
2163     my $child_output = '';
2164     my $child_dead = 0;
2165     my $child_exit_status = 0;
2166     my ($fdsrc, $cwsrc);
2167     my $open_sources = 0;
2168
2169     my $steps = define_steps
2170         cb_ref => \$sys_cb;
2171
2172     step setup => sub {
2173         $open_sources++;
2174         Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP)
2175             ->set_callback($steps->{'fd_source_cb'});
2176
2177         $open_sources++;
2178         Amanda::MainLoop::child_watch_source($pid)
2179             ->set_callback($steps->{'child_watch_source_cb'});
2180     };
2181
2182     step immediate => 1,
2183          fd_source_cb => sub {
2184         my ($fdsrc) = @_;
2185         my ($len, $bytes);
2186         $len = POSIX::read($readfd, $bytes, 1024);
2187
2188         # if we got an EOF, shut things down.
2189         if ($len == 0) {
2190             $child_eof = 1;
2191             POSIX::close($readfd);
2192             $fdsrc->remove();
2193             $fdsrc = undef; # break a reference loop
2194             $steps->{'maybe_finished'}->();
2195         } else {
2196             # otherwise, just keep the bytes
2197             $child_output .= $bytes;
2198         }
2199     };
2200
2201     step immediate => 1,
2202          child_watch_source_cb => sub {
2203         my ($cwsrc, $got_pid, $got_status) = @_;
2204         $cwsrc->remove();
2205         $cwsrc = undef; # break a reference loop
2206         $child_dead = 1;
2207         $child_exit_status = $got_status;
2208
2209         $steps->{'maybe_finished'}->();
2210     };
2211
2212     step maybe_finished => sub {
2213         return if --$open_sources;
2214
2215         # everything is finished -- process the results and invoke the callback
2216         chomp $child_output;
2217
2218         # let the callback take care of any further interpretation
2219         my $exitval = POSIX::WEXITSTATUS($child_exit_status);
2220         $sys_cb->($exitval, $child_output);
2221     };
2222 }
2223
2224 1;