1 # Copyright (c) 2006 Zmanda Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU General Public License version 2 as published
5 # by the Free Software Foundation.
7 # This program is distributed in the hope that it will be useful, but
8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
9 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 # You should have received a copy of the GNU General Public License along
13 # with this program; if not, write to the Free Software Foundation, Inc.,
14 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 # Contact information: Zmanda Inc, 505 N Mathlida Ave, Suite 120
17 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
19 package Amanda::Changer;
24 @ISA = qw( Exporter );
27 reset clean eject label
28 query loadslot find scan
33 use Amanda::Device qw( :constants );
34 use Amanda::Config qw( :getconf );
38 Amanda::Changer -- interface to changer scripts
44 my ($error, $slot) = Amanda::Changer::reset();
46 my ($nslots, $curslot, $backwards, $searchable) = Amanda::Changer::query();
48 my ($tpslot, $tpdevice) = Amanda::Changer::find("TAPE018");
51 my ($slot, $device, $error) = @_;
52 if (!$error) print "Slot $slot: $device\n";
55 Amanda::Changer::scan(\&slot_callback);
63 All of these functions return an array of values, beginning with
64 C<$error>, and containing any other results appropriate to the
67 The functions C<croak()> in the event of a serious error (problems
68 running the changer script, or an exit status of 2 or higher).
69 "Benign" errors, corresponding to an exit status of 1 or a slot named
70 "<error>", result in the return of a single-element array containing
71 the error message. Error-handling for calls can be written
73 C<$error> and C<$slot>. The first is false unless a "benign"
74 error, such as a positioning error, has occurred, in which case it
75 contains the message from the changer script, and the other results
76 are undefined. C<$slot> is the first word returned from the changer
77 script, and is usually a number, but occasionally a string such as
84 my ($error, $slot) = reset();
86 Resets the tape changer, if supported, by calling
92 my ($error, $slot) = clean();
94 Triggers a cleaning cycle, if supported, by calling
100 my ($error, $slot) = eject();
102 Ejects the tape in the current slot, if supported, by calling
108 my ($error) = label($label);
110 Inform the changer that the tape in the current slot is labeled C<$label>. Calls
112 $tpchanger -label $label
116 my ($error, $slot, $nslots, $backwards, $searchable) = query();
118 Query the changer to determine the current slot (C<$slot>), the
119 number of slots (C<$nslots>), whether it can move backward through tapes
120 (C<$backwards>), and whether it is searchable (that is, has a barcode
121 reader; C<$searchable>). A changer which cannot move backward through
122 tapes is also known as a gravity feeder.
130 my ($error, $slot, $device) = loadslot($desired_slot);
132 Load the tape in the given slot, returning its slot and device.
133 C<$desired_slot> can be a numeric slot number or one of the symbolic
134 names defined by the changer API, e.g., "next", "current", or "first".
136 $tpchanger -slot $slot
140 my ($error, $tpslot, $tpdevice) = Amanda::Changer::find($label);
142 Search the changer for a tape with the given label, returning with
143 C<$tpslot = "<none>"> if the given label is not found.
145 If the changer is searchable, this function calls
147 $tpchanger -search $label
149 Otherwise it scans all slots in order, beginning with the current slot,
150 until it finds one with a label equal to C<$label> or exhausts all
151 slots. Note that it is considered a fatal error if the label is not
156 my ($error) = Amanda::Changer::scan(\&slot_callback);
158 Call C<slot_callback> for all slots, beginning with the current slot,
159 until C<slot_callback> returns a nonzero value or all slots are
160 exhausted. C<slot_callback> gets three arguments: a slot number, a
161 device name for that slot, and a boolean value which is true if the
162 changer successfully loaded the slot.
169 my ($error, $slot, $rest) = run_tpchanger("-reset");
170 return ($error) if $error;
176 my ($error, $slot, $rest) = run_tpchanger("-clean");
177 return ($error) if $error;
183 my ($error, $slot, $rest) = run_tpchanger("-eject");
184 return ($error) if $error;
192 my ($error, $slot, $rest) = run_tpchanger("-label", $label);
193 return ($error) if $error;
199 my ($error, $slot, $rest) = run_tpchanger("-info");
200 return ($error) if $error;
202 # old, unsearchable changers don't return the third result, so it's optional in the regex
203 $rest =~ /(\d+) (\d+) ?(\d+)?/ or croak("Malformed response from changer -seek: $rest");
205 # return array: error, nslots, curslot, backwards, searchable
206 return (0, $slot, $1, $2, $3?1:0);
210 my ($desired_slot) = @_;
212 my ($error, $slot, $rest) = run_tpchanger("-slot", $desired_slot);
213 return ($error) if $error;
215 return (0, $slot, $rest);
221 my ($error, $curslot, $nslots, $backwards, $searchable) = query();
222 return ($error) if $error;
225 # search using the barcode reader, etc.
226 my ($error, $slot, $rest) = run_tpchanger("-search", $label);
227 return ($error) if $error;
228 return ($error, $slot, $rest);
230 # search manually, starting with "current"
231 my $slotstr = "current";
232 for (my $checked = 0; $checked < $nslots; $checked++) {
233 my ($error, $slot, $rest) = run_tpchanger("-slot", $slotstr);
236 # ignore "benign" errors
239 my $device = Amanda::Device->new($rest);
241 next if ($device->read_label() != $READ_LABEL_STATUS_SUCESS);
244 if ($device->{'volume_label'} eq $label) {
245 return (0, $slot, $rest);
249 croak("Label $label not found in any slot");
254 my ($slot_callback) = @_;
256 my ($error, $curslot, $nslots, $backwards, $searchable) = query();
257 return ($error) if $error;
259 my $slotstr = "current";
261 for (my $checked = 0; $checked < $nslots; $checked++) {
262 my ($error, $slot, $rest) = run_tpchanger("-slot", $slotstr);
266 $done = $slot_callback->(undef, undef, $error);
268 $done = $slot_callback->($slot, $rest, 0);
277 # Internal-use function to actually invoke a changer script and parse
278 # its output. If the script's exit status is neither 0 nor 1, or if an error
279 # occurs running the script, then run_tpchanger croaks with the error message.
281 # @params @args: command-line arguments to follow the name of the changer
282 # @returns: array ($error, $slot, $rest), where $error is an error message if
283 # a benign error occurred, or 0 if no error occurred
287 # get the tape changer and extend it to a full path
288 my $tapechanger = getconf($CNF_TPCHANGER);
289 if ($tapechanger !~ qr(^/)) {
290 $tapechanger = "$amlibexecdir/$tapechanger";
293 my $pid = open(my $child, "-|");
294 if (!defined($pid)) {
295 croak("Can't fork to run changer script: $!");
301 # cd into the config dir, if one exists
302 # TODO: construct a "fake" config dir including any "-o" overrides
303 my $config_dir = Amanda::Config::get_config_dir();
305 if (!chdir($config_dir)) {
306 print "<error> Could not chdir to '$config_dir'\n";
311 %ENV = Amanda::Util::safe_env();
313 exec { $tapechanger } $tapechanger, @args or
314 print "<error> Could not exec $tapechanger: $!\n";
319 my @child_output = <$child>;
321 # close the child and get its exit status
323 if (!close($child)) {
325 croak("Error running changer script: $!");
332 croak("Malformed output from changer script -- no output")
333 if (@child_output < 1);
334 croak("Malformed output from changer script -- too many lines")
335 if (@child_output > 1);
336 croak("Malformed output from changer script: '$child_output[0]'")
337 if ($child_output[0] !~ /\s*([^\s]+)\s+(.+)?/);
338 my ($slot, $rest) = ($1, $2);
340 if ($child_exit == 0) {
341 return (0, $slot, $rest);
342 } elsif (POSIX::WIFEXITED($child_exit) && POSIX::WEXITSTATUS($child_exit) == 1) {
343 return ($rest); # non-fatal error
345 croak("Fatal error from changer script: $rest");