X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=changer-src%2Fchg-glue.pl;fp=changer-src%2Fchg-glue.pl;h=0000000000000000000000000000000000000000;hb=fd48f3e498442f0cbff5f3606c7c403d0566150e;hp=a0aeaebd645425e98fd633dbed89a3585984dbbc;hpb=96f35b20267e8b1a1c846d476f27fcd330e0b018;p=debian%2Famanda diff --git a/changer-src/chg-glue.pl b/changer-src/chg-glue.pl deleted file mode 100644 index a0aeaeb..0000000 --- a/changer-src/chg-glue.pl +++ /dev/null @@ -1,316 +0,0 @@ -#! @PERL@ -# Copyright (c) 2008 Zmanda Inc. All Rights Reserved. -# -# This program is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License version 2 as published -# by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. -# -# You should have received a copy of the GNU General Public License along -# with this program; if not, write to the Free Software Foundation, Inc., -# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -# -# Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300 -# Sunnyvale, CA 94086, USA, or: http://www.zmanda.com - -use lib '@amperldir@'; -use strict; - -# This script interfaces the C changer library to Amanda::Perl. It reads -# commands from its stdin that are identical to those that would be passed as -# arguments to a changer script, and replies with an encoded exit status and -# the response of the script. -# -# Specifically, the conversation is (P = Parent, C = Child) -# P>C: -$cmd $args -# C>P: EXITSTATUS $exitstatus -# C>P: $slot $message -# P>C: -$cmd $args -# C>P: EXITSTATUS $exitstatus -# C>P: $slot $message -# P>C: (EOF) -# -# The script exits as soon as it reads an EOF on its standard input. - -use Amanda::Changer; -use Amanda::MainLoop; -use Amanda::Config qw( :init ); -use Amanda::Util qw( :constants ); -use Amanda::Debug qw( :logging ); - -my $chg; -my $res; - -sub release_and_then { - my ($release_opts, $andthen) = @_; - if ($res) { - # release the current reservation, then call andthen - $res->release(@$release_opts, - finished_cb => sub { - my ($error) = @_; - $res = undef; - - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - Amanda::MainLoop::call_later(\&getcmd); - } else { - $andthen->(); - } - } - ); - } else { - # no reservation to release - $andthen->(); - } -} - -sub do_slot { - my ($slot) = @_; - - # handle the special cases we support - if ($slot eq "next" or $slot eq "advance") { - if (!$res) { - $slot = "next"; - } else { - $slot = $res->{'next_slot'}; - } - } elsif ($slot eq "first") { - do_reset(); - return; - } elsif ($slot eq "prev" or $slot eq "last") { - print "EXITSTATUS 1\n"; - print " slot specifier '$slot' is not valid\n"; - Amanda::MainLoop::call_later(\&getcmd); - return; - } - - my $load_slot = sub { - $chg->load(slot => $slot, set_current => 1, - res_cb => sub { - (my $error, $res) = @_; - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - } else { - print "EXITSTATUS 0\n"; - print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n"; - } - Amanda::MainLoop::call_later(\&getcmd); - } - ); - }; - - release_and_then([], $load_slot); -} - -sub do_info { - $chg->info(info => [ 'num_slots' ], - info_cb => sub { - my $error = shift; - my %results = @_; - - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - } else { - my $nslots = $results{'num_slots'}; - $nslots = 0 unless defined $nslots; - print "EXITSTATUS 0\n"; - print "current $nslots 0 1\n"; - } - Amanda::MainLoop::call_later(\&getcmd); - } - ); -} - -sub do_reset { - my $do_reset = sub { - $chg->reset( - finished_cb => sub { - my ($error) = @_; - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - Amanda::MainLoop::call_later(\&getcmd); - } else { - do_slot("current"); - } - } - ); - }; - release_and_then([], $do_reset); -} - -sub do_clean { - my $do_clean = sub { - $chg->clean( - finished_cb => sub { - my ($error) = @_; - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - Amanda::MainLoop::call_later(\&getcmd); - } else { - print "EXITSTATUS 0\n"; - print " cleaning operation successful\n"; - Amanda::MainLoop::call_later(\&getcmd); - } - }, - drive => '', - ); - }; - release_and_then([], $do_clean); -} - -sub do_eject { - my $do_eject = sub { - $chg->eject( - finished_cb => sub { - my ($error) = @_; - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - Amanda::MainLoop::call_later(\&getcmd); - } else { - print "EXITSTATUS 0\n"; - print " volume ejected\n"; - Amanda::MainLoop::call_later(\&getcmd); - } - }, - drive => '', - ); - }; - release_and_then([], $do_eject); -} - -sub do_search { - my ($label) = @_; - my $load_label = sub { - $chg->load(label => $label, set_current => 1, - res_cb => sub { - (my $error, $res) = @_; - if ($error) { - print "EXITSTATUS 1\n"; - print " $error\n"; - } else { - print "EXITSTATUS 0\n"; - print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n"; - } - Amanda::MainLoop::call_later(\&getcmd); - } - ); - }; - - release_and_then([], $load_label); -} - -sub do_label { - my ($label) = @_; - if ($res) { - $res->set_label(label => $label, - finished_cb => sub { - my ($err) = @_; - if ($err) { - print "EXITSTATUS 1\n"; - print " $err\n"; - } else { - print "EXITSTATUS 0\n"; - print $res->{'this_slot'}, " ", $res->{'device_name'}, "\n"; - } - Amanda::MainLoop::call_later(\&getcmd); - } - ); - } else { - print "EXITSTATUS 1\n"; - print " No volume loaded\n"; - Amanda::MainLoop::call_later(\&getcmd); - } -} - -sub getcmd { - my ($slot, $label); - my $command = ; - chomp $command; - - if (!defined($command)) { - finish(); - return; - } - - debug("got command '$command'"); - if (($slot) = ($command =~ /^-slot (.*)$/)) { - do_slot($slot); - } elsif ($command =~ /^-info$/) { - do_info(); - } elsif ($command =~ /^-reset$/) { - do_reset(); - } elsif ($command =~ /^-clean$/) { - do_clean(); - } elsif ($command =~ /^-eject$/) { - do_eject(); - } elsif (($label) = ($command =~ /^-search (.*)/)) { - do_search($label); - } elsif (($label) = ($command =~ /^-label (.*)/)) { - do_label($label); - } else { - print "EXITSTATUS 2\n"; - print " unknown command '$command'\n"; - finish(); - } -} - -sub finish { - if ($res) { - $res->release( - finished_cb => sub { - $res = undef; - Amanda::MainLoop::quit(); - } - ); - } else { - Amanda::MainLoop::quit(); - } -} - -Amanda::Util::setup_application("chg-glue", "server", $CONTEXT_DAEMON); - -die("$0 is for internal use only") if (@ARGV < 1); -my $config_name = $ARGV[0]; - -# override die to print a changer-compatible message -$SIG{__DIE__} = sub { - my ($msg) = @_; - die $msg unless defined $^S; - print "EXITSTATUS 2\n"; - print " $msg\n"; - exit 1; -}; - -config_init($CONFIG_INIT_EXPLICIT_NAME, $config_name); -my ($cfgerr_level, @cfgerr_errors) = config_errors(); -if ($cfgerr_level >= $CFGERR_WARNINGS) { - config_print_errors(); - if ($cfgerr_level >= $CFGERR_ERRORS) { - die("errors processing config file"); - } -} -Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER); - -# select unbuffered communication -$| = 1; - -$chg = Amanda::Changer->new(); -if ($chg->isa("Amanda::Changer::Error")) { - die("Error creating changer: $chg"); -} - -Amanda::MainLoop::call_later(\&getcmd); -Amanda::MainLoop::run(); -if ($res) { - $res->release(); -}