git.gag.com Git - debian/amanda/blob - application-src/amgtar_perl.pl

   1 #!@PERL@
   2 # Copyright (c) 2005-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 use lib '@amperldir@';
  21 use strict;
  22 use Getopt::Long;
  23
  24 package Amanda::Application::amgtar_perl;
  25 use base qw(Amanda::Application);
  26 use File::Copy;
  27 use File::Path;
  28 use IPC::Open3;
  29 use Sys::Hostname;
  30 use Symbol;
  31 use Amanda::Constants;
  32 use Amanda::Config qw( :init :getconf  config_dir_relative );
  33 use Amanda::Debug qw( :logging );
  34 use Amanda::Paths;
  35 use Amanda::Util qw( :constants );
  36
  37 sub new {
  38     my $class = shift;
  39     my ($config, $host, $disk, $device, $level, $index, $message, $collection, $record, $calcsize) = @_;
  40     my $self = $class->SUPER::new();
  41
  42     $self->{runtar}  = ${Amanda::Paths::amlibexecdir} ."/runtar" .
  43                        $self->{'suf'};
  44     $self->{gnulist} = $Amanda::Paths::GNUTAR_LISTED_INCREMENTAL_DIR;
  45     $self->{gnutar}  = $Amanda::Constants::GNUTAR;
  46
  47     $self->{config}     = $config;
  48     $self->{host}       = $host;
  49     $self->{disk}       = $disk;
  50     $self->{device}     = $device;
  51     $self->{level}      = [ @{$level} ];
  52     $self->{index}      = $index;
  53     $self->{message}    = $message;
  54     $self->{collection} = $collection;
  55     $self->{record}     = $record;
  56     $self->{calcsize}   = $calcsize;
  57
  58     return $self;
  59 }
  60
  61 sub command_support {
  62    my $self = shift;
  63
  64    print "CONFIG YES\n";
  65    print "HOST YES\n";
  66    print "DISK YES\n";
  67    print "MAX-LEVEL 9\n";
  68    print "INDEX-LINE YES\n";
  69    print "INDEX-XML NO\n";
  70    print "MESSAGE-LINE YES\n";
  71    print "MESSAGE-XML NO\n";
  72    print "RECORD YES\n";
  73    print "COLLECTION NO\n";
  74    print "MULTI-ESTIMATE YES\n";
  75    print "CALCSIZE YES\n";
  76 }
  77
  78 sub command_selfcheck {
  79    my $self = shift;
  80
  81    print "OK " . $self->{disk} . "\n";
  82    print "OK " . $self->{device} . "\n";
  83    #check binary
  84    #check statefile
  85    #check amdevice
  86    #check property include/exclude
  87 }
  88
  89 sub command_estimate {
  90    my $self = shift;
  91
  92    if (defined $self->{calcsize}) {
  93       $self->run_calcsize("GNUTAR", undef);
  94       return;
  95    }
  96
  97    my($listdir) = $self->{'host'} . $self->{'disk'};
  98    $listdir     =~ s/\//_/g;
  99    my $gnufile;
 100    my $level;
 101    while (defined ($level = shift @{$self->{level}})) {
 102       if($level == 0) {
 103          open($gnufile, ">$self->{gnulist}/${listdir}_${level}.new") || die();
 104          close($gnufile) || die();
 105       }
 106       else {
 107          my($prev_level) = $level - 1;
 108          if (-f "$self->{gnulist}/${listdir}_${prev_level}") {
 109            copy("$self->{gnulist}/${listdir}_${prev_level}", "$self->{gnulist}/${listdir}_${level}.new");
 110          } else {
 111            open($gnufile, ">$self->{gnulist}/${listdir}_${level}.new") || die();
 112            close($gnufile) || die();
 113         #print "ERROR file $self->{gnulist}/${listdir}_${level}.new doesn't exist\n";
 114          }
 115       }
 116       my($size) = -1;
 117       my(@cmd) = ($self->{runtar}, $self->{'config'}, $self->{'gnutar'}, "--create", "--directory", $self->{'device'}, "--listed-incremental", "$self->{gnulist}/${listdir}_${level}.new", "--sparse", "--one-file-system", "--ignore-failed-read", "--totals", "--file", "/dev/null", ".");
 118       debug("cmd:" . join(" ", @cmd));
 119       my $wtrfh;
 120       my $estimate_fd = Symbol::gensym;
 121       my $pid = open3($wtrfh, '>&STDOUT', $estimate_fd, @cmd);
 122       close($wtrfh);
 123
 124       $size = parse_estimate($estimate_fd);
 125       close($estimate_fd);
 126       output_size($level, $size);
 127       unlink "$self->{gnulist}/${listdir}_${level}.new";
 128       waitpid $pid, 0;
 129    }
 130    exit 0;
 131 }
 132
 133 sub parse_estimate {
 134    my($fh) = @_;
 135    my($size) = -1;
 136    while(<$fh>) {
 137       if ($_ =~ /^Total bytes written: (\d*)/) {
 138          $size = $1;
 139          last;
 140       }
 141    }
 142    return $size;
 143 }
 144
 145 sub output_size {
 146    my($level) = shift;
 147    my($size) = shift;
 148    if($size == -1) {
 149       print "$level -1 -1\n";
 150       #exit 2;
 151    }
 152    else {
 153       my($ksize) = int $size / (1024);
 154       $ksize=32 if ($ksize<32);
 155       print "$level $ksize 1\n";
 156    }
 157 }
 158
 159 sub command_backup {
 160    my $self = shift;
 161
 162    my($listdir) = $self->{'host'} . $self->{'disk'};
 163    my($verbose) = "";
 164    $listdir     =~ s/\//_/g;
 165    my($level) = $self->{level}[0];
 166    if($level == 0) {
 167       open(GNULIST, ">$self->{gnulist}/${listdir}_${level}.new") || die();
 168       close(GNULIST) || die();
 169    }
 170    else {
 171       my($prev_level) = $level - 1;
 172       copy("$self->{gnulist}/${listdir}_${prev_level}",
 173            "$self->{gnulist}/${listdir}_${level}.new");
 174    }
 175
 176    my $mesgout_fd;
 177    open($mesgout_fd, '>&=3') || die();
 178    $self->{mesgout} = $mesgout_fd;
 179
 180    if(defined($self->{index})) {
 181       $verbose = "--verbose";
 182    }
 183    my(@cmd) = ($self->{runtar}, $self->{config}, $self->{gnutar}, "--create", $verbose, "--directory", $self->{device}, "--listed-incremental", "$self->{gnulist}/${listdir}_${level}.new", "--sparse", "--one-file-system", "--ignore-failed-read", "--totals", "--file", "-", ".");
 184
 185    debug("cmd:" . join(" ", @cmd));
 186
 187    my $wtrfh;
 188    my $index_fd = Symbol::gensym;
 189    my $pid = open3($wtrfh, '>&STDOUT', $index_fd, @cmd) || die();
 190    close($wtrfh);
 191
 192    if(defined($self->{index})) {
 193       my $indexout_fd;
 194       open($indexout_fd, '>&=4') || die();
 195       $self->parse_backup($index_fd, $mesgout_fd, $indexout_fd);
 196       close($indexout_fd);
 197    }
 198    else {
 199       $self->parse_backup($index_fd, $mesgout_fd, undef);
 200    }
 201    close($index_fd);
 202
 203    if(defined($self->{record})) {
 204       debug("rename $self->{gnulist}/${listdir}_${level}.new $self->{gnulist}/${listdir}_${level}");
 205       rename "$self->{gnulist}/${listdir}_${level}.new",
 206              "$self->{gnulist}/${listdir}_${level}";
 207    }
 208    else {
 209       debug("unlink $self->{gnulist}/${listdir}_${level}.new");
 210       unlink "$self->{gnulist}/${listdir}_${level}.new";
 211    }
 212    waitpid $pid, 0;
 213    if( $? != 0 ){
 214        print $mesgout_fd "? $self->{gnutar} returned error\n";
 215        die();
 216    }
 217    exit 0;
 218 }
 219
 220 sub parse_backup {
 221    my $self = shift;
 222    my($fhin, $fhout, $indexout) = @_;
 223    my $size  = -1;
 224    my $ksize = -1;
 225    while(<$fhin>) {
 226       if ( /^\.\//) {
 227          if(defined($indexout)) {
 228             if(defined($self->{index})) {
 229                s/^\.//;
 230                print $indexout $_;
 231             }
 232          }
 233       }
 234       else {
 235             if (/^Total bytes written: (\d*)/) {
 236                $size = $1;
 237                $ksize = int ($size / 1024);
 238             }
 239             elsif(defined($fhout)) {
 240                if (/: Directory is new$/ ||
 241                    /: Directory has been renamed/) {
 242                   # ignore
 243                } else { # strange
 244                   print $fhout "? $_";
 245                }
 246             }
 247       }
 248    }
 249    if(defined($fhout)) {
 250       if ($size == -1) {
 251       }
 252       else {
 253          my($ksize) = int ($size/1024);
 254          print $fhout "sendbackup: size $ksize\n";
 255          print $fhout "sendbackup: end\n";
 256       }
 257    }
 258 }
 259
 260 sub command_index_from_output {
 261    index_from_output(0, 1);
 262    exit 0;
 263 }
 264
 265 sub index_from_output {
 266    my($fhin, $fhout) = @_;
 267    my($size) = -1;
 268    while(<$fhin>) {
 269       next if /^Total bytes written:/;
 270       next if !/^\.\//;
 271       s/^\.//;
 272       print $fhout $_;
 273    }
 274 }
 275
 276 sub command_index_from_image {
 277    my $self = shift;
 278    my $index_fd;
 279    open($index_fd, "$self->{gnutar} --list --file - |") || die();
 280    index_from_output($index_fd, 1);
 281 }
 282
 283 sub command_restore {
 284    my $self = shift;
 285
 286    chdir(Amanda::Util::get_original_cwd());
 287    my(@cmd) = ($self->{gnutar}, "--numeric-owner", "-xpGvf", "-");
 288    for(my $i=1;defined $ARGV[$i]; $i++) {
 289       my $param = $ARGV[$i];
 290       $param =~ /^(.*)$/;
 291       push @cmd, $1;
 292    }
 293    debug("cmd:" . join(" ", @cmd));
 294    exec { $cmd[0] } @cmd;
 295    die("Can't exec '", $cmd[0], "'");
 296 }
 297
 298 sub command_validate {
 299    my $self = shift;
 300
 301    my(@cmd) = ($self->{gnutar}, "-tf", "-");
 302    debug("cmd:" . join(" ", @cmd));
 303    my $pid = open3('>&STDIN', '>&STDOUT', '>&STDERR', @cmd) || die("validate", "Unable to run @cmd");
 304    waitpid $pid, 0;
 305    if( $? != 0 ){
 306        die("validate", "$self->{gnutar} returned error");
 307    }
 308    exit(0);
 309 }
 310
 311 sub command_print_command {
 312 }
 313
 314 package main;
 315
 316 sub usage {
 317     print <<EOF;
 318 Usage: amgtar_perl <command> --config=<config> --host=<host> --disk=<disk> --device=<device> --level=<level> --index=<yes|no> --message=<text> --collection=<no> --record=<yes|no> --calcsize.
 319 EOF
 320     exit(1);
 321 }
 322
 323 my $opt_config;
 324 my $opt_host;
 325 my $opt_disk;
 326 my $opt_device;
 327 my @opt_level;
 328 my $opt_index;
 329 my $opt_message;
 330 my $opt_collection;
 331 my $opt_record;
 332 my $opt_calcsize;
 333
 334 Getopt::Long::Configure(qw{bundling});
 335 GetOptions(
 336     'config=s'     => \$opt_config,
 337     'host=s'       => \$opt_host,
 338     'disk=s'       => \$opt_disk,
 339     'device=s'     => \$opt_device,
 340     'level=s'      => \@opt_level,
 341     'index=s'      => \$opt_index,
 342     'message=s'    => \$opt_message,
 343     'collection=s' => \$opt_collection,
 344     'record'       => \$opt_record,
 345     'calcsize'     => \$opt_calcsize,
 346 ) or usage();
 347
 348 my $application = Amanda::Application::amgtar_perl->new($opt_config, $opt_host, $opt_disk, $opt_device, \@opt_level, $opt_index, $opt_message, $opt_collection, $opt_record, $opt_calcsize);
 349
 350 $application->do($ARGV[0]);