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