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

   1 # Copyright (c) 2009,2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This library is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU Lesser General Public License version 2.1 as
   5 # published by the Free Software Foundation.
   6 #
   7 # This library is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  10 # License for more details.
  11 #
  12 # You should have received a copy of the GNU Lesser General Public License
  13 # along with this library; if not, write to the Free Software Foundation,
  14 # Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
  15 #
  16 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 package Amanda::Changer::ndmp;
  20
  21 use strict;
  22 use warnings;
  23 use Carp;
  24 use base 'Amanda::Changer::robot';
  25
  26 use Amanda::MainLoop;
  27 use Amanda::Config qw( :getconf );
  28 use Amanda::Debug qw( debug warning );
  29 use Amanda::Device qw( :constants );
  30 use Amanda::Changer;
  31 use Amanda::NDMP;
  32
  33 =head1 NAME
  34
  35 Amanda::Changer::ndmp -- subclass of Amanda::Changer:robot to handle NDMP-based changers
  36
  37 =head1 DESCRIPTION
  38
  39 This package controls a physical tape changer via NDMP.
  40
  41 See the amanda-changers(7) manpage for usage information.
  42
  43 =cut
  44
  45 # NOTES
  46 #
  47 # This class relies on Amanda::Changer::robot for most of its functionality,
  48 # but overrides it to insert its own Interface class (that speaks NDMP) and to
  49 # create NDMP devices instead of tape devices.
  50
  51 sub get_interface {
  52     my $self = shift;
  53     my ($device_name, $ignore_barcodes) = @_;
  54
  55     my ($host, $port, $scsi_dev) = ($device_name =~ /([^:@]*)(?::(\d*))?@(.*)/);
  56     if (!$host) {
  57         return Amanda::Changer->make_error("fatal", undef,
  58             message => "invalid chg-ndmp specification '$device_name'");
  59     }
  60     $port = $port? ($port+0) : 0; # 0 => default port
  61
  62     $self->{'ndmp-username'} = 'ndmp';
  63     $self->{'ndmp-password'} = 'ndmp';
  64     $self->{'ndmp-auth'} = 'md5';
  65     $self->{'verbose'} = 0;
  66     for my $propname (qw(ndmp-username ndmp-password ndmp-auth verbose)) {
  67         if (exists $self->{'config'}->{'properties'}->{$propname}) {
  68             if (@{$self->{'config'}->{'properties'}->{$propname}->{'values'}} > 1) {
  69                 return Amanda::Changer->make_error("fatal", undef,
  70                     message => "only one value allowed for '$propname'");
  71             }
  72             $self->{$propname} = $self->{'config'}->{'properties'}->{$propname}->{'values'}->[0];
  73         }
  74     }
  75
  76     # assemble the arguments to NDMPConnection's constructor, so that the interface
  77     # can create a connection as needed
  78     my $connargs = [ $host, $port,
  79                      $self->{'ndmp-username'}, $self->{'ndmp-password'},
  80                      $self->{'ndmp-auth'} ];
  81
  82     return Amanda::Changer::ndmp::Interface->new($connargs, $scsi_dev, $ignore_barcodes,
  83                                                  $self->{'verbose'}),
  84 }
  85
  86 sub get_device {
  87     my $self = shift;
  88     my ($device_name) = @_;
  89
  90     my $device = Amanda::Changer::robot::get_device($self, $device_name);
  91
  92     # set the authentication properties for the new device based on our
  93     # own settings, but only if they haven't been set by the user
  94     my ($val, $surety, $source);
  95
  96     ($val, $surety, $source)= $device->property_get("ndmp-auth");
  97     $device->property_set("ndmp-auth", $self->{'ndmp-auth'})
  98         if ($source == $PROPERTY_SOURCE_DEFAULT);
  99
 100     ($val, $surety, $source)= $device->property_get("ndmp-password");
 101     $device->property_set("ndmp-password", $self->{'ndmp-password'})
 102         if ($source == $PROPERTY_SOURCE_DEFAULT);
 103
 104     ($val, $surety, $source)= $device->property_get("ndmp-username");
 105     $device->property_set("ndmp-username", $self->{'ndmp-username'})
 106         if ($source == $PROPERTY_SOURCE_DEFAULT);
 107
 108     return $device;
 109 }
 110
 111 package Amanda::Changer::ndmp::Interface;
 112
 113 use Amanda::NDMP qw( :constants );
 114 use Amanda::Debug qw( debug warning );
 115 use Amanda::MainLoop;
 116
 117 sub new {
 118     my $class = shift;
 119     my ($connargs, $scsi_dev, $ignore_barcodes, $verbose) = @_;
 120
 121     return bless {
 122         connargs => $connargs,
 123         scsi_dev => $scsi_dev,
 124         ignore_barcodes => $ignore_barcodes,
 125         verbose => $verbose,
 126
 127         # have we called READ ELEMENT STATUS yet?
 128         have_status => 0,
 129
 130         # this class manages the translation of SCSI element numbers to what we
 131         # will call 'mtx numbers', just like mtx itself does.  Specifically,
 132         # drives are numbered starting at 0 and slots are numbered starting at
 133         # 1.  These hashes map mtx numbers to scsi element numbers, and are set
 134         # by status()
 135         drive_scsi_elem_map => {},
 136         slot_scsi_elem_map => {},
 137
 138         # to use MOVE MEDIUM, we need a medium transport element, which is stashed
 139         # here
 140         medium_transport_element => undef,
 141     }, $class;
 142 }
 143
 144 sub inquiry {
 145     my $self = shift;
 146     my ($inquiry_cb) = @_;
 147
 148     my $conn = $self->_get_scsi_conn(\$inquiry_cb);
 149     return $inquiry_cb->($conn->err_msg()) if $conn->err_code();
 150
 151     # send a TEST UNIT READY first
 152     my $res = $conn->scsi_execute_cdb(
 153         flags => 0,
 154         timeout => 1*1000,
 155         cdb => pack('CxxxxC', 0, 0)
 156     );
 157     if (!$res) {
 158         return $inquiry_cb->($conn->err_msg());
 159     }
 160     if ($res->{'status'} != 0) {
 161         my $sense_info = $self->_get_scsi_err($res);
 162         return $inquiry_cb->("TEST UNIT READY failed: $sense_info");
 163     }
 164
 165     # now send an INQUIRY
 166     $res = $conn->scsi_execute_cdb(
 167         flags => $NDMP9_SCSI_DATA_DIR_IN,
 168         timeout => 5*1000,
 169         cdb => pack('CCCnC', 0x12, 0, 0, 96, 0),
 170         datain_len => 96
 171     );
 172     if (!$res) {
 173         return $inquiry_cb->($conn->err_msg());
 174     }
 175     if ($res->{'status'} != 0) {
 176         my $sense_info = $self->_get_scsi_err($res);
 177         return $inquiry_cb->("INQUIRY failed: $sense_info");
 178     }
 179
 180     # check that this is a media changer
 181     if (ord(substr($res->{'datain'}, 0, 1)) != 8) {
 182         return $inquiry_cb->("not a SCSI media changer device");
 183     }
 184
 185     # extract the data we want
 186     my $result = {
 187         'vendor id' => $self->_trim_scsi(substr($res->{'datain'}, 8, 8)),
 188         'product id' => $self->_trim_scsi(substr($res->{'datain'}, 16, 16)),
 189         'revision' => $self->_trim_scsi(substr($res->{'datain'}, 32, 4)),
 190         'product type' => "Medium Changer",
 191     };
 192
 193     return $inquiry_cb->(undef, $result);
 194 }
 195
 196 sub status {
 197     my $self = shift;
 198     my ($status_cb) = @_;
 199
 200     # the SMC spec says we can "query" the length of the READ ELEMENT STATUS
 201     # result by passing an initial datain_len of 8, so that's what we do.  This
 202     # variable will be changed, later
 203     my $bufsize = 8;
 204
 205     my $conn = $self->_get_scsi_conn(\$status_cb);
 206     return $status_cb->($conn->err_msg()) if $conn->err_code();
 207
 208 send_cdb:
 209     my $res = $conn->scsi_execute_cdb(
 210         flags => $NDMP9_SCSI_DATA_DIR_IN,
 211         timeout => 60*1000, # 60-second timeout
 212         cdb => pack('CCnnCCnxC',
 213             0xB8, # opcode
 214             0x10, # VOLTAG, all element types
 215             0, # start at addr 0
 216             0xffff, # and give me 65535 elements
 217             2, # CURDATA=1, so the robot should use its cached state
 218             $bufsize >> 16, # allocation length high byte
 219             $bufsize & 0xffff, # allocation length low short
 220             0), # control
 221         datain_len => $bufsize
 222     );
 223     if (!$res) {
 224         return $status_cb->($conn->err_msg());
 225     }
 226     if ($res->{'status'} != 0) {
 227         my $sense_info = $self->_get_scsi_err($res);
 228         return $status_cb->("READ ELEMENT STATUS failed: $sense_info");
 229     }
 230
 231     # if we only got the size, then send another request
 232     if ($bufsize == 8) {
 233         my ($msb, $lsw) = unpack("Cn", substr($res->{'datain'}, 5, 3));
 234         $bufsize = ($msb << 16) + $lsw;
 235         $bufsize += 8; # add the header length
 236         if ($bufsize > 8) {
 237             goto send_cdb;
 238         } else {
 239             return $status_cb->("got short result from READ ELEMENT STATUS");
 240         }
 241     }
 242
 243     $self->{'have_status'} = 1;
 244
 245     # parse it and invoke the callback
 246     $status_cb->(undef, $self->_parse_read_element_status($res->{'datain'}));
 247 }
 248
 249 sub load {
 250     my $self = shift;
 251     my ($slot, $drive, $finished_cb) = @_;
 252
 253     return $self->_do_move_medium("load", $slot, $drive, $finished_cb);
 254 }
 255
 256 sub unload {
 257     my $self = shift;
 258     my ($drive, $slot, $finished_cb) = @_;
 259
 260     return $self->_do_move_medium("unload", $drive, $slot, $finished_cb);
 261 }
 262
 263 sub transfer {
 264     my $self = shift;
 265     my ($slot1, $slot2, $finished_cb) = @_;
 266
 267     return $self->_do_move_medium("transfer", $slot1, $slot2, $finished_cb);
 268 }
 269
 270 sub _do_move_medium {
 271     my $self = shift;
 272     my ($op, $src, $dst, $finished_cb) = @_;
 273     my $conn;
 274     my $steps = define_steps
 275         cb_ref => \$finished_cb;
 276
 277     step get_conn => sub {
 278         $conn = $self->_get_scsi_conn(\$finished_cb);
 279         return $finished_cb->($conn->err_msg()) if $conn->err_code();
 280
 281         $steps->{'get_status'}->();
 282     };
 283
 284     step get_status => sub {
 285         if ($self->{'have_status'}) {
 286             return $steps->{'send_move_medium'}->();
 287         } else {
 288             $self->status(sub {
 289                 my ($err, $status) = @_;
 290                 return $finished_cb->($err) if ($err);
 291                 return $steps->{'send_move_medium'}->();
 292             });
 293         }
 294     };
 295
 296     step send_move_medium => sub {
 297         # figure out what $slot and $drive are in terms of elements
 298         my ($src_elem, $dst_elem);
 299         if ($op eq "load") {
 300             $src_elem = $self->{'slot_scsi_elem_map'}->{$src};
 301             $dst_elem = $self->{'drive_scsi_elem_map'}->{$dst};
 302         } elsif ($op eq "unload") {
 303             $src_elem = $self->{'drive_scsi_elem_map'}->{$src};
 304             $dst_elem = $self->{'slot_scsi_elem_map'}->{$dst};
 305         } elsif ($op eq "transfer") {
 306             $src_elem = $self->{'slot_scsi_elem_map'}->{$src};
 307             $dst_elem = $self->{'slot_scsi_elem_map'}->{$dst};
 308         }
 309
 310         unless (defined $src_elem) {
 311             return $finished_cb->("unknown source slot/drive '$src'");
 312         }
 313
 314         unless (defined $dst_elem) {
 315             return $finished_cb->("unknown destiation slot/drive '$dst'");
 316         }
 317
 318         # send a MOVE MEDIUM command
 319         my $res = $conn->scsi_execute_cdb(
 320             # mtx uses data dir "out", but ndmjob uses 0.  A NetApp filer
 321             # segfaults with data dir "out", so we use 0.
 322             flags => $NDMP9_SCSI_DATA_DIR_NONE,
 323             dataout => '',
 324             # NOTE: 0 does not mean "no timeout"; it means "fail immediately"
 325             timeout => 300000,
 326             cdb => pack('CxnnnxxxC',
 327                 0xA5, # MOVE MEDIUM
 328                 $self->{'medium_transport_elem'},
 329                 $src_elem,
 330                 $dst_elem,
 331                 0) # control
 332         );
 333
 334         $steps->{'scsi_done'}->($res);
 335     };
 336
 337     step scsi_done => sub {
 338         my ($res) = @_;
 339
 340         if (!$res) {
 341             return $finished_cb->($conn->err_msg());
 342         }
 343         if ($res->{'status'} != 0) {
 344             my $sense_info = $self->_get_scsi_err($res);
 345             return $finished_cb->("MOVE MEDIUM failed: $sense_info");
 346         }
 347
 348         return $finished_cb->(undef);
 349     };
 350 }
 351
 352 # a selected set of errors we might see; keyed by ASC . ASCQ
 353 my %scsi_errors = (
 354     '0500' => "Logical Unit Does Not Respond To Selection",
 355     '0600' => "No Reference Position Found",
 356     '2101' => "Invalid element address",
 357     '3003' => "Cleaning Cartridge Installed",
 358     '3b0d' => "Medium Destination Element Full",
 359     '3b0e' => "Medium Source Element Empty",
 360     '3b11' => "Medium Magazine Not Accessible",
 361     '3b12' => "Medium Magazine Removed",
 362     '3b13' => "Medium Magazine Inserted",
 363     '3b14' => "Medium Magazine Locked",
 364     '3b15' => "Medium Magazine Unlocked",
 365     '3b18' => "Element Disabled",
 366 );
 367
 368 sub _get_scsi_err {
 369     my $self = shift;
 370     my ($res) = @_;
 371
 372     if (($res->{'status'} & 0x3E) == 2) { # CHECK CONDITION
 373         my @sense_data = map { ord($_) } split //, $res->{'ext_sense'};
 374         my $sense_key = $sense_data[1] & 0xF;
 375         my $sense_code = $sense_data[2];
 376         my $sense_code_qualifier = $sense_data[3];
 377         my $ascascq = sprintf("%02x%02x", $sense_code, $sense_code_qualifier);
 378         my $msg = "CHECK CONDITION: ";
 379         if (exists $scsi_errors{$ascascq}) {
 380             $msg .= $scsi_errors{$ascascq} . ' - ';
 381         }
 382         $msg .= sprintf("sense key 0x%2.2x, sense code 0x%2.2x, qualifier 0x%2.2x",
 383             $sense_key, $sense_code, $sense_code_qualifier);
 384         return $msg;
 385     } else {
 386         return "unexepected SCSI status $res->{status}";
 387     }
 388 }
 389
 390 ## non-method utilities
 391
 392 sub _trim_scsi {
 393     my $self = shift;
 394     my ($val) = @_;
 395     $val =~ s/^[ \0]*//;
 396     $val =~ s/[ \0]*$//;
 397     return $val;
 398 }
 399
 400 sub _parse_read_element_status {
 401     my $self = shift;
 402     my ($data) = @_;
 403
 404     # this is based on SMC-3 section 6.11.  Not all fields are converted.  Note
 405     # that unpack() does not support 3-byte integers, so this extracts the msb
 406     # (most significant byte) and lsw (least significant word) and combines them
 407     # $data is consumed piecemeal throughout the following.  Constants are included
 408     # inline, with a comment to indicate their meaning
 409
 410     my $result = { drives => {}, slots => {} };
 411     my $next_drive_num = 0;
 412     my $next_slot_num = 1;
 413     my %slots_by_elem; # inverse of $self->{slot_scsi_elem_map}
 414
 415     # element status header
 416     my ($first_elem, $num_elems) = unpack("nn", substr($data, 0, 4));
 417     $data = substr($data, 8);
 418
 419     while ($data and $num_elems) { # for each element status page
 420         my ($elem_type, $flags, $descrip_len, $all_descrips_len_msb,
 421             $all_descrips_len_lsw) = unpack("CCnxCn", substr($data, 0, 8));
 422         my $all_descrips_len = ($all_descrips_len_msb << 16) + $all_descrips_len_lsw;
 423         my $have_pvoltag = $flags & 0x80;
 424         my $have_avoltag = $flags & 0x40;
 425         die unless $all_descrips_len % $descrip_len == 0;
 426         die unless $all_descrips_len >= $descrip_len;
 427         die length($data) unless $all_descrips_len <= length($data);
 428         $data = substr($data, 8);
 429
 430         while ($all_descrips_len > 0) { # for each element status descriptor
 431             my $descripdata  = substr($data, 0, $descrip_len);
 432
 433             my ($elem_addr, $flags, $asc, $ascq, $flags2, $src_addr) =
 434                 unpack("nCxCCxxxCn", substr($descripdata, 0, 12));
 435             my $except_flag = $flags & 0x04;
 436             my $full_flag = $flags & 0x01;
 437             my $svalid_flag = $flags2 & 0x80;
 438             my $invert_flag = $flags2 & 0x40;
 439             my $ed_flag = $flags2 & 0x08;
 440             $descripdata = substr($descripdata, 12);
 441
 442             my ($pvoltag, $avoltag);
 443             if ($have_pvoltag) {
 444                 $pvoltag = $self->_trim_scsi(substr($descripdata, 0, 32));
 445                 $descripdata = substr($descripdata, 36);
 446             }
 447             if ($have_avoltag) {
 448                 $avoltag = $self->_trim_scsi(substr($descripdata, 0, 32));
 449                 $descripdata = substr($descripdata, 36);
 450             }
 451
 452             # (there's more data here, but we don't need it, so it remains unparsed)
 453
 454             if ($elem_type == 4) { # data transfer element (drive)
 455                 my $drive = $next_drive_num++;
 456                 $self->{'drive_scsi_elem_map'}->{$drive} = $elem_addr;
 457
 458                 if ($full_flag) {
 459                     my $h = $result->{'drives'}->{$drive} = {};
 460                     $h->{'barcode'} = $pvoltag;
 461                     # (we'll come back to this later and convert it to orig_slot)
 462                     $h->{'orig_slot_elem'} = $src_addr if $svalid_flag;
 463                 } else {
 464                     $result->{'drives'}->{$drive} = undef;
 465                 }
 466             } elsif ($elem_type == 2 or $elem_type == 3) { # storage or import/export
 467                 my $slot = $next_slot_num++;
 468                 $self->{'slot_scsi_elem_map'}->{$slot} = $elem_addr;
 469                 $slots_by_elem{$elem_addr} = $slot;
 470
 471                 my $h = $result->{'slots'}->{$slot} = {};
 472                 $h->{'empty'} = 1 if !$full_flag;
 473                 $h->{'barcode'} = $pvoltag if $pvoltag ne '';
 474                 $h->{'ie'} = 1 if ($elem_type == 3); # import/export elem type
 475             } elsif ($elem_type == 1) { # medium transport
 476                 if (!defined $self->{'medium_transport_elem'}) {
 477                     $self->{'medium_transport_elem'} = $elem_addr;
 478                 }
 479             }
 480
 481             $data = substr($data, $descrip_len);
 482             $all_descrips_len -= $descrip_len;
 483             $num_elems--;
 484         }
 485     }
 486
 487     # clean up the orig_slots, now that we have a complete mapping of mtx
 488     # numbers to SCSI element numbers.
 489     for my $dr (values %{$result->{'drives'}}) {
 490         next unless defined $dr;
 491         if (defined $dr->{'orig_slot_elem'}) {
 492             $dr->{'orig_slot'} = $slots_by_elem{$dr->{'orig_slot_elem'}};
 493         } else {
 494             $dr->{'orig_slot'} = undef;
 495         }
 496         delete $dr->{'orig_slot_elem'};
 497     }
 498
 499     return $result;
 500 }
 501
 502 # this method is responsible for opening a new NDMPConnection and calling scsi_open,
 503 # as well as patching the given callback to automatically close the connection on
 504 # completion.
 505 sub _get_scsi_conn {
 506     my $self = shift;
 507     my ($cbref) = @_;
 508
 509     my $conn = Amanda::NDMP::NDMPConnection->new(@{$self->{'connargs'}});
 510     if ($conn->err_code()) {
 511         return $conn;
 512     }
 513
 514     if (!$conn->scsi_open($self->{'scsi_dev'})) {
 515         return $conn;
 516     }
 517
 518     if ($self->{'verbose'}) {
 519         $conn->set_verbose(1);
 520     }
 521
 522     # patch scsi_close into the callback, so it will be executed in error and
 523     # success conditions
 524     my $orig_cb = $$cbref;
 525     $$cbref = sub {
 526         my @args = @_;
 527
 528         my $result = $conn->scsi_close();
 529         $conn = undef;
 530         if (!$result) {
 531             if (!$args[0]) { # only report an error if one hasn't already occurred
 532                 my $err = Amanda::Changer->make_error("fatal", undef,
 533                     message => "".$conn->err_msg());
 534                 return $orig_cb->($err);
 535             }
 536         }
 537
 538         return $orig_cb->(@args);
 539     };
 540
 541     return $conn;
 542 }
 543
 544 1;