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

   1 # vim:ft=perl
   2 # Copyright (c) 2008-2012 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. Mathilda Ave., Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 package Amanda::Extract;
  21
  22 use strict;
  23 use warnings;
  24 use IPC::Open3;
  25
  26 use Amanda::Debug qw( :logging );
  27 use Amanda::Paths;
  28
  29 =head1 NAME
  30
  31 Amanda::Extract - perl utilities to run scripts and applications
  32
  33 =head1 SYNOPSIS
  34
  35   use Amanda::Extract;
  36
  37   my (@bsu, @err)= Amanda::Extract::BSU(application => $application,
  38                                         config      => $config,
  39                                         host        => $host,
  40                                         disk        => $disk,
  41                                         device      => $device);
  42   my (@bsu, @err)= Amanda::Extract::Run($application_name, \@g_options,
  43                                         $hdr, @properties);
  44
  45 =cut
  46
  47 sub BSU {
  48     my (%params) = @_;
  49
  50     my %bsu;
  51     my @err;
  52     my @command;
  53
  54     push @command, $Amanda::Paths::APPLICATION_DIR . '/' . $params{'application'};
  55     push @command, "support";
  56     push @command, "--config", $params{'config'} if $params{'config'};
  57     push @command, "--host"  , $params{'host'}   if $params{'host'};
  58     push @command, "--disk"  , $params{'disk'}   if $params{'disk'};
  59     push @command, "--device", $params{'device'} if $params{'device'};
  60     debug("Running: " . join(' ', @command));
  61
  62     my $in;
  63     my $out;
  64     my $err = Symbol::gensym;
  65     my $pid = open3($in, $out, $err, @command);
  66
  67     close($in);
  68     while (my $line = <$out>) {
  69         chomp $line;
  70         debug("support: $line");
  71         my ($name, $value) = split ' ', $line;
  72
  73         $name = lc($name);
  74
  75         if ($name eq 'config' ||
  76             $name eq 'host' ||
  77             $name eq 'disk' ||
  78             $name eq 'index-line' ||
  79             $name eq 'index-xml' ||
  80             $name eq 'message-line' ||
  81             $name eq 'message-xml' ||
  82             $name eq 'record' ||
  83             $name eq 'include-file' ||
  84             $name eq 'include-list' ||
  85             $name eq 'include-list-glob' ||
  86             $name eq 'include-optional' ||
  87             $name eq 'exclude-file' ||
  88             $name eq 'exclude-list' ||
  89             $name eq 'exclude-list-glob' ||
  90             $name eq 'exclude-optional' ||
  91             $name eq 'collection' ||
  92             $name eq 'caclsize' ||
  93             $name eq 'client-estimate' ||
  94             $name eq 'multi-estimate' ||
  95             $name eq 'amfeatures') {
  96             $bsu{$name} = ($value eq "YES");
  97         } elsif ($name eq 'max-level') {
  98             $bsu{$name} = $value;
  99         } elsif ($name eq 'recover-mode') {
 100             $bsu{'smb-recover-mode'} = $value eq 'SMB';
 101         } elsif ($name eq 'recover-path') {
 102             $bsu{'recover-path-cwd'} = $value eq 'CWD';
 103             $bsu{'recover-path-remote'} = $value eq 'REMOTE';
 104         } elsif ($name eq 'data-path') {
 105             if ($value eq 'AMANDA') {
 106                 $bsu{'data-path-amanda'} = 1;
 107             } elsif ($value eq 'DIRECTTCP') {
 108                 $bsu{'data-path-directtcp'} = 1;
 109             }
 110         }
 111     }
 112     close($out);
 113
 114     while (my $line = <$err>) {
 115         chomp($line);
 116         next if $line == '';
 117         push @err, $line;
 118     }
 119     close($err);
 120
 121     waitpid($pid, 0);
 122     my $child_exit_status = $? >> 8;
 123
 124     if ($child_exit_status != 0) {
 125         push @err, "exited with status $child_exit_status";
 126     }
 127     return (\%bsu, \@err);
 128 }
 129
 130 1;