2 # Copyright (c) 2009-2012 Zmanda, Inc. All Rights Reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU General Public License
6 # as published by the Free Software Foundation; either version 2
7 # of the License, or (at your option) any later version.
9 # This program is distributed in the hope that it will be useful, but
10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 # You should have received a copy of the GNU General Public License along
15 # with this program; if not, write to the Free Software Foundation, Inc.,
16 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
19 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
21 package Installcheck::Application;
23 use Amanda::MainLoop qw( :GIOCondition );
28 use POSIX qw( :errno_h :fcntl_h );
29 use POSIX qw( EAGAIN );
36 Installcheck::Application - driver Application API programs and scripts
40 use Installcheck::Application;
42 my $app = Installcheck::Application->new('myapp');
44 $app->add_property('foo' => 'bar');
45 $app->add_property('baz');
46 $app->add_property('bat', 1, 2, 3);
47 $app->delete_property('foo');
48 $app->get_property('foo');
49 $app->set_property('foo', ['bar', '']);
50 my @props = $app->list_properties();
52 my $feats = $app->support('config' => 'TESTCONF', 'temp-prop' => 1);
53 die "need calcsize support" unless ($feats{'CALCSIZE'});
55 my $backup = $app->backup('device' => 'file:/path', 'level' => 0);
56 die join("\n", @{$backup->{'errors'}}) if $backup->{'errors'};
57 print STDERR join("\n", @{$backup->{'index'}});
58 print $backup->{'data'};
64 =item C< new($app_name) >
66 Create a new C< Installcheck::Application > object that will run C< $app_name >.
72 Properties are automatically passed as arguments to any command.
73 Their names will be lowercase.
77 =item C< add_property($prop_name, 'val1', 'val2') >
79 Add one or more values for property C< $prop_name >.
81 =item C< delete_property($prop_name) >
83 Delete all values for property C< $prop_name >.
85 =item C< get_property($prop_name) >
87 Get all values for property C< $prop_name >.
89 =item C< set_property($prop_name, 'val1', 'val2') >
91 Set the values for property C< $prop_name >, removing any previous values.
93 =item C< list_properties() >
95 Returns all properties that have a value.
105 Runs the C< support > command and returns the output as a hashref,
106 with all keys in uppercase.
108 =item C<< backup('disk' => '/some/path', 'device' => '/some/path, 'level' => 0) >>
110 Runs the C< backup() > command on the given device.
111 If a C< disk > argument is not given, it defaults to the C< device >.
118 The data stream produced by the application
122 An array of index lines produced by the application
126 The size of the backup (C< data >)
130 Any normal/informative messages
140 =item C< exit_status >
142 The exit status of the application
146 =item C<< restore('data' => $data_from_backup, 'objects' => ['a', 'b'], 'level' => 0) >>
148 Runs the C< restore > command to restore the C< objects > to the
149 current working directory, supplying it with C< data >.
150 The optional C< level > argument (defaulting to 0) specifies the level of the backup
157 Any output from the application
159 =item C< exit_status >
161 The exit status of the application
165 =item C<< estimate('device' => '/some/path, 'level' => 0) >>
173 The level of the backup that would result
177 The size of the backup that would result
179 =item C< exit_status >
181 The exit status of the application
185 =item C<< selfcheck('device' => '/some/path, 'disk' => '/some/path') >>
187 Runs the C< selfcheck > command on the given device.
188 If a C< disk > argument is not given, it defaults to the C< device >.)
201 =item C< exit_status >
203 The exit status of the application
212 my ($class, $app_name) = @_;
215 'app_name' => $app_name,
219 bless($self, $class);
232 my $name = _propify(shift @_);
235 $self->{'props'}->{$name} ||= [];
236 push @{$self->{'props'}->{$name}}, @values;
239 sub delete_property {
241 my $name = _propify(shift @_);
243 delete $self->{'props'}->{$name};
248 my $name = _propify(shift @_);
250 defined($self->{'props'}->{$name}) ? @{$self->{'props'}->{$name}} : ();
255 my $name = _propify(shift @_);
258 @{$self->{'props'}->{$name}} = @values;
261 sub list_properties {
264 my @prop_names = keys %{$self->{'props'}};
265 # return only non-empty properties
266 grep { $self->{'props'}->{$_} } @prop_names;
269 # setup and run the application
270 # $cmd - the command to give the application
271 # $extra_args - an arrayref of additional arguments
272 # $fds - a hashref of hashrefs specifying file descriptors
273 # The key specifies the target file descriptor number in the child process.
274 # Each hashref can have:
275 # 'child_mode' - 'r' or 'w', how the fd will be used in the child process
276 # 'cb' - an explicit callback to use when the fd is ready for reading/writing
277 # 'write' - a string to write out. An appropriate callback will be generated
278 # 'save_to' - a scalarref to save output to. An appropriate callback will be generated
279 # For each key in $fds, a pipe will be setup.
280 # Additional keys will be added:
281 # 'child_fd' - the file descriptor used by the child
282 # 'parent_fd' - the file descriptor used by the parent
283 # 'handle' - an anonymous filehandle (IO::Handle) for 'parent_fd'
284 # 'src' - the event source (for Amanda::MainLoop)
285 # 'done' - a callback (coderef) that must be called when you're done with the fd
286 # returns child exit status
288 my ($self, $cmd, $extra_args, $fds) = @_;
289 confess 'must have a command' unless $cmd;
291 my $fdn; # file descriptor number
295 if (defined($exit_status)) {
298 foreach $fdn (keys %$fds) {
299 my $fd = $fds->{$fdn};
300 if (($fd->{'child_mode'} eq 'w') and ref($fd->{'done'})) {
305 Amanda::MainLoop::quit() if $really_done;
309 # start setting up pipes
310 foreach $fdn (keys %$fds) {
311 my $fd = $fds->{$fdn};
312 confess "mode must be either 'r' or 'w'" unless $fd->{'child_mode'} =~ /^r|w$/;
313 my ($fd0, $fd1) = POSIX::pipe();
314 my ($c_fd, $p_fd, $p_mode);
315 if ($fd->{'child_mode'} eq 'r') {
316 $p_fd = $fd->{'parent_fd'} = $fd1;
318 $c_fd = $fd->{'child_fd'} = $fd0;
320 $p_fd = $fd->{'parent_fd'} = $fd0;
322 $c_fd = $fd->{'child_fd'} = $fd1;
325 my $p_handle = $fd->{'handle'} = IO::Handle->new_from_fd($p_fd, $p_mode);
326 confess "unable to fdopen $p_fd with mode $p_mode" unless $p_handle;
328 if ($fd->{'save_to'}) {
329 $fd->{'cb'} = _make_save_cb($fd->{'save_to'}, $fd);
330 } elsif ($fd->{'write'}) {
331 $fd->{'cb'} = _make_write_cb($fd->{'write'}, $fd);
333 $fd->{'done'} = _make_done_cb($fd, $all_done);
335 my $events = ($fd->{'child_mode'} eq 'r') ? $G_IO_OUT : ($G_IO_IN|$G_IO_HUP);
336 $fd->{'src'} = Amanda::MainLoop::fd_source($p_handle, $events);
337 $fd->{'src'}->set_callback($fd->{'cb'}) if $fd->{'cb'};
342 my @args = ($cmd, @$extra_args);
343 foreach my $name (keys %{$self->{'props'}}) {
344 $self->{'props'}->{$name} ||= [];
345 foreach my $val (@{$self->{'props'}->{$name}}) {
346 push @args, "--$name", "$val";
351 if ($pid) { # in parent
352 # parent shouldn't use child_fd
353 foreach $fdn (keys %$fds) {
354 my $fd = $fds->{$fdn};
355 POSIX::close($fd->{'child_fd'});
357 my $wait_src = Amanda::MainLoop::child_watch_source($pid);
358 $wait_src->set_callback(sub {
359 $exit_status = $_[2];
363 Amanda::MainLoop::run();
366 # don't need to remove wait_src, that's done automatically
367 foreach $fdn (keys %$fds) {
368 my $fd = $fds->{$fdn};
369 $fd->{'src'}->remove();
370 POSIX::close($fd->{'parent_fd'});
374 my @child_fds = keys %$fds;
375 foreach $fdn (@child_fds) {
376 my $fd = $fds->{$fdn};
377 confess "failed to call dup2($fd->{'child_fd'}, $fdn)"
378 unless POSIX::dup2($fd->{'child_fd'}, $fdn);
379 POSIX::close($fd->{'child_fd'})
380 unless grep {$_ == $fd->{'child_fd'}} @child_fds;
381 POSIX::close($fd->{'parent_fd'})
382 unless grep {$_ == $fd->{'parent_fd'}} @child_fds;
386 exec "$APPLICATION_DIR/$self->{'app_name'}", @args;
392 # given a fd hashref, make a callback that will make the fd non-blocking
393 sub _make_nonblock_cb {
395 confess "a hash reference (representing a fd) is required" unless $fd;
401 fcntl($fd->{'handle'}, F_GETFL, $flags)
402 or confess "Couldn't get flags: $!\n";
403 $flags |= O_NONBLOCK;
404 fcntl($fd->{'handle'}, F_SETFL, $flags)
405 or confess "Couldn't set flags: $!\n";
412 # given a scalar/string and a fd hashref,
413 # make a callback that will write the string to the fd
415 my ($data, $fd) = @_;
416 confess "a hash reference (representing a fd) is required" unless $fd;
417 my $len = length($data);
419 my $nonblock_cb = _make_nonblock_cb($fd);
421 my $BYTES_TO_WRITE = 4096;
426 # this shouldn't happen since the src is removed once we're done (below)
427 confess "offset greater than length" if $offset >= $len;
429 my $rv = $fd->{'handle'}->syswrite($data, $BYTES_TO_WRITE, $offset);
431 confess "Error writing: $!" unless $! == EAGAIN;
435 $fd->{'done'}->() if ($offset >= $len);
440 # given a scalarref and a fd hashref,
441 # make a callback that will save bytes from fd in scalarref
443 my ($store, $fd) = @_;
444 confess "a scalar reference is required" unless ref($store) eq "SCALAR";
445 confess "a hash reference (representing a fd) is required" unless $fd;
448 my $nonblock_cb = _make_nonblock_cb($fd);
450 my $BYTES_TO_READ = 4096;
455 my $rv = $fd->{'handle'}->sysread($$store, $BYTES_TO_READ, $offset);
457 $fd->{'done'}->() if (0 == $rv);
459 confess "Error reading: $!" unless $! == EAGAIN;
466 my ($fd, $all_done) = @_;
468 $fd->{'src'}->remove();
469 $fd->{'handle'}->close();
475 # parse the size string output by various commands, returning the number of bytes
479 confess "failed to parse size" unless ($sstr =~ /^(\d+)(\D?)$/i);
483 $suf = 'k' unless $suf;
484 my %suf_pows = ('k' => 10, 'm' => 20, 'g' => 30);
485 confess "invalid suffix $suf" unless $suf_pows{$suf};
486 $size *= 1 << $suf_pows{$suf};
495 _exec($self, 'support', undef, {
496 1 => {'child_mode' => 'w', 'save_to' => \$sup_str},
499 my %sup = split(/\s+/, $sup_str);
500 # fold into uppercase
501 foreach my $k (keys %sup) {
514 foreach my $k ( qw(device level) ) {
515 confess "$k required" unless defined($nargs{$k});
517 $nargs{'disk'} ||= $nargs{'device'};
519 my @args = map {my $k = $_; ("--$k", $nargs{$k}) } keys(%nargs);
521 my ($data, $msg_str, $index_str);
522 my $exit_status = _exec($self, 'backup', \@args,
524 1 => {'child_mode' => 'w', 'save_to' => \$data},
525 3 => {'child_mode' => 'w', 'save_to' => \$msg_str},
526 4 => {'child_mode' => 'w', 'save_to' => \$index_str},
530 my @index = split(/\n/, $index_str);
534 my ($size, @infos, @errors, @unknowns);
535 foreach my $l (split(/\n/, $msg_str)) {
536 if ($l =~ /^([|?&]) (.*)$/) {
537 my ($sym, $rem) = ($1, $2);
541 } elsif ($sym eq '?') {
543 } elsif ($sym eq '&') {
544 push(@unknowns, $rem);
546 confess "should not be reached";
548 } elsif ($l =~ /^sendbackup: (.*)$/) {
550 if ($rem =~ /^size (\d+)$/i) {
551 $size = _parse_size($1);
552 } elsif (lc($rem) eq 'end') {
555 confess "failed to parse: $l";
558 confess "failed to parse: $l";
562 {'data' => $data, 'index' => \@index, 'size' => $size,
563 'infos' => \@infos, 'errors' => \@errors, 'unknowns' => \@unknowns,
564 'exit_status' => $exit_status};
571 foreach my $k ( qw(objects data) ) {
572 confess "'$k' required" unless defined($args{$k});
574 $args{'level'} ||= 0;
577 my $exit_status = _exec($self, 'restore', ['--level', $args{'level'}, @{$args{'objects'}}], {
578 0 => {'child_mode' => 'r', 'write' => $args{'data'}},
579 1 => {'child_mode' => 'w', 'save_to' => \$msgs},
582 {'msgs' => $msgs, 'exit_status' => $exit_status};
591 foreach my $k ( qw(device level) ) {
592 confess "$k required" unless defined($nargs{$k});
594 $nargs{'disk'} ||= $nargs{'device'};
595 my $calcsize = $nargs{'calcsize'};
596 delete $nargs{'calcsize'};
598 my @args = map {my $k = $_; ("--$k", $nargs{$k}) } keys(%nargs);
599 push @args, '--calcsize' if $calcsize;
602 my $exit_status = _exec($self, 'estimate', \@args,
604 1 => {'child_mode' => 'w', 'save_to' => \$est},
607 $est =~ /^(\d+) (\d+) 1\n$/;
608 my ($level, $size) = ($1, $2);
610 $size = ($size eq '-1')? -1 : _parse_size($size);
612 {'level' => $level, 'size' => $size, 'exit_status' => $exit_status};
619 foreach my $k ( qw(device) ) {
620 confess "$k required" unless defined($nargs{$k});
622 $nargs{'disk'} ||= $nargs{'device'};
624 my @args = map {my $k = $_; ("--$k", $nargs{$k}) } keys(%nargs);
627 my $exit_status = _exec($self, 'selfcheck', \@args,
629 1 => {'child_mode' => 'w', 'save_to' => \$msg_str},
634 foreach my $l (split(/\n/, $msg_str)) {
635 confess "invalid line: $l" unless $l =~ /^(OK|ERROR) (.*)$/;
636 my ($type, $rem) = ($1, $2);
639 } elsif ($type eq 'ERROR') {
642 confess "should not be reached";
646 {'oks' => \@oks, 'errors' => \@errors, 'exit_status' => $exit_status};