Imported Upstream version 2.6.1
[debian/amanda] / changer-src / chg-glue.pl
diff --git a/changer-src/chg-glue.pl b/changer-src/chg-glue.pl
new file mode 100644 (file)
index 0000000..fe7e6a6
--- /dev/null
@@ -0,0 +1,275 @@
+#! @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 );
+
+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> $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 "<error> 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> $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> $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> $error\n";
+                   Amanda::MainLoop::call_later(\&getcmd);
+               } else {
+                   do_slot("current");
+               }
+           }
+       );
+    };
+    release_and_then([], $do_reset);
+}
+
+sub do_eject {
+    release_and_then([ eject => 1 ],
+       sub {
+           print "EXITSTATUS 0\n";
+           print "<none> OK: no volume loaded\n";
+           Amanda::MainLoop::call_later(\&getcmd);
+       }
+    );
+}
+
+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> $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 "<error> $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 "<error> No volume loaded\n";
+       Amanda::MainLoop::call_later(\&getcmd);
+    }
+}
+
+sub getcmd {
+    my ($slot, $label);
+    my $command = <STDIN>;
+    if (!defined($command)) {
+       finish();
+       return;
+    }
+
+    if (($slot) = ($command =~ /^-slot (.*)$/)) {
+       do_slot($slot);
+    } elsif ($command =~ /^-info$/) {
+       do_info();
+    } elsif ($command =~ /^-reset$/) {
+       do_reset();
+    } 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 "<error> 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_SCRIPTUTIL);
+
+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 "<error> $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();
+
+Amanda::MainLoop::call_later(\&getcmd);
+Amanda::MainLoop::run();
+if ($res) {
+    $res->release();
+}