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 use Amanda::Debug qw( :logging );
  44
  45 my $chg;
  46 my $res;
  47
  48 sub release_and_then {
  49     my ($release_opts, $andthen) = @_;
  50     if ($res) {
  51         # release the current reservation, then call andthen
  52         $res->release(@$release_opts,
  53             finished_cb => sub {
  54                 my ($error) = @_;
  55                 $res = undef;
  56
  57                 if ($error) {
  58                     print "EXITSTATUS 1\n";
  59                     print "<error> $error\n";
  60                     Amanda::MainLoop::call_later(\&getcmd);
  61                 } else {
  62                     $andthen->();
  63                 }
  64             }
  65         );
  66     } else {
  67         # no reservation to release
  68         $andthen->();
  69     }
  70 }
  71
  72 sub do_slot {
  73     my ($slot) = @_;
  74
  75     # handle the special cases we support
  76     if ($slot eq "next" or $slot eq "advance") {
  77         if (!$res) {
  78             $slot = "next";
  79         } else {
  80             $slot = $res->{'next_slot'};
  81         }
  82     } elsif ($slot eq "first") {
  83         do_reset();
  84         return;
  85     } elsif ($slot eq "prev" or $slot eq "last") {
  86         print "EXITSTATUS 1\n";
  87         print "<error> slot specifier '$slot' is not valid\n";
  88         Amanda::MainLoop::call_later(\&getcmd);
  89         return;
  90     }
  91
  92     my $load_slot = sub {
  93         $chg->load(slot => $slot, set_current => 1,
  94             res_cb => sub {
  95                 (my $error, $res) = @_;
  96                 if ($error) {
  97                     print "EXITSTATUS 1\n";
  98                     print "<error> $error\n";
  99                 } else {
 100                     print "EXITSTATUS 0\n";
 101                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 102                 }
 103                 Amanda::MainLoop::call_later(\&getcmd);
 104             }
 105         );
 106     };
 107
 108     release_and_then([], $load_slot);
 109 }
 110
 111 sub do_info {
 112     $chg->info(info => [ 'num_slots' ],
 113         info_cb => sub {
 114             my $error = shift;
 115             my %results = @_;
 116
 117             if ($error) {
 118                 print "EXITSTATUS 1\n";
 119                 print "<error> $error\n";
 120             } else {
 121                 my $nslots = $results{'num_slots'};
 122                 $nslots = 0 unless defined $nslots;
 123                 print "EXITSTATUS 0\n";
 124                 print "current $nslots 0 1\n";
 125             }
 126             Amanda::MainLoop::call_later(\&getcmd);
 127         }
 128     );
 129 }
 130
 131 sub do_reset {
 132     my $do_reset = sub {
 133         $chg->reset(
 134             finished_cb => sub {
 135                 my ($error) = @_;
 136                 if ($error) {
 137                     print "EXITSTATUS 1\n";
 138                     print "<error> $error\n";
 139                     Amanda::MainLoop::call_later(\&getcmd);
 140                 } else {
 141                     do_slot("current");
 142                 }
 143             }
 144         );
 145     };
 146     release_and_then([], $do_reset);
 147 }
 148
 149 sub do_clean {
 150     my $do_clean = sub {
 151         $chg->clean(
 152             finished_cb => sub {
 153                 my ($error) = @_;
 154                 if ($error) {
 155                     print "EXITSTATUS 1\n";
 156                     print "<error> $error\n";
 157                     Amanda::MainLoop::call_later(\&getcmd);
 158                 } else {
 159                     print "EXITSTATUS 0\n";
 160                     print "<none> cleaning operation successful\n";
 161                     Amanda::MainLoop::call_later(\&getcmd);
 162                 }
 163             },
 164             drive => '',
 165         );
 166     };
 167     release_and_then([], $do_clean);
 168 }
 169
 170 sub do_eject {
 171     my $do_eject = sub {
 172         $chg->eject(
 173             finished_cb => sub {
 174                 my ($error) = @_;
 175                 if ($error) {
 176                     print "EXITSTATUS 1\n";
 177                     print "<error> $error\n";
 178                     Amanda::MainLoop::call_later(\&getcmd);
 179                 } else {
 180                     print "EXITSTATUS 0\n";
 181                     print "<none> volume ejected\n";
 182                     Amanda::MainLoop::call_later(\&getcmd);
 183                 }
 184             },
 185             drive => '',
 186         );
 187     };
 188     release_and_then([], $do_eject);
 189 }
 190
 191 sub do_search {
 192     my ($label) = @_;
 193     my $load_label = sub {
 194         $chg->load(label => $label, set_current => 1,
 195             res_cb => sub {
 196                 (my $error, $res) = @_;
 197                 if ($error) {
 198                     print "EXITSTATUS 1\n";
 199                     print "<error> $error\n";
 200                 } else {
 201                     print "EXITSTATUS 0\n";
 202                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 203                 }
 204                 Amanda::MainLoop::call_later(\&getcmd);
 205             }
 206         );
 207     };
 208
 209     release_and_then([], $load_label);
 210 }
 211
 212 sub do_label {
 213     my ($label) = @_;
 214     if ($res) {
 215         $res->set_label(label => $label,
 216             finished_cb => sub {
 217                 my ($err) = @_;
 218                 if ($err) {
 219                     print "EXITSTATUS 1\n";
 220                     print "<error> $err\n";
 221                 } else {
 222                     print "EXITSTATUS 0\n";
 223                     print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
 224                 }
 225                 Amanda::MainLoop::call_later(\&getcmd);
 226             }
 227         );
 228     } else {
 229         print "EXITSTATUS 1\n";
 230         print "<error> No volume loaded\n";
 231         Amanda::MainLoop::call_later(\&getcmd);
 232     }
 233 }
 234
 235 sub getcmd {
 236     my ($slot, $label);
 237     my $command = <STDIN>;
 238     chomp $command;
 239
 240     if (!defined($command)) {
 241         finish();
 242         return;
 243     }
 244
 245     debug("got command '$command'");
 246     if (($slot) = ($command =~ /^-slot (.*)$/)) {
 247         do_slot($slot);
 248     } elsif ($command =~ /^-info$/) {
 249         do_info();
 250     } elsif ($command =~ /^-reset$/) {
 251         do_reset();
 252     } elsif ($command =~ /^-clean$/) {
 253         do_clean();
 254     } elsif ($command =~ /^-eject$/) {
 255         do_eject();
 256     } elsif (($label) = ($command =~ /^-search (.*)/)) {
 257         do_search($label);
 258     } elsif (($label) = ($command =~ /^-label (.*)/)) {
 259         do_label($label);
 260     } else {
 261         print "EXITSTATUS 2\n";
 262         print "<error> unknown command '$command'\n";
 263         finish();
 264     }
 265 }
 266
 267 sub finish {
 268     if ($res) {
 269         $res->release(
 270             finished_cb => sub {
 271                 $res = undef;
 272                 Amanda::MainLoop::quit();
 273             }
 274         );
 275     } else {
 276         Amanda::MainLoop::quit();
 277     }
 278 }
 279
 280 Amanda::Util::setup_application("chg-glue", "server", $CONTEXT_DAEMON);
 281
 282 die("$0 is for internal use only") if (@ARGV < 1);
 283 my $config_name = $ARGV[0];
 284
 285 # override die to print a changer-compatible message
 286 $SIG{__DIE__} = sub {
 287     my ($msg) = @_;
 288     die $msg unless defined $^S;
 289     print "EXITSTATUS 2\n";
 290     print "<error> $msg\n";
 291     exit 1;
 292 };
 293
 294 config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name);
 295 my ($cfgerr_level, @cfgerr_errors) = config_errors();
 296 if ($cfgerr_level >= $CFGERR_WARNINGS) {
 297     config_print_errors();
 298     if ($cfgerr_level >= $CFGERR_ERRORS) {
 299         die("errors processing config file");
 300     }
 301 }
 302 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 303
 304 # select unbuffered communication
 305 $| = 1;
 306
 307 $chg = Amanda::Changer->new();
 308 if ($chg->isa("Amanda::Changer::Error")) {
 309     die("Error creating changer: $chg");
 310 }
 311
 312 Amanda::MainLoop::call_later(\&getcmd);
 313 Amanda::MainLoop::run();
 314 if ($res) {
 315     $res->release();
 316 }