git.gag.com Git - debian/amanda/blob - device-src/amtapetype.pl

   1 #! @PERL@
   2 # Copyright (c) 2008 Zmanda Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License version 2 as published
   6 # by the Free Software Foundation.
   7 #
   8 # This program 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 General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 # This is a tool to examine a device and generate a reasonable tapetype
  21 # entry accordingly.
  22
  23 use lib '@amperldir@';
  24 use strict;
  25
  26 use File::Basename;
  27 use Getopt::Long;
  28 use Math::BigInt;
  29 use Amanda::BigIntCompat;
  30
  31 use Amanda::Device qw( :constants );
  32 use Amanda::Debug qw( :logging );
  33 use Amanda::Util qw( :constants );
  34 use Amanda::Config qw( :init :getconf config_dir_relative );
  35 use Amanda::MainLoop;
  36 use Amanda::Xfer;
  37 use Amanda::Constants;
  38 use Amanda::Types;
  39
  40 # command-line options
  41 my $opt_only_compression = 0;
  42 my $opt_blocksize;
  43 my $opt_tapetype_name = 'unknown-tapetype';
  44 my $opt_force = 0;
  45 my $opt_label = "amtapetype-".(int rand 2**31);
  46 my $opt_device_name;
  47
  48 # global "hint" from the compression heuristic as to how fast this
  49 # drive is.
  50 my $device_speed_estimate;
  51
  52 # open up a device, optionally check its label, and start it in ACCESS_WRITE.
  53 sub open_device {
  54     my $device = Amanda::Device->new($opt_device_name);
  55     if ($device->status() != $DEVICE_STATUS_SUCCESS) {
  56         die("Could not open device $opt_device_name: ".$device->error()."\n");
  57     }
  58
  59     if (defined $opt_blocksize) {
  60         $device->property_set('BLOCK_SIZE', $opt_blocksize)
  61             or die "Error setting blocksize: " . $device->error_or_status();
  62     }
  63
  64     if (!$opt_force) {
  65         my $read_label_status = $device->read_label();
  66         if ($read_label_status & $DEVICE_STATUS_VOLUME_UNLABELED) {
  67             if ($device->volume_label) {
  68                 die "Volume in device $opt_device_name has Amanda label '" .
  69                     {$device->volume_label} . "'. Giving up.";
  70             }
  71         } elsif ($read_label_status != $DEVICE_STATUS_SUCCESS) {
  72             die "Error reading label: " . $device->error_or_status();
  73         }
  74     }
  75
  76     return $device;
  77 }
  78
  79 sub start_device {
  80     my ($device) = @_;
  81
  82     if (!$device->start($ACCESS_WRITE, $opt_label, undef)) {
  83         die("Error writing label '$opt_label': ". $device->error_or_status());
  84     }
  85
  86     return $device;
  87 }
  88
  89 # Write a single file to the device, and record the results in STATS.
  90 # write_one_file(
  91 #   STATS => $stats_hashref,    (see below)
  92 #   DEVICE => $dev,             (device to write to)
  93 #   PATTERN => RANDOM or FIXED, (data pattern to write)
  94 #   BYTES => nn,                (number of bytes; optional)
  95 #   MAX_TIME => secs);          (cancel write after this time; optional)
  96 #
  97 # Returns 0 on success (including EOM), "TIMEOUT" on timeout, or an error message
  98 # on failure.
  99 #
 100 # STATS is a multi-level hashref; write_one_file adds to any values
 101 # already in the data structure.
 102 #   $stats->{$pattern}->{TIME} - number of seconds spent writing
 103 #   $stats->{$pattern}->{FILES} - number of files written
 104 #   $stats->{$pattern}->{BYTES} - number of bytes written (approximate)
 105 #
 106 sub write_one_file(%) {
 107     my %options = @_;
 108     my $stats = $options{'STATS'} || { };
 109     my $device = $options{'DEVICE'};
 110     my $bytes = $options{'MAX_BYTES'} || 0;
 111     my $pattern = $options{'PATTERN'} || 'FIXED';
 112     my $max_time = $options{'MAX_TIME'} || 0;
 113
 114     # start the device
 115     my $hdr = Amanda::Types::dumpfile_t->new();
 116     $hdr->{type} = $Amanda::Types::F_DUMPFILE;
 117     $hdr->{name} = "amtapetype";
 118     $hdr->{disk} = "/test";
 119     $hdr->{datestamp} = "X";
 120     $device->start_file($hdr)
 121         or return $device->error_or_status();
 122
 123     # set up the transfer
 124     my ($source, $dest, $xfer);
 125     if ($pattern eq 'FIXED') {
 126         # a simple 256-byte pattern to dodge run length encoding.
 127         my $non_random_pattern = pack("C*", 0..255);
 128         $source = Amanda::Xfer::Source::Pattern->new($bytes, $non_random_pattern);
 129     } elsif ($pattern eq 'RANDOM') {
 130         $source = Amanda::Xfer::Source::Random->new($bytes, 1 + int rand 100);
 131     } else {
 132         die "Unknown PATTERN $pattern";
 133     }
 134     $dest = Amanda::Xfer::Dest::Device->new($device, 0);
 135     $xfer = Amanda::Xfer->new([$source, $dest]);
 136
 137     # set up the relevant callbacks
 138     my ($timeout_src, $xfer_src, $spinner_src);
 139     my $got_error = 0;
 140     my $got_timeout = 0;
 141
 142     $xfer_src = $xfer->get_source();
 143     $xfer_src->set_callback(sub {
 144         my ($src, $xmsg, $xfer) = @_;
 145         if ($xmsg->{type} == $Amanda::Xfer::XMSG_ERROR) {
 146             $got_error = $xmsg->{message};
 147         }
 148         if ($xfer->get_status() == $Amanda::Xfer::XFER_DONE) {
 149             Amanda::MainLoop::quit();
 150         }
 151     });
 152
 153     if ($max_time) {
 154         $timeout_src = Amanda::MainLoop::timeout_source($max_time * 1000);
 155         $timeout_src->set_callback(sub {
 156             my ($src) = @_;
 157             $got_timeout = 1;
 158             $xfer->cancel(); # will result in an XFER_DONE
 159         });
 160     }
 161
 162     $spinner_src = Amanda::MainLoop::timeout_source(1000);
 163     $spinner_src->set_callback(sub {
 164         my ($src) = @_;
 165         my ($file, $block) = ($device->file(), $device->block());
 166         print STDERR "File $file, block $block    \r";
 167     });
 168
 169     my $start_time = time();
 170
 171     $xfer->start();
 172     Amanda::MainLoop::run();
 173     $xfer_src->remove();
 174     $spinner_src->remove();
 175     $timeout_src->remove() if ($timeout_src);
 176     print STDERR " " x 60, "\r";
 177
 178     my $duration = time() - $start_time;
 179
 180     # OK, we finished, update statistics (even if we saw an error)
 181     my $blocks_written = $device->block();
 182     my $block_size = $device->property_get("block_size");
 183     $stats->{$pattern}->{BYTES} += $blocks_written * $block_size;
 184     $stats->{$pattern}->{FILES} += 1;
 185     $stats->{$pattern}->{TIME}  += $duration;
 186
 187     if ($device->status() != $Amanda::Device::DEVICE_STATUS_SUCCESS) {
 188         return $device->error_or_status();
 189     }
 190
 191     if ($got_error) {
 192         return $got_error;
 193     }
 194
 195     if ($got_timeout) {
 196         return "TIMEOUT";
 197     }
 198
 199     return 0;
 200 }
 201
 202 sub check_compression {
 203     my ($device) = @_;
 204
 205     # Check compression status here by property query. If the device can answer
 206     # the question, there's no reason to investigate further.
 207     my $compression_enabled = $device->property_get("compression");
 208
 209     if (defined $compression_enabled) {
 210         return $compression_enabled;
 211     }
 212
 213     # Need to use heuristic to find out if compression is enabled.  Also, we
 214     # rewind between passes so that the second pass doesn't get some kind of
 215     # buffering advantage.
 216
 217     print STDERR "Applying heuristic check for compression.\n";
 218
 219     # We base our determination on whether it's faster to write random data or
 220     # patterned data.  That starts by writing random data for a short length of
 221     # time, then measuring the elapsed time and total data written.  Due to
 222     # potential delay in cancelling a transfer, the elapsed time will be a bit
 223     # longer than the intended time.   We then write the same amount of
 224     # patterned data, and again measure the elapsed time.  We can then
 225     # calculate the speeds of the two operations.  If the compressible speed
 226     # was faster by more than min_ratio, then we assume compression is enabled.
 227
 228     my $compression_check_time = 60;
 229     my $compression_check_min_ratio = 1.2;
 230
 231     my $stats = { };
 232
 233     start_device($device);
 234
 235     my $err = write_one_file(
 236                     DEVICE => $device,
 237                     STATS => $stats,
 238                     MAX_TIME => $compression_check_time,
 239                     PATTERN => 'RANDOM');
 240
 241     if ($err != 'TIMEOUT') {
 242         die $err;
 243     }
 244
 245     # restart the device to rewind it
 246     start_device($device);
 247
 248     $err = write_one_file(
 249                     DEVICE => $device,
 250                     STATS => $stats,
 251                     MAX_BYTES => $stats->{'RANDOM'}->{'BYTES'},
 252                     PATTERN => 'FIXED');
 253     if ($err) {
 254         die $err;
 255     }
 256
 257     # speed calculations are a little tricky: BigInt * float comes out to NaN, so we
 258     # cast the BigInts to float first
 259     my $random_speed = ($stats->{RANDOM}->{BYTES} . "") / $stats->{RANDOM}->{TIME};
 260     my $fixed_speed = ($stats->{FIXED}->{BYTES} . "") / $stats->{FIXED}->{TIME};
 261
 262     print STDERR "Wrote random (uncompressible) data at $random_speed bytes/sec\n";
 263     print STDERR "Wrote fixed (compressible) data at $fixed_speed bytes/sec\n";
 264
 265     # sock this away for make_tapetype's use
 266     $device_speed_estimate = $random_speed;
 267
 268     $compression_enabled =
 269         ($fixed_speed / $random_speed > $compression_check_min_ratio);
 270     return $compression_enabled;
 271 }
 272
 273 sub make_tapetype {
 274     my ($device, $compression_enabled) = @_;
 275     my $blocksize = $device->property_get("BLOCK_SIZE");
 276
 277     # First, write one very long file to get the total tape length
 278     print STDERR "Writing one file to fill the volume.\n";
 279     my $stats = {};
 280     start_device($device);
 281     my $err = write_one_file(
 282                 DEVICE => $device,
 283                 STATS => $stats,
 284                 PATTERN => 'RANDOM');
 285
 286     if ($stats->{RANDOM}->{BYTES} < 1024 * 1024 * 100) {
 287         die "Wrote less than 100MB to the device: $err\n";
 288     }
 289     my $volume_size_estimate = $stats->{RANDOM}->{BYTES};
 290     my $speed_estimate = (($stats->{RANDOM}->{BYTES}."") / 1024)
 291                         / $stats->{RANDOM}->{TIME};
 292     $speed_estimate = int $speed_estimate;
 293     print STDERR "Wrote $volume_size_estimate bytes at $speed_estimate kb/sec\n";
 294
 295     # now we want to write about 100 filemarks; round down to the blocksize
 296     # to avoid counting padding as part of the filemark
 297     my $file_size = $volume_size_estimate / 100;
 298     $file_size -= $file_size % $blocksize;
 299
 300     print STDERR "Writing smaller files ($file_size bytes) to determine filemark.\n";
 301     $stats = {};
 302     start_device($device);
 303     while (!write_one_file(
 304                         DEVICE => $device,
 305                         STATS => $stats,
 306                         MAX_BYTES => $file_size,
 307                         PATTERN => 'RANDOM')) { }
 308
 309     my $filemark_estimate = ($volume_size_estimate - $stats->{RANDOM}->{BYTES})
 310                           / ($stats->{RANDOM}->{FILES} - 1);
 311     if ($filemark_estimate < 0) {
 312         $filemark_estimate = 0;
 313     }
 314
 315     my $comment = "Created by amtapetype; compression "
 316         . ($compression_enabled? "enabled" : "disabled");
 317
 318     print <<EOF;
 319     define tapetype $opt_tapetype_name {
 320         comment "$comment"
 321         length $volume_size_estimate bytes
 322         filemark $filemark_estimate bytes
 323         speed $speed_estimate kps
 324         blocksize $blocksize bytes
 325     }
 326 EOF
 327 }
 328
 329 sub usage {
 330     print STDERR <<EOF;
 331 Usage: amtapetype [-h] [-c] [-f] [-b blocksize] [-t typename] [-l label]
 332                   [ [-o config_overwrite] ... ] device
 333         -h   Display this message
 334         -c   Only check hardware compression state
 335         -f   Run amtapetype even if the loaded volume is already in use
 336              or compression is enabled.
 337         -b   Blocksize to use (default 32k)
 338         -t   Name to give to the new tapetype definition
 339         -l   Label to write to the tape (default is randomly generated)
 340         -o   Overwrite configuration parameter (such as device properties)
 341     Blocksize can include an optional suffix (k, m, or g)
 342 EOF
 343     exit(1);
 344 }
 345
 346 ## Application initialization
 347
 348 Amanda::Util::setup_application("amtapetype", "server", $CONTEXT_CMDLINE);
 349 config_init(0, undef);
 350
 351 my $config_overwrites = new_config_overwrites($#ARGV+1);
 352
 353 Getopt::Long::Configure(qw(bundling));
 354 GetOptions(
 355     'help|usage|?|h' => \&usage,
 356     'c' => \$opt_only_compression,
 357     'b=s' => sub {
 358         my ($num, $suff) = ($_[1] =~ /^([0-9]+)\s*(.*)$/);
 359         die "Invalid blocksize '$_[1]'" unless (defined $num);
 360         my $mult = (defined $suff)?
 361             Amanda::Config::find_multiplier($suff) : 1;
 362         die "Invalid suffix '$suff'" unless ($mult);
 363         $opt_blocksize = $num * $mult;
 364     },
 365     't=s' => \$opt_tapetype_name,
 366     'f' => \$opt_force,
 367     'l' => \$opt_label,
 368     'o=s' => sub { add_config_overwrite_opt($config_overwrites, $_[1]); },
 369 ) or usage();
 370 usage() if (@ARGV != 1);
 371
 372 $opt_device_name= shift @ARGV;
 373
 374 apply_config_overwrites($config_overwrites);
 375 my ($cfgerr_level, @cfgerr_errors) = config_errors();
 376 if ($cfgerr_level >= $CFGERR_WARNINGS) {
 377     config_print_errors();
 378     if ($cfgerr_level >= $CFGERR_ERRORS) {
 379         die("errors processing configuration options");
 380     }
 381 }
 382
 383 Amanda::Util::finish_setup($RUNNING_AS_ANY);
 384
 385 my $device = open_device();
 386
 387 my $compression_enabled = check_compression($device);
 388 print STDERR "Compression: ",
 389     $compression_enabled? "enabled" : "disabled",
 390     "\n";
 391
 392 if ($compression_enabled and !$opt_force) {
 393     print STDERR "Turn off compression or run amtapetype with the -f option\n";
 394     exit(1);
 395 }
 396
 397 if (!$opt_only_compression) {
 398     make_tapetype($device, $compression_enabled);
 399 }