File Coverage

blib/lib/AFS/Command/Base.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # (c) 2003-2004 Morgan Stanley and Co.
5             # See ..../src/LICENSE for terms of distribution.
6             #
7              
8             package AFS::Command::Base;
9              
10             require 5.6.0;
11              
12 8     8   43 use strict;
  8         93  
  8         283  
13 8     8   43 use English;
  8         12  
  8         40  
14 8     8   4506 use Carp;
  8         17  
  8         559  
15 8     8   49 use File::Basename qw(basename);
  8         12  
  8         889  
16 8     8   953984 use Date::Format;
  0            
  0            
17              
18             use IO::File;
19             use IO::Pipe;
20              
21             our $AUTOLOAD = "";
22             our $VERSION = '1.99';
23              
24             our %Carp =
25             (
26             carp => \&Carp::carp,
27             croak => \&Carp::croak,
28             );
29              
30             sub setCarp {
31              
32             my $class = shift;
33             my (%args) = @_;
34              
35             foreach my $key ( keys %args ) {
36             unless ( $Carp{$key} ) {
37             croak("Unsupported argument: '$key'");
38             }
39             unless ( ref $args{$key} eq 'CODE' ) {
40             croak("Not a code reference: '$args{$key}'");
41             }
42             $Carp{$key} = $args{$key};
43             }
44              
45             return AFS::Object->_setCarp(@_);
46              
47             }
48              
49             sub new {
50              
51             my $proto = shift;
52             my $class = ref($proto) || $proto;
53             my %args = @_;
54              
55             my $self = {};
56              
57             foreach my $key ( qw( localtime noauth localauth encrypt quiet timestamps ) ) {
58             $self->{$key}++ if $args{$key};
59             }
60              
61             # AFS::Command::VOS -> vos
62             if ( $args{command} ) {
63             my @commands = (split /\s+/,$args{command});
64             push (@{$self->{command}},@commands);
65             } else {
66             @{$self->{command}} = lc((split(/::/,$class))[2]);
67             }
68              
69             bless $self, $class;
70              
71             return $self;
72              
73             }
74              
75             sub errors {
76             my $self = shift;
77             return $self->{errors};
78             }
79              
80             sub supportsOperation {
81             my $self = shift;
82             my $operation = shift;
83             return $self->_operations($operation);
84             }
85              
86             sub supportsArgument {
87             my $self = shift;
88             my $operation = shift;
89             my $argument = shift;
90             return unless $self->_operations($operation);
91             return unless $self->_arguments($operation);
92             return exists $self->{_arguments}->{$operation}->{$argument};
93             }
94              
95             sub _Carp {
96             my $self = shift;
97             $Carp{carp}->(@_);
98             }
99              
100             sub _Croak {
101             my $self = shift;
102             $Carp{croak}->(@_);
103             }
104              
105             sub _operations {
106              
107             my $self = shift;
108             my $operation = shift;
109              
110             my $class = ref $self;
111              
112             unless ( $self->{_operations} ) {
113              
114             my %operations = ();
115              
116             #
117             # This hack is necessary to support the offline/online "hidden"
118             # vos commands. These won't show up in the normal help output,
119             # so we have to check for them individually. Since offline and
120             # online are implemented as a pair, we can just check one of
121             # them, and assume the other is there, too.
122             #
123              
124             foreach my $type ( qw(default hidden) ) {
125              
126             if ( $type eq 'hidden' ) {
127             next unless $self->isa("AFS::Command::VOS");
128             }
129              
130             my $pipe = IO::Pipe->new() || do {
131             $self->_Carp("Unable to create pipe: $ERRNO\n");
132             return;
133             };
134              
135             my $pid = fork();
136              
137             unless ( defined $pid ) {
138             $self->_Carp("Unable to fork: $ERRNO\n");
139             return;
140             }
141              
142             if ( $pid == 0 ) {
143              
144             STDERR->fdopen( STDOUT->fileno(), "w" ) ||
145             $self->_Croak("Unable to redirect stderr: $ERRNO\n");
146             STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
147             $self->_Croak("Unable to redirect stdout: $ERRNO\n");
148              
149             if ( $type eq 'default' ) {
150             exec @{$self->{command}}, 'help';
151             } else {
152             exec @{$self->{command}}, 'offline', '-help';
153             }
154             die "Unable to exec @{$self->{command}} help: $ERRNO\n";
155              
156             } else {
157              
158             $pipe->reader();
159              
160             while ( defined($_ = $pipe->getline()) ) {
161             if ( $type eq 'default' ) {
162             next if /Commands are:/;
163             my ($command) = split;
164             next if $command =~ /^(apropos|help)$/;
165             $operations{$command}++;
166             } else {
167             if ( /^Usage:/ ) {
168             $operations{offline}++;
169             $operations{online}++;
170             }
171             }
172             }
173              
174             }
175              
176             unless ( waitpid($pid,0) ) {
177             $self->_Carp("Unable to get status of child process ($pid)");
178             return;
179             }
180              
181             if ( $? ) {
182             $self->_Carp("Error running @{$self->{command}} help. Unable to configure $class");
183             return;
184             }
185              
186             }
187              
188             $self->{_operations} = \%operations;
189              
190             }
191              
192             return $self->{_operations}->{$operation};
193              
194             }
195              
196             sub _arguments {
197              
198             my $self = shift;
199             my $operation = shift;
200              
201             my $arguments =
202             {
203             optional => {},
204             required => {},
205             aliases => {},
206             };
207              
208             my @command;
209             push (@command, @{$self->{command}});
210              
211             unless ( $self->_operations($operation) ) {
212             $self->_Carp("Unsupported @command operation '$operation'\n");
213             return;
214             }
215              
216             return $self->{_arguments}->{$operation}
217             if ref $self->{_arguments}->{$operation} eq 'HASH';
218              
219             my $pipe = IO::Pipe->new() || do {
220             $self->_Carp("Unable to create pipe: $ERRNO");
221             return;
222             };
223              
224             my $pid = fork();
225              
226             my $errors = 0;
227              
228             unless ( defined $pid ) {
229             $self->_Carp("Unable to fork: $ERRNO");
230             return;
231             }
232              
233             if ( $pid == 0 ) {
234              
235             STDERR->fdopen( STDOUT->fileno(), "w" ) ||
236             die "Unable to redirect stderr: $ERRNO\n";
237             STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
238             die "Unable to redirect stdout: $ERRNO\n";
239             exec @command, $operation, '-help';
240             die "Unable to exec @command help $operation: $ERRNO\n";
241              
242             } else {
243              
244             $pipe->reader();
245              
246             while ( <$pipe> ) {
247              
248             if ( /Unrecognized operation '$operation'/ ) {
249             $self->_Carp("Unsupported @command operation '$operation'\n");
250             $errors++;
251             last;
252             }
253              
254             next unless s/^Usage:.*\s+$operation\s+//;
255              
256             while ( $_ ) {
257             if ( s/^\[\s*-(\w+?)\s*\]\s*// ) {
258             $arguments->{optional}->{$1} = 0
259             unless $1 eq 'help'; # Yeah, skip it...
260             } elsif ( s/^\[\s*-(\w+?)\s+<[^>]*?>\+\s*]\s*// ) {
261             $arguments->{optional}->{$1} = [];
262             } elsif ( s/^\[\s*-(\w+?)\s+<[^>]*?>\s*]\s*// ) {
263             $arguments->{optional}->{$1} = 1;
264             } elsif ( s/^\s*-(\w+?)\s+<[^>]*?>\+\s*// ) {
265             $arguments->{required}->{$1} = [];
266             } elsif ( s/^\s*-(\w+?)\s+<[^>]*?>\s*// ) {
267             $arguments->{required}->{$1} = 1;
268             } elsif ( s/^\s*-(\w+?)\s*// ) {
269             $arguments->{required}->{$1} = 0;
270             } else {
271             $self->_Carp("Unable to parse @command help for $operation\n" .
272             "Unrecognized string: '$_'");
273             $errors++;
274             last;
275             }
276             }
277              
278             last;
279              
280             }
281              
282             }
283              
284             #
285             # XXX -- Hack Alert!!!
286             #
287             # Because some asshole decided to change the force option to vos
288             # release from -f to -force, you can't use the API tranparently
289             # with 2 different vos binaries that support the 2 different options.
290             #
291             # If we need more of these, we can add them, as this let's us
292             # alias one argument to another.
293             #
294             if ( $self->isa("AFS::Command::VOS") && $operation eq 'release' ) {
295             if ( exists $arguments->{optional}->{f} ) {
296             $arguments->{aliases}->{force} = 'f';
297             } elsif ( exists $arguments->{optional}->{force} ) {
298             $arguments->{aliases}->{f} = 'force';
299             }
300             }
301              
302             unless ( waitpid($pid,0) ) {
303             $self->_Carp("Unable to get status of child process ($pid)");
304             $errors++;
305             }
306              
307             if ( $? ) {
308             $self->_Carp("Error running @command $operation -help. Unable to configure @command $operation");
309             $errors++;
310             }
311              
312             return if $errors;
313             return $self->{_arguments}->{$operation} = $arguments;
314              
315             }
316              
317             sub _save_stderr {
318              
319             my $self = shift;
320              
321             $self->{olderr} = IO::File->new(">&STDERR") || do {
322             $self->_Carp("Unable to dup stderr: $ERRNO");
323             return;
324             };
325              
326             my $command = basename((split /\s+/,@{$self->{command}})[0]);
327              
328             $self->{tmpfile} = "/tmp/.$command.$self->{operation}.$$";
329              
330             my $newerr = IO::File->new(">$self->{tmpfile}") || do {
331             $self->_Carp("Unable to open $self->{tmpfile}: $ERRNO");
332             return;
333             };
334              
335             STDERR->fdopen( $newerr->fileno(), "w" ) || do {
336             $self->_Carp("Unable to reopen stderr: $ERRNO");
337             return;
338             };
339              
340             $newerr->close() || do {
341             $self->_Carp("Unable to close $self->{tmpfile}: $ERRNO");
342             return;
343             };
344              
345             return 1;
346              
347             }
348              
349             sub _restore_stderr {
350              
351             my $self = shift;
352              
353             STDERR->fdopen( $self->{olderr}->fileno(), "w") || do {
354             $self->_Carp("Unable to restore stderr: $ERRNO");
355             return;
356             };
357              
358             $self->{olderr}->close() || do {
359             $self->_Carp("Unable to close saved stderr: $ERRNO");
360             return;
361             };
362              
363             delete $self->{olderr};
364              
365             my $newerr = IO::File->new($self->{tmpfile}) || do {
366             $self->_Carp("Unable to reopen $self->{tmpfile}: $ERRNO");
367             return;
368             };
369              
370             $self->{errors} = "";
371              
372             while ( <$newerr> ) {
373             $self->{errors} .= $_;
374             }
375              
376             $newerr->close() || do {
377             $self->_Carp("Unable to close $self->{tmpfile}: $ERRNO");
378             return;
379             };
380              
381             unlink($self->{tmpfile}) || do {
382             $self->_Carp("Unable to unlink $self->{tmpfile}: $ERRNO");
383             return;
384             };
385              
386             delete $self->{tmpfile};
387              
388             return 1;
389              
390             }
391              
392             sub _parse_arguments {
393              
394             my $self = shift;
395             my $class = ref($self);
396             my (%args) = @_;
397              
398             my $arguments = $self->_arguments($self->{operation});
399              
400             unless ( defined $arguments ) {
401             $self->_Carp("Unable to obtain arguments for $class->$self->{operation}");
402             return;
403             }
404              
405             $self->{errors} = "";
406              
407             $self->{cmds} = [];
408              
409             if ( $args{inputfile} ) {
410              
411             push( @{$self->{cmds}}, [ 'cat', $args{inputfile} ] );
412              
413             } else {
414              
415             my @argv = ( @{$self->{command}}, $self->{operation} );
416              
417             foreach my $key ( keys %args ) {
418             next unless $arguments->{aliases}->{$key};
419             $args{$arguments->{aliases}->{$key}} = delete $args{$key};
420             }
421              
422             foreach my $key ( qw( noauth localauth encrypt ) ) {
423             next unless $self->{$key};
424             $args{$key}++ if exists $arguments->{required}->{$key};
425             $args{$key}++ if exists $arguments->{optional}->{$key};
426             }
427              
428             unless ( $self->{quiet} ) {
429             $args{verbose}++ if exists $arguments->{optional}->{verbose};
430             }
431              
432             foreach my $type ( qw( required optional ) ) {
433              
434             foreach my $key ( keys %{$arguments->{$type}} ) {
435              
436             my $hasvalue = $arguments->{$type}->{$key};
437              
438             if ( $type eq 'required' ) {
439             unless ( exists $args{$key} ) {
440             $self->_Carp("Required argument '$key' not provided");
441             return;
442             }
443             } else {
444             next unless exists $args{$key};
445             }
446              
447             if ( $hasvalue ) {
448             if ( ref $args{$key} eq 'HASH' || ref $args{$key} eq 'ARRAY' ) {
449             unless ( ref $hasvalue eq 'ARRAY' ) {
450             $self->_Carp("Invalid argument '$key': can't provide a list of values");
451             return;
452             }
453             push(@argv,"-$key");
454             foreach my $value ( ref $args{$key} eq 'HASH' ? %{$args{$key}} : @{$args{$key}} ) {
455             push(@argv,$value);
456             }
457             } else {
458             push(@argv,"-$key",$args{$key});
459             }
460             } else {
461             push(@argv,"-$key") if $args{$key};
462             }
463              
464             delete $args{$key};
465              
466             }
467              
468             }
469              
470             if ( %args ) {
471             $self->_Carp("Unsupported arguments: " . join(' ',sort keys %args));
472             return;
473             }
474              
475             push( @{$self->{cmds}}, \@argv );
476              
477             }
478              
479             return 1;
480              
481             }
482              
483             sub _exec_cmds {
484              
485             my $self = shift;
486              
487             my %args = @_;
488              
489             my @cmds = @{$self->{cmds}};
490              
491             $self->{pids} = {};
492              
493             for ( my $index = 0 ; $index <= $#cmds ; $index++ ) {
494              
495             my $cmd = $cmds[$index];
496              
497             my $pipe = IO::Pipe->new() || do {
498             $self->_Carp("Unable to create pipe: $ERRNO");
499             return;
500             };
501              
502             my $pid = fork();
503              
504             unless ( defined $pid ) {
505             $self->_Carp("Unable to fork: $ERRNO");
506             return;
507             }
508              
509             if ( $pid == 0 ) {
510              
511             if ( $index == $#cmds &&
512             exists $args{stdout} && $args{stdout} ne 'stdout' ) {
513             my $stdout = IO::File->new(">$args{stdout}") ||
514             $self->_Croak("Unable to open $args{stdout}: $ERRNO");
515             STDOUT->fdopen( $stdout->fileno(), "w" ) ||
516             $self->_Croak("Unable to redirect stdout: $ERRNO");
517             } else {
518             STDOUT->fdopen( $pipe->writer()->fileno(), "w" ) ||
519             $self->_Croak("Unable to redirect stdout: $ERRNO");
520             }
521              
522             if ( exists $args{stderr} && $args{stderr} eq 'stdout' ) {
523             STDERR->fdopen( STDOUT->fileno(), "w" ) ||
524             $self->_Croak("Unable to redirect stderr: $ERRNO");
525             }
526              
527             if ( $index == 0 ) {
528             if ( exists $args{stdin} && $args{stdin} ne 'stdin' ) {
529             my $stdin = IO::File->new("<$args{stdin}") ||
530             $self->_Croak("Unable to open $args{stdin}: $ERRNO");
531             STDIN->fdopen( $stdin->fileno(), "r" ) ||
532             $self->_Croak("Unable to redirect stdin: $ERRNO");
533             }
534             } else {
535             STDIN->fdopen( $self->{handle}->fileno(), "r" ) ||
536             $self->_Croak("Unable to redirect stdin: $ERRNO");
537             }
538              
539             $ENV{TZ} = 'GMT' unless $self->{localtime};
540              
541             exec( { $cmd->[0] } @{$cmd} ) ||
542             $self->_Croak("Unable to exec @{$cmd}: $ERRNO");
543              
544             }
545              
546             $self->{handle} = $pipe->reader();
547              
548             $self->{pids}->{$pid} = $cmd;
549              
550             }
551              
552             return 1;
553              
554             }
555              
556             sub _parse_output {
557              
558             my $self = shift;
559              
560             $self->{errors} = "";
561              
562             while ( defined($_ = $self->{handle}->getline()) ) {
563             $self->{errors} .= time2str("[%Y-%m-%d %H:%M:%S] ",time,'GMT') if $self->{timestamps};
564             $self->{errors} .= $_;
565             }
566              
567             return 1;
568              
569             }
570              
571             sub _reap_cmds {
572              
573             my $self = shift;
574             my (%args) = @_;
575              
576             my $errors = 0;
577              
578             $self->{handle}->close() || do {
579             $self->_Carp("Unable to close pipe handle: $ERRNO");
580             $errors++;
581             };
582              
583             delete $self->{handle};
584             delete $self->{cmds};
585              
586             $self->{status} = {};
587              
588             my %allowstatus = ();
589             if ( $args{allowstatus} ) {
590             if ( ref $args{allowstatus} eq 'ARRAY' ) {
591             foreach my $status ( @{$args{allowstatus}} ) {
592             $allowstatus{$status}++;
593             }
594             } else {
595             $allowstatus{$args{allowstatus}}++;
596             }
597             }
598              
599             foreach my $pid ( keys %{$self->{pids}} ) {
600              
601             $self->{status}->{$pid}->{cmd} =
602             join(' ', @{delete $self->{pids}->{$pid}} );
603              
604             if ( waitpid($pid,0) ) {
605              
606             $self->{status}->{$pid}->{status} = $?;
607             if ( $? ) {
608             if ( %allowstatus ) {
609             $errors++ unless $allowstatus{$? >> 8};
610             } else {
611             $errors++;
612             }
613             }
614              
615              
616             } else {
617             $self->{status}->{$pid}->{status} = undef;
618             $errors++;
619             }
620              
621             }
622              
623             return if $errors;
624             return 1;
625              
626             }
627              
628             sub AUTOLOAD {
629              
630             my $self = shift;
631             my (%args) = @_;
632              
633             $self->{operation} = $AUTOLOAD;
634             $self->{operation} =~ s/.*:://;
635              
636             return unless $self->_parse_arguments(%args);
637              
638             return unless $self->_exec_cmds( stderr => 'stdout' );
639              
640             my $errors = 0;
641              
642             $errors++ unless $self->_parse_output();
643             $errors++ unless $self->_reap_cmds();
644              
645             return if $errors;
646             return 1;
647              
648             }
649              
650             sub DESTROY {}
651              
652             1;
653