git.gag.com Git - debian/amanda/blob - changer-src/chg-glue.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 use lib '@amperldir@';
  21 use strict;
  22
  23 # This script interfaces the C changer library to Amanda::Perl.  It reads
  24 # commands from its stdin that are identical to those that would be passed as
  25 # arguments to a changer script, and replies with an encoded exit status and
  26 # the response of the script.
  27 #
  28 # Specifically, the conversation is (P = Parent, C = Child)
  29 # P>C: -$cmd $args
  30 # C>P: EXITSTATUS $exitstatus
  31 # C>P: $slot $message
  32 # P>C: -$cmd $args
  33 # C>P: EXITSTATUS $exitstatus
  34 # C>P: $slot $message
  35 # P>C: (EOF)
  36 #
  37 # The script exits as soon as it reads an EOF on its standard input.
  38
  39 use Amanda::Changer;
  40 use Amanda::MainLoop;
  41 use Amanda::Config qw( :init );
  42 use Amanda::Util qw( :constants );
  43
  44 my $chg;
  45 my $res;
  46
  47 sub release_and_then {
  48     my ($release_opts, $andthen) = @_;
  49     if ($res) {
  50         # release the current reservation, then call andthen
  51         $res->release(@$release_opts,
  52             finished_cb => sub {
  53                 my ($error) = @_;
  54                 $res = undef;
  55
  56                 if ($error) {
  57                     print "EXITSTATUS 1\n";
  58                     print "<error> $error\n";
  59                     Amanda::MainLoop::call_later(\&getcmd);
  60                 } else {
  61                     $andthen->();
  62                 }
  63             }
  64         );
  65     } else {
  66         # no reservation to release
  67         $andthen->();
  68     }
  69 }
  70
  71 sub do_slot {
  72     my ($slot) = @_;
  73
  74     # handle the special cases we support
  75     if ($slot eq "next" or $slot eq "advance") {
  76         if (!$res) {
  77             $slot = "next";
  78         } else {
  79             $slot = $res->{'next_slot'};
  80         }
  81     } elsif ($slot eq "first") {
  82         do_reset();
  83         return;
  84     } elsif ($slot eq "prev" or $slot eq "last") {
  85         print "EXITSTATUS 1\n";
  86         print "<error> slot specifier '$slot' is not valid\n";
  87         Amanda::MainLoop::call_later(\&getcmd);
  88         return;
  89     }
  90
  91     my $load_slot = sub {
  92         $chg->load(slot => $slot, set_current => 1,
  93             res_cb => sub {
  94                 (my $error, $res) = @_;
  95                 if ($error) {
  96                     print "EXITSTATUS 1\n";
  97                     print "<error> $error\n";
  98                 } else {
  99                     print "EXITSTATUS 0\n";
 100                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 101                 }
 102                 Amanda::MainLoop::call_later(\&getcmd);
 103             }
 104         );
 105     };
 106
 107     release_and_then([], $load_slot);
 108 }
 109
 110 sub do_info {
 111     $chg->info(info => [ 'num_slots' ],
 112         info_cb => sub {
 113             my $error = shift;
 114             my %results = @_;
 115
 116             if ($error) {
 117                 print "EXITSTATUS 1\n";
 118                 print "<error> $error\n";
 119             } else {
 120                 my $nslots = $results{'num_slots'};
 121                 $nslots = 0 unless defined $nslots;
 122                 print "EXITSTATUS 0\n";
 123                 print "current $nslots 0 1\n";
 124             }
 125             Amanda::MainLoop::call_later(\&getcmd);
 126         }
 127     );
 128 }
 129
 130 sub do_reset {
 131     my $do_reset = sub {
 132         $chg->reset(
 133             finished_cb => sub {
 134                 my ($error) = @_;
 135                 if ($error) {
 136                     print "EXITSTATUS 1\n";
 137                     print "<error> $error\n";
 138                     Amanda::MainLoop::call_later(\&getcmd);
 139                 } else {
 140                     do_slot("current");
 141                 }
 142             }
 143         );
 144     };
 145     release_and_then([], $do_reset);
 146 }
 147
 148 sub do_eject {
 149     release_and_then([ eject => 1 ],
 150         sub {
 151             print "EXITSTATUS 0\n";
 152             print "<none> OK: no volume loaded\n";
 153             Amanda::MainLoop::call_later(\&getcmd);
 154         }
 155     );
 156 }
 157
 158 sub do_search {
 159     my ($label) = @_;
 160     my $load_label = sub {
 161         $chg->load(label => $label, set_current => 1,
 162             res_cb => sub {
 163                 (my $error, $res) = @_;
 164                 if ($error) {
 165                     print "EXITSTATUS 1\n";
 166                     print "<error> $error\n";
 167                 } else {
 168                     print "EXITSTATUS 0\n";
 169                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 170                 }
 171                 Amanda::MainLoop::call_later(\&getcmd);
 172             }
 173         );
 174     };
 175
 176     release_and_then([], $load_label);
 177 }
 178
 179 sub do_label {
 180     my ($label) = @_;
 181     if ($res) {
 182         $res->set_label(label => $label,
 183             finished_cb => sub {
 184                 my ($err) = @_;
 185                 if ($err) {
 186                     print "EXITSTATUS 1\n";
 187                     print "<error> $err\n";
 188                 } else {
 189                     print "EXITSTATUS 0\n";
 190                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 191                 }
 192                 Amanda::MainLoop::call_later(\&getcmd);
 193             }
 194         );
 195     } else {
 196         print "EXITSTATUS 1\n";
 197         print "<error> No volume loaded\n";
 198         Amanda::MainLoop::call_later(\&getcmd);
 199     }
 200 }
 201
 202 sub getcmd {
 203     my ($slot, $label);
 204     my $command = <STDIN>;
 205     if (!defined($command)) {
 206         finish();
 207         return;
 208     }
 209
 210     if (($slot) = ($command =~ /^-slot (.*)$/)) {
 211         do_slot($slot);
 212     } elsif ($command =~ /^-info$/) {
 213         do_info();
 214     } elsif ($command =~ /^-reset$/) {
 215         do_reset();
 216     } elsif ($command =~ /^-eject$/) {
 217         do_eject();
 218     } elsif (($label) = ($command =~ /^-search (.*)/)) {
 219         do_search($label);
 220     } elsif (($label) = ($command =~ /^-label (.*)/)) {
 221         do_label($label);
 222     } else {
 223         print "EXITSTATUS 2\n";
 224         print "<error> unknown command '$command'\n";
 225         finish();
 226     }
 227 }
 228
 229 sub finish {
 230     if ($res) {
 231         $res->release(
 232             finished_cb => sub {
 233                 $res = undef;
 234                 Amanda::MainLoop::quit();
 235             }
 236         );
 237     } else {
 238         Amanda::MainLoop::quit();
 239     }
 240 }
 241
 242 Amanda::Util::setup_application("chg-glue", "server", $CONTEXT_SCRIPTUTIL);
 243
 244 die("$0 is for internal use only") if (@ARGV < 1);
 245 my $config_name = $ARGV[0];
 246
 247 # override die to print a changer-compatible message
 248 $SIG{__DIE__} = sub {
 249     my ($msg) = @_;
 250     die $msg unless defined $^S;
 251     print "EXITSTATUS 2\n";
 252     print "<error> $msg\n";
 253     exit 1;
 254 };
 255
 256 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
 257 my ($cfgerr_level, @cfgerr_errors) = config_errors();
 258 if ($cfgerr_level >= $CFGERR_WARNINGS) {
 259     config_print_errors();
 260     if ($cfgerr_level >= $CFGERR_ERRORS) {
 261         die("errors processing config file");
 262     }
 263 }
 264 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 265
 266 # select unbuffered communication
 267 $| = 1;
 268
 269 $chg = Amanda::Changer->new();
 270
 271 Amanda::MainLoop::call_later(\&getcmd);
 272 Amanda::MainLoop::run();
 273 if ($res) {
 274     $res->release();
 275 }