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