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 );
47 sub release_and_then {
48 my ($release_opts, $andthen) = @_;
50 # release the current reservation, then call andthen
51 $res->release(@$release_opts,
57 print "EXITSTATUS 1\n";
58 print "<error> $error\n";
59 Amanda::MainLoop::call_later(\&getcmd);
66 # no reservation to release
74 # handle the special cases we support
75 if ($slot eq "next" or $slot eq "advance") {
79 $slot = $res->{'next_slot'};
81 } elsif ($slot eq "first") {
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);
92 $chg->load(slot => $slot, set_current => 1,
94 (my $error, $res) = @_;
96 print "EXITSTATUS 1\n";
97 print "<error> $error\n";
99 print "EXITSTATUS 0\n";
100 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
102 Amanda::MainLoop::call_later(\&getcmd);
107 release_and_then([], $load_slot);
111 $chg->info(info => [ 'num_slots' ],
117 print "EXITSTATUS 1\n";
118 print "<error> $error\n";
120 my $nslots = $results{'num_slots'};
121 $nslots = 0 unless defined $nslots;
122 print "EXITSTATUS 0\n";
123 print "current $nslots 0 1\n";
125 Amanda::MainLoop::call_later(\&getcmd);
136 print "EXITSTATUS 1\n";
137 print "<error> $error\n";
138 Amanda::MainLoop::call_later(\&getcmd);
145 release_and_then([], $do_reset);
149 release_and_then([ eject => 1 ],
151 print "EXITSTATUS 0\n";
152 print "<none> OK: no volume loaded\n";
153 Amanda::MainLoop::call_later(\&getcmd);
160 my $load_label = sub {
161 $chg->load(label => $label, set_current => 1,
163 (my $error, $res) = @_;
165 print "EXITSTATUS 1\n";
166 print "<error> $error\n";
168 print "EXITSTATUS 0\n";
169 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
171 Amanda::MainLoop::call_later(\&getcmd);
176 release_and_then([], $load_label);
182 $res->set_label(label => $label,
186 print "EXITSTATUS 1\n";
187 print "<error> $err\n";
189 print "EXITSTATUS 0\n";
190 print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n";
192 Amanda::MainLoop::call_later(\&getcmd);
196 print "EXITSTATUS 1\n";
197 print "<error> No volume loaded\n";
198 Amanda::MainLoop::call_later(\&getcmd);
204 my $command = <STDIN>;
205 if (!defined($command)) {
210 if (($slot) = ($command =~ /^-slot (.*)$/)) {
212 } elsif ($command =~ /^-info$/) {
214 } elsif ($command =~ /^-reset$/) {
216 } elsif ($command =~ /^-eject$/) {
218 } elsif (($label) = ($command =~ /^-search (.*)/)) {
220 } elsif (($label) = ($command =~ /^-label (.*)/)) {
223 print "EXITSTATUS 2\n";
224 print "<error> unknown command '$command'\n";
234 Amanda::MainLoop::quit();
238 Amanda::MainLoop::quit();
242 Amanda::Util::setup_application("chg-glue", "server", $CONTEXT_SCRIPTUTIL);
244 die("$0 is for internal use only") if (@ARGV < 1);
245 my $config_name = $ARGV[0];
247 # override die to print a changer-compatible message
248 $SIG{__DIE__} = sub {
250 die $msg unless defined $^S;
251 print "EXITSTATUS 2\n";
252 print "<error> $msg\n";
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");
264 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
266 # select unbuffered communication
269 $chg = Amanda::Changer->new();
271 Amanda::MainLoop::call_later(\&getcmd);
272 Amanda::MainLoop::run();