2 # Copyright (c) 2008 Zmanda Inc. All Rights Reserved.
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.
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
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
17 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use lib '@amperldir@';
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.
28 # Specifically, the conversation is (P = Parent, C = Child)
30 # C>P: EXITSTATUS $exitstatus
33 # C>P: EXITSTATUS $exitstatus
37 # The script exits as soon as it reads an EOF on its standard input.
41 use Amanda::Config qw( :init );
42 use Amanda::Util qw( :constants );
43 use Amanda::Debug qw( :logging );
48 sub release_and_then {
49 my ($release_opts, $andthen) = @_;
51 # release the current reservation, then call andthen
52 $res->release(@$release_opts,
58 print "EXITSTATUS 1\n";
59 print "<error> $error\n";
60 Amanda::MainLoop::call_later(\&getcmd);
67 # no reservation to release
75 # handle the special cases we support
76 if ($slot eq "next" or $slot eq "advance") {
80 $slot = $res->{'next_slot'};
82 } elsif ($slot eq "first") {
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);
93 $chg->load(slot => $slot, set_current => 1,
95 (my $error, $res) = @_;
97 print "EXITSTATUS 1\n";
98 print "<error> $error\n";
100 print "EXITSTATUS 0\n";
101 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
103 Amanda::MainLoop::call_later(\&getcmd);
108 release_and_then([], $load_slot);
112 $chg->info(info => [ 'num_slots' ],
118 print "EXITSTATUS 1\n";
119 print "<error> $error\n";
121 my $nslots = $results{'num_slots'};
122 $nslots = 0 unless defined $nslots;
123 print "EXITSTATUS 0\n";
124 print "current $nslots 0 1\n";
126 Amanda::MainLoop::call_later(\&getcmd);
137 print "EXITSTATUS 1\n";
138 print "<error> $error\n";
139 Amanda::MainLoop::call_later(\&getcmd);
146 release_and_then([], $do_reset);
155 print "EXITSTATUS 1\n";
156 print "<error> $error\n";
157 Amanda::MainLoop::call_later(\&getcmd);
159 print "EXITSTATUS 0\n";
160 print "<none> cleaning operation successful\n";
161 Amanda::MainLoop::call_later(\&getcmd);
167 release_and_then([], $do_clean);
176 print "EXITSTATUS 1\n";
177 print "<error> $error\n";
178 Amanda::MainLoop::call_later(\&getcmd);
180 print "EXITSTATUS 0\n";
181 print "<none> volume ejected\n";
182 Amanda::MainLoop::call_later(\&getcmd);
188 release_and_then([], $do_eject);
193 my $load_label = sub {
194 $chg->load(label => $label, set_current => 1,
196 (my $error, $res) = @_;
198 print "EXITSTATUS 1\n";
199 print "<error> $error\n";
201 print "EXITSTATUS 0\n";
202 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
204 Amanda::MainLoop::call_later(\&getcmd);
209 release_and_then([], $load_label);
215 $res->set_label(label => $label,
219 print "EXITSTATUS 1\n";
220 print "<error> $err\n";
222 print "EXITSTATUS 0\n";
223 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
225 Amanda::MainLoop::call_later(\&getcmd);
229 print "EXITSTATUS 1\n";
230 print "<error> No volume loaded\n";
231 Amanda::MainLoop::call_later(\&getcmd);
237 my $command = <STDIN>;
240 if (!defined($command)) {
245 debug("got command '$command'");
246 if (($slot) = ($command =~ /^-slot (.*)$/)) {
248 } elsif ($command =~ /^-info$/) {
250 } elsif ($command =~ /^-reset$/) {
252 } elsif ($command =~ /^-clean$/) {
254 } elsif ($command =~ /^-eject$/) {
256 } elsif (($label) = ($command =~ /^-search (.*)/)) {
258 } elsif (($label) = ($command =~ /^-label (.*)/)) {
261 print "EXITSTATUS 2\n";
262 print "<error> unknown command '$command'\n";
272 Amanda::MainLoop::quit();
276 Amanda::MainLoop::quit();
280 Amanda::Util::setup_application("chg-glue", "server", $CONTEXT_DAEMON);
282 die("$0 is for internal use only") if (@ARGV < 1);
283 my $config_name = $ARGV[0];
285 # override die to print a changer-compatible message
286 $SIG{__DIE__} = sub {
288 die $msg unless defined $^S;
289 print "EXITSTATUS 2\n";
290 print "<error> $msg\n";
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");
302 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
304 # select unbuffered communication
307 $chg = Amanda::Changer->new();
308 if ($chg->isa("Amanda::Changer::Error")) {
309 die("Error creating changer: $chg");
312 Amanda::MainLoop::call_later(\&getcmd);
313 Amanda::MainLoop::run();