File Coverage

blib/lib/AFS/Command/BOS.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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::BOS;
9              
10             require 5.6.0;
11              
12 1     1   1207 use strict;
  1         2  
  1         38  
13 1     1   5 use English;
  1         2  
  1         9  
14              
15 1     1   1515 use AFS::Command::Base;
  0            
  0            
16             use AFS::Object;
17             use AFS::Object::BosServer;
18             use AFS::Object::Instance;
19              
20             our @ISA = qw(AFS::Command::Base);
21             our $VERSION = '1.99';
22              
23             sub getdate {
24              
25             my $self = shift;
26             my (%args) = @_;
27              
28             my $result = AFS::Object::BosServer->new();
29              
30             $self->{operation} = "getdate";
31              
32             my $directory = $args{dir} || '/usr/afs/bin';
33              
34             return unless $self->_parse_arguments(%args);
35              
36             return unless $self->_save_stderr();
37              
38             my $errors = 0;
39              
40             $errors++ unless $self->_exec_cmds();
41              
42             while ( defined($_ = $self->{handle}->getline()) ) {
43              
44             chomp;
45              
46             next unless m:File $directory/(\S+) dated ([^,]+),:;
47              
48             my $file = AFS::Object->new
49             (
50             file => $1,
51             date => $2,
52             );
53              
54             if ( /\.BAK dated ([^,]+),/ ) {
55             $file->_setAttribute( bak => $1 );
56             }
57              
58             if ( /\.OLD dated ([^,\.]+)/ ) {
59             $file->_setAttribute( old => $1 );
60             }
61              
62             $result->_addFile($file);
63              
64             }
65              
66             $errors++ unless $self->_reap_cmds();
67             $errors++ unless $self->_restore_stderr();
68              
69             return if $errors;
70             return $result;
71              
72             }
73              
74             sub getlog {
75              
76             my $self = shift;
77             my (%args) = @_;
78              
79             my $result = AFS::Object::BosServer->new();
80              
81             $self->{operation} = "getlog";
82              
83             my $redirect = undef;
84             my $redirectname = undef;
85              
86             if ( $args{redirect} ) {
87             $redirectname = delete $args{redirect};
88             $redirect = IO::File->new(">$redirectname") || do {
89             $self->_Carp("Unable to write to $redirectname: $ERRNO");
90             return;
91             };
92             }
93              
94             return unless $self->_parse_arguments(%args);
95              
96             return unless $self->_save_stderr();
97              
98             my $errors = 0;
99              
100             $errors++ unless $self->_exec_cmds();
101              
102             my $log = "";
103              
104             while ( defined($_ = $self->{handle}->getline()) ) {
105             next if /^Fetching log file/;
106             if ( $redirect ) {
107             $redirect->print($_);
108             } else {
109             $log .= $_;
110             }
111             }
112              
113             if ( $redirect ) {
114             $redirect->close()|| do {
115             $self->_Carp("Unable to close $redirectname: $ERRNO");
116             $errors++
117             };
118             $result->_setAttribute( log => $redirectname );
119             } else {
120             $result->_setAttribute( log => $log );
121             }
122              
123             $errors++ unless $self->_reap_cmds();
124             $errors++ unless $self->_restore_stderr();
125              
126             return if $errors;
127             return $result;
128              
129             }
130              
131             sub getrestart {
132              
133             my $self = shift;
134             my (%args) = @_;
135              
136             my $result = AFS::Object::BosServer->new();
137              
138             $self->{operation} = "getrestart";
139              
140             return unless $self->_parse_arguments(%args);
141              
142             return unless $self->_save_stderr();
143              
144             my $errors = 0;
145              
146             $errors++ unless $self->_exec_cmds();
147              
148             while ( defined($_ = $self->{handle}->getline()) ) {
149              
150             if ( /restarts at (.*)/ || /restarts (never)/ ) {
151             $result->_setAttribute( restart => $1 );
152             } elsif ( /binaries at (.*)/ || /binaries (never)/ ) {
153             $result->_setAttribute( binaries => $1 );
154             }
155              
156             }
157              
158             $errors++ unless $self->_reap_cmds();
159             $errors++ unless $self->_restore_stderr();
160              
161             return if $errors;
162             return $result;
163              
164             }
165              
166             sub listhosts {
167              
168             my $self = shift;
169             my (%args) = @_;
170              
171             my $result = AFS::Object::BosServer->new();
172              
173             $self->{operation} = "listhosts";
174              
175             return unless $self->_parse_arguments(%args);
176              
177             return unless $self->_save_stderr();
178              
179             my $errors = 0;
180              
181             $errors++ unless $self->_exec_cmds();
182              
183             my @hosts = ();
184              
185             while ( defined($_ = $self->{handle}->getline()) ) {
186              
187             chomp;
188              
189             if ( /Cell name is (\S+)/i ) {
190             $result->_setAttribute( cell => $1 );
191             }
192              
193             if ( /Host \d+ is (\S+)/i ) {
194             push(@hosts,$1);
195             }
196              
197             }
198              
199             $result->_setAttribute( hosts => \@hosts );
200              
201             $errors++ unless $self->_reap_cmds();
202             $errors++ unless $self->_restore_stderr();
203              
204             return if $errors;
205             return $result;
206              
207             }
208              
209             sub listkeys {
210              
211             my $self = shift;
212             my (%args) = @_;
213              
214             my $result = AFS::Object::BosServer->new();
215              
216             $self->{operation} = "listkeys";
217              
218             return unless $self->_parse_arguments(%args);
219              
220             return unless $self->_save_stderr();
221              
222             my $errors = 0;
223              
224             $errors++ unless $self->_exec_cmds();
225              
226             while ( defined($_ = $self->{handle}->getline()) ) {
227              
228             chomp;
229              
230             if ( /key (\d+)/ ) {
231              
232             my $key = AFS::Object->new( index => $1 );
233              
234             if ( /has cksum (\d+)/ ) {
235             $key->_setAttribute( cksum => $1 );
236             } elsif ( /is \'([^\']+)\'/ ) {
237             $key->_setAttribute( value => $1 );
238             }
239              
240             $result->_addKey($key);
241              
242             }
243              
244             if ( /last changed on (.*)\./ ) {
245             $result->_setAttribute( keyschanged => $1 );
246             }
247              
248             }
249              
250             $errors++ unless $self->_reap_cmds();
251             $errors++ unless $self->_restore_stderr();
252              
253             return if $errors;
254             return $result;
255              
256             }
257              
258             sub listusers {
259              
260             my $self = shift;
261             my (%args) = @_;
262              
263             my $result = AFS::Object::BosServer->new();
264              
265             $self->{operation} = "listusers";
266              
267             return unless $self->_parse_arguments(%args);
268              
269             return unless $self->_save_stderr();
270              
271             my $errors = 0;
272              
273             $errors++ unless $self->_exec_cmds();
274              
275             while ( defined($_ = $self->{handle}->getline()) ) {
276              
277             chomp;
278              
279             if ( /^SUsers are: (.*)/ ) {
280             $result->_setAttribute( susers => [split(/\s+/,$1)] );
281             }
282              
283             }
284              
285             $errors++ unless $self->_reap_cmds();
286             $errors++ unless $self->_restore_stderr();
287              
288             return if $errors;
289             return $result;
290              
291             }
292              
293             #
294             # XXX -- we might want to provide parsing of the bos salvage output,
295             # but for now, this is a non-parsed command.
296             #
297              
298             # sub salvage {
299              
300             # my $self = shift;
301             # my (%args) = @_;
302              
303             # my $result = AFS::Object::BosServer->new();
304              
305             # $self->{operation} = "salvage";
306              
307             # return unless $self->_parse_arguments(%args);
308              
309             # return unless $self->_save_stderr();
310              
311             # my $errors = 0;
312              
313             # $errors++ unless $self->_exec_cmds();
314              
315             # while ( defined($_ = $self->{handle}->getline()) ) {
316              
317            
318              
319             # }
320              
321             # $errors++ unless $self->_reap_cmds();
322             # $errors++ unless $self->_restore_stderr();
323              
324             # return if $errors;
325             # return $result;
326              
327             # }
328              
329             sub status {
330              
331             my $self = shift;
332             my (%args) = @_;
333              
334             my $result = AFS::Object::BosServer->new();
335              
336             $self->{operation} = "status";
337              
338             return unless $self->_parse_arguments(%args);
339              
340             return unless $self->_save_stderr();
341              
342             my $errors = 0;
343              
344             $errors++ unless $self->_exec_cmds();
345              
346             my $instance = undef;
347              
348             while ( defined($_ = $self->{handle}->getline()) ) {
349              
350             chomp;
351              
352             if ( /inappropriate access/ ) {
353             $result->_setAttribute( access => 1 );
354             next;
355             }
356              
357             if ( /Instance (\S+),/ ) {
358              
359             if ( defined $instance ) {
360             $result->_addInstance($instance);
361             }
362              
363             $instance = AFS::Object::Instance->new( instance => $1 );
364              
365             #
366             # This is ugly, since the order and number of these
367             # strings varies.
368             #
369             if ( /\(type is (\S+)\)/ ) {
370             $instance->_setAttribute( type => $1 );
371             }
372              
373             if ( /(disabled|temporarily disabled|temporarily enabled),/ ) {
374             $instance->_setAttribute( state => $1 );
375             }
376              
377             if ( /stopped for too many errors/ ) {
378             $instance->_setAttribute( errorstop => 1 );
379             }
380              
381             if ( /has core file/ ) {
382             $instance->_setAttribute( core => 1 );
383             }
384              
385             if ( /currently (.*)\.$/ ) {
386             $instance->_setAttribute( status => $1 );
387             }
388              
389             }
390              
391             if ( /Auxiliary status is: (.*)\.$/ ) {
392             $instance->_setAttribute( auxiliary => $1 );
393             }
394              
395             if ( /Process last started at (.*) \((\d+) proc starts\)/ ) {
396             $instance->_setAttribute
397             (
398             startdate => $1,
399             startcount => $2,
400             );
401             }
402              
403             if ( /Last exit at (.*)/ ) {
404             $instance->_setAttribute( exitdate => $1 );
405             }
406              
407             if ( /Last error exit at ([^,]+),/ ) {
408              
409             $instance->_setAttribute( errorexitdate => $1 );
410              
411             if ( /due to shutdown request/ ) {
412             $instance->_setAttribute( errorexitdue => 'shutdown' );
413             }
414              
415             if ( /due to signal (\d+)/ ) {
416             $instance->_setAttribute
417             (
418             errorexitdue => 'signal',
419             errorexitsignal => $1,
420             );
421             }
422              
423             if ( /by exiting with code (\d+)/ ) {
424             $instance->_setAttribute
425             (
426             errorexitdue => 'code',
427             errorexitcode => $1,
428             );
429             }
430              
431             }
432              
433             if ( /Command\s+(\d+)\s+is\s+\'(.*)\'/ ) {
434             my $command = AFS::Object->new
435             (
436             index => $1,
437             command => $2,
438             );
439             $instance->_addCommand($command);
440             }
441              
442             if ( /Notifier\s+is\s+\'(.*)\'/ ) {
443             $instance->_setAttribute( notifier => $1 );
444             }
445              
446             }
447              
448             if ( defined $instance ) {
449             $result->_addInstance($instance);
450             }
451              
452             $errors++ unless $self->_reap_cmds();
453             $errors++ unless $self->_restore_stderr();
454              
455             return if $errors;
456             return $result;
457              
458             }
459              
460              
461             1;