File Coverage

blib/lib/NetApp/Filer.pm
Criterion Covered Total %
statement 73 470 15.5
branch 5 136 3.6
condition 0 14 0.0
subroutine 19 57 33.3
pod 24 26 92.3
total 121 703 17.2


line stmt bran cond sub pod time code
1              
2             package NetApp::Filer;
3              
4             our $VERSION = '500.002';
5             $VERSION = eval $VERSION; ## no critic: StringyEval
6              
7 7     7   356441 use strict;
  7         21  
  7         268  
8 7     7   40 use warnings;
  7         14  
  7         228  
9 7     7   39 use English;
  7         14  
  7         55  
10 7     7   4063 use Carp;
  7         15  
  7         436  
11              
12 7     7   8540 use Class::Std;
  7         117459  
  7         50  
13 7     7   8182 use Params::Validate qw( :all );
  7         144848  
  7         1788  
14 7     7   8409 use IPC::Cmd qw( run );
  7         627608  
  7         542  
15 7     7   7623 use Regexp::Common;
  7         19970  
  7         49  
16 7     7   485370 use Net::Telnet;
  7         285790  
  7         378  
17 7     7   5010 use Clone qw(clone);
  7         36418  
  7         621  
18              
19 7     7   64 use Data::Dumper;
  7         14  
  7         361  
20              
21 7     7   7419 use Memoize;
  7         18919  
  7         413  
22 7     7   3657 use NetApp::Filer::TimeoutCache;
  7         17  
  7         203  
23              
24 7     7   3172 use NetApp::Filer::Version;
  7         23  
  7         232  
25 7     7   3643 use NetApp::Filer::License;
  7         19  
  7         216  
26 7     7   3236 use NetApp::Filer::Option;
  7         19  
  7         198  
27 7     7   3513 use NetApp::Filer::Export;
  7         23  
  7         48201  
28              
29             {
30              
31             my %hostname_of :ATTR( get => 'hostname' );
32             my %username_of :ATTR( get => 'username' );
33              
34             my %protocol_of :ATTR;
35              
36             my %ssh_identity_of :ATTR;
37             my %ssh_command_of :ATTR;
38              
39             my %telnet_password_of :ATTR;
40             my %telnet_timeout_of :ATTR;
41             my %telnet_session_of :ATTR;
42             my %telnet_session_by; # NOT an ATTR. Keyed on hostname/username
43              
44             my %command_status_of :ATTR;
45             my %command_error_of :ATTR;
46             my %command_stdout_of :ATTR;
47             my %command_stderr_of :ATTR;
48              
49             my %version_of :ATTR( get => 'version' );
50              
51             my %cache_enabled_of :ATTR;
52             my %cache_of :ATTR;
53              
54             my %snapmirror_state_of :ATTR;
55              
56             sub BUILD {
57              
58 0     0 0 0 my ($self,$ident,$args_ref) = @_;
59              
60 0         0 my @args = %$args_ref;
61              
62 0         0 my (%args) = validate( @args, {
63             hostname => {
64             type => SCALAR,
65             },
66             username => {
67             type => SCALAR,
68             default => 'root',
69             optional => 1,
70             },
71             protocol => {
72             type => SCALAR,
73             regex => qr{^(ssh|telnet)$},
74             default => 'ssh',
75             optional => 1,
76             },
77             telnet_password => {
78             type => SCALAR,
79             optional => 1,
80             },
81             telnet_timeout => {
82             type => SCALAR,
83             default => 60,
84             optional => 1,
85             },
86             ssh_identity => {
87             type => SCALAR,
88             optional => 1,
89             },
90             ssh_command => {
91             type => ARRAYREF,
92             default => [qw( ssh )],
93             optional => 1,
94             },
95             cache_enabled => {
96             type => SCALAR,
97             default => 0,
98             optional => 1,
99             },
100             cache_expiration => {
101             type => SCALAR,
102             default => 10,
103             optional => 1,
104             },
105             });
106              
107 0         0 $hostname_of{$ident} = $args{hostname};
108 0         0 $username_of{$ident} = $args{username};
109 0         0 $protocol_of{$ident} = $args{protocol};
110            
111 0         0 $command_stdout_of{$ident} = [];
112 0         0 $command_stderr_of{$ident} = [];
113              
114 0 0       0 if ( $protocol_of{$ident} eq 'ssh' ) {
115              
116 0 0       0 if ( $args{telnet_password} ) {
117 0         0 $telnet_password_of{$ident} = $args{telnet_password};
118             }
119              
120 0         0 $ssh_command_of{$ident} = clone $args{ssh_command};
121              
122 0 0       0 if ( $args{ssh_identity} ) {
123              
124 0 0       0 if ( not -f $args{ssh_identity} ) {
125 0         0 croak("No such ssh_identity file: $args{ssh_identity}\n");
126             }
127              
128 0         0 $ssh_identity_of{$ident} = $args{ssh_identity};
129              
130 0         0 push( @{ $ssh_command_of{$ident} },
  0         0  
131             '-i', $ssh_identity_of{$ident} );
132              
133             }
134              
135 0         0 push( @{ $ssh_command_of{$ident} },
  0         0  
136             '-l', $username_of{$ident}, $hostname_of{$ident} );
137             } else {
138              
139 0         0 $telnet_timeout_of{$ident} = $args{telnet_timeout};
140              
141 0         0 $telnet_password_of{$ident} = $args{telnet_password};
142              
143 0   0     0 $telnet_session_by{ $args{hostname}, $args{username} } ||=
144             $self->_telnet_connect();
145              
146 0         0 $telnet_session_of{$ident} =
147             $telnet_session_by{ $args{hostname}, $args{username} };
148              
149             }
150              
151 0         0 $self->_run_command(
152             command => [qw( version )],
153             );
154              
155 0         0 my @stdout = $self->_get_command_stdout;
156              
157 0         0 $version_of{$ident} = NetApp::Filer::Version->new({
158             string => $stdout[0],
159             });
160              
161 0         0 $cache_enabled_of{$ident} = $args{cache_enabled};
162              
163 0 0       0 return 1 if not $args{cache_enabled};
164              
165 0         0 $cache_of{$ident} = {
166             get_aggregate => {},
167             get_volume => {},
168             get_qtree => {},
169             };
170              
171 0         0 foreach my $method ( keys %{ $cache_of{$ident} } ) {
  0         0  
172              
173 0 0       0 if ( $args{cache_expiration} ) {
174            
175 0         0 tie %{ $cache_of{$ident}->{$method} },
  0         0  
176             'NetApp::Filer::TimeoutCache',
177             lifetime => $args{cache_expiration};
178              
179 0         0 memoize(
180             $method,
181             SCALAR_CACHE => [ HASH => $cache_of{$ident}->{$method} ],
182             LIST_CACHE => 'MERGE',
183             );
184              
185             } else {
186              
187 0         0 memoize $method;
188              
189             }
190            
191             }
192              
193             }
194              
195             sub _telnet_connect {
196              
197 0     0   0 my $self = shift;
198 0         0 my $ident = ident $self;
199              
200 0         0 my $timeout = $telnet_timeout_of{$ident};
201 0         0 my $hostname = $hostname_of{$ident};
202 0         0 my $username = $username_of{$ident};
203 0         0 my $password = $telnet_password_of{$ident};
204              
205 0         0 my $session = Net::Telnet->new(
206             Timeout => $timeout,
207             Prompt => '/> |\*> /',
208             );
209              
210 0 0       0 if ( $ENV{NETAPP_TELNET_DEBUG} ) {
211 0         0 $session->input_log('/var/tmp/netapp-telnet-debug.log');
212             }
213              
214 0         0 $session->open( $hostname );
215              
216 0         0 $session->waitfor('/login:/');
217 0         0 $session->print( $username );
218 0         0 $session->waitfor('/Password:/');
219 0         0 $session->print( $password );
220              
221 0         0 eval { $session->waitfor( $session->prompt ) };
  0         0  
222 0 0       0 if ( $@ ) {
223 0         0 croak(
224             "Unable to authenticate to $hostname: $@\n"
225             );
226             }
227              
228 0         0 return $session;
229              
230             }
231              
232             sub _run_command {
233              
234 0     0   0 my $self = shift;
235 0         0 my $ident = ident $self;
236              
237 0         0 my $protocol = $protocol_of{$ident};
238              
239 0 0       0 if ( $protocol eq 'ssh' ) {
240 0         0 return $self->_run_ssh_command(@_);
241             } else {
242 0         0 return $self->_run_telnet_command(@_);
243             }
244            
245             }
246              
247             sub _run_telnet_command {
248              
249 0     0   0 my $self = shift;
250 0         0 my $ident = ident $self;
251              
252 0         0 my %args = validate( @_, {
253             command => { type => ARRAYREF },
254             nonfatal => { type => SCALAR,
255             optional => 1 },
256             });
257              
258 0         0 my @command = ();
259              
260 0         0 foreach my $argument ( @{ $args{command} } ) {
  0         0  
261 0 0       0 if ( $argument =~ /[()]/ ) {
262 0         0 push @command, qq{'$argument'};
263             } else {
264 0         0 push @command, $argument;
265             }
266             }
267              
268 0         0 my $command = join(" ",@command);
269              
270 0         0 my @results;
271              
272 0         0 eval {
273 0         0 @results = $telnet_session_of{$ident}->cmd($command);
274             };
275            
276 0         0 my $error = $@;
277              
278 0 0       0 if ( $error ) {
279 0         0 croak(
280             "Remote telnet command execution failed!!\n",
281             "Command: $command\n",
282             "Error: $error\n",
283             );
284             }
285              
286 0         0 chomp @results;
287              
288 0         0 my @stdout = ();
289 0         0 my @stderr = ();
290              
291             # XXX: Get rid of the command we sent, which will be the first
292             # line in the results, and the part of the prompt that we
293             # don't pattern match, which will be the last line. This
294             # keeps getting uglier.... Sometimes the command is NOT the
295             # first line of output...
296 0 0       0 if ( $results[0] =~ /$command/ ) {
297 0         0 shift @results;
298             }
299              
300 0         0 pop @results;
301              
302 0         0 my $command_first = $command[0];
303 0   0     0 my $command_second = $command[1] || '';
304              
305 0         0 foreach my $result ( @results ) {
306              
307             # XXX: OK, this may get out of hand, but this assumption
308             # is not always correct. We have found at least one case
309             # where a non-error is prefixed with the command name. If
310             # we have to add a lot of exceptions here, we'll need a
311             # more scalable solution.
312             #
313             # OK, we have two now.... Using telnet sucks....
314             #
315             # Yep... This is starting to get ugly....
316 0 0 0     0 if ( $result =~ /^snap reclaimable: Approximately/ ) {
    0          
    0          
    0          
317 0         0 push @stdout, $result;
318             } elsif ( $result =~ /^vol size: .* has size/ ) {
319 0         0 push @stdout, $result;
320             } elsif ( $result =~ /^snap delta: No snapshots exist/ ) {
321 0         0 push @stdout, $result;
322             } elsif ( $result =~ /^$command_first:/ ||
323             $result =~ /^$command_first $command_second:/ ) {
324 0         0 push @stderr, $result;
325             } else {
326 0         0 push @stdout, $result;
327             }
328              
329             }
330              
331 0         0 $command_stdout_of{$ident} = [ @stdout ];
332 0         0 $command_stderr_of{$ident} = [ @stderr ];
333              
334 0 0       0 if ( @stderr ) {
335 0         0 $command_status_of{$ident} = 0;
336 0 0       0 if ( ! $args{nonfatal} ) {
337 0         0 my $hostname = $self->get_hostname;
338 0         0 croak(
339             "Error running '$command' via telnet on $hostname:\n",
340             @stderr,
341             );
342             }
343             } else {
344 0         0 $command_status_of{$ident} = 1;
345             }
346              
347 0         0 return $command_status_of{$ident};
348              
349             }
350              
351             sub _run_ssh_command {
352              
353 0     0   0 my $self = shift;
354 0         0 my $ident = ident $self;
355              
356 0         0 my %args = validate( @_, {
357             command => { type => ARRAYREF },
358             nonfatal => { type => SCALAR,
359             optional => 1 },
360             });
361              
362 0         0 my $command = join(" ",@{ $args{command} });
  0         0  
363              
364 0         0 my @command = @{ $self->_get_ssh_command };
  0         0  
365              
366 0         0 foreach my $argument ( @{ $args{command} } ) {
  0         0  
367 0 0       0 if ( $argument =~ /[()]/ ) {
368 0         0 push @command, qq{'$argument'};
369             } else {
370 0         0 push @command, $argument;
371             }
372             }
373              
374 0         0 my @results = run( command => \@command );
375              
376 0         0 my $full_command = join(" ",@command);
377              
378 0         0 $command_status_of{$ident} = $results[0];
379 0         0 $command_error_of{$ident} = $results[1];
380              
381 0         0 my $stdout = join( '', @{ $results[3] } );
  0         0  
382              
383 0         0 $command_stdout_of{$ident} = [ split( /\n/, $stdout ) ];
384              
385 0         0 my $stderr = join( '', @{ $results[4] } );
  0         0  
386              
387 0         0 $command_stderr_of{$ident} = [ split( /\n/, $stderr ) ];
388              
389 0 0       0 if ( not $command_status_of{$ident} ) {
390 0         0 croak(
391             "Remote ssh command execution failed!!\n",
392             "Command: $full_command\n",
393             "Command_Error code: $command_error_of{$ident}\n",
394             "STDERR: $stderr\n",
395             );
396             }
397              
398 0 0 0     0 if ( $stderr && ! $args{nonfatal} ) {
399 0         0 my $hostname = $self->get_hostname;
400 0         0 croak(
401             "Error running '$command' via ssh on $hostname:\n",
402             $stderr,
403             );
404             }
405              
406 0         0 return $command_status_of{$ident};
407              
408             }
409              
410             sub _get_command_stdout {
411 0     0   0 return @{ $command_stdout_of{ident shift} };
  0         0  
412             }
413              
414             sub _get_command_stderr {
415 0     0   0 return @{ $command_stderr_of{ident shift} };
  0         0  
416             }
417              
418             sub _get_command_status {
419 0     0   0 return $command_status_of{ident shift};
420             }
421              
422             sub _get_command_error {
423 0     0   0 return $command_error_of{ident shift};
424             }
425              
426             sub _get_ssh_command {
427 0     0   0 return $ssh_command_of{ident shift};
428             }
429              
430             sub _clear_cache {
431              
432 0     0   0 my $self = shift;
433 0         0 my $ident = ident $self;
434              
435 0         0 my (%args) = validate( @_, {
436             method => { type => SCALAR },
437             key => { type => SCALAR,
438             optional => 1 },
439             });
440              
441 0 0       0 if ( not $cache_enabled_of{$ident} ) {
442 0         0 return 1;
443             }
444              
445 0 0       0 if ( not exists $cache_of{$ident}->{ $args{method} } ) {
446 0         0 croak("Invalid argument: $args{method} is not cached\n");
447             }
448              
449 0 0       0 if ( $args{key} ) {
450             # XXX: The keys might be more complex than this...
451 0         0 delete $cache_of{$ident}->{ $args{method} }->{ $args{key} };
452             } else {
453 0         0 %{ $cache_of{$ident}->{ $args{method} } } = ();
  0         0  
454             }
455              
456 0         0 return 1;
457              
458             }
459              
460             sub get_licenses {
461              
462 0     0 1 0 my $self = shift;
463              
464 0         0 $self->_run_command(
465             command => [qw( license )],
466             );
467              
468 0         0 my @stdout = $self->_get_command_stdout;
469              
470 0         0 my @licenses = ();
471              
472 0         0 while ( my $line = shift @stdout ) {
473              
474 0 0       0 next if $line =~ /not licensed/;
475              
476 0         0 my $license = $self->_parse_license( $line );
477              
478 0         0 push @licenses, NetApp::Filer::License->new( $license );
479              
480             }
481              
482 0         0 return @licenses;
483              
484             }
485              
486             sub get_license {
487              
488 0     0 1 0 my $self = shift;
489 0         0 my $service = shift;
490              
491 0         0 return grep { $_->get_service eq $service } $self->get_licenses;
  0         0  
492              
493             }
494              
495             sub add_license {
496              
497 0     0 1 0 my $self = shift;
498 0         0 my $code = shift;
499              
500 0         0 return $self->_run_command(
501             command => [qw(license add), $code ],
502             );
503              
504             }
505              
506             sub delete_license {
507              
508 0     0 1 0 my $self = shift;
509 0         0 my $service = shift;
510              
511 0         0 return $self->_run_command(
512             command => [qw(license delete), $service ],
513             );
514             }
515              
516             sub get_options {
517              
518 0     0 0 0 my $self = shift;
519              
520 0         0 $self->_run_command(
521             command => ['options'],
522             );
523              
524 0         0 my @stdout = $self->_get_command_stdout;
525              
526 0         0 my @options = ();
527              
528 0         0 while ( my $line = shift @stdout ) {
529              
530 0         0 my $option = $self->_parse_option( $line );
531              
532 0         0 push @options, NetApp::Filer::Option->new ( $option );
533              
534             }
535              
536 0         0 return @options;
537              
538             }
539              
540             sub get_aggregate_names {
541              
542 0     0 1 0 my $self = shift;
543              
544 0         0 $self->_run_command(
545             command => [qw( aggr status )],
546             );
547              
548 0         0 my @stdout = $self->_get_command_stdout;
549              
550 0         0 my $indices =
551             NetApp::Aggregate->_parse_aggr_status_headers( shift @stdout );
552              
553 0         0 my @names = ();
554              
555 0         0 while ( my $line = shift @stdout ) {
556              
557 0         0 my $data = NetApp::Aggregate->_parse_aggr_status_aggregate(
558             indices => $indices,
559             line => $line,
560             );
561              
562 0 0       0 if ( $data->{name} ) {
563 0         0 push( @names, $data->{name} );
564             }
565              
566             }
567              
568 0         0 return @names;
569            
570             }
571              
572             sub get_aggregates {
573            
574 0     0 1 0 my $self = shift;
575              
576 0         0 my @aggregates = ();
577              
578 0         0 foreach my $name ( $self->get_aggregate_names ) {
579 0         0 push @aggregates, $self->get_aggregate( $name );
580             }
581              
582 0         0 return @aggregates;
583              
584             }
585              
586             sub get_aggregate {
587            
588 0     0 1 0 my $self = shift;
589 0         0 my $name = shift;
590              
591 0         0 $self->_run_command(
592             command => [qw( aggr status ), $name, '-v' ],
593             );
594              
595 0         0 my @stdout = $self->_get_command_stdout;
596              
597 0         0 my $indices =
598             NetApp::Aggregate->_parse_aggr_status_headers( shift @stdout );
599              
600 0         0 my $aggregate = {};
601              
602 0         0 while ( my $line = shift @stdout ) {
603 0 0       0 last if $line =~ /^\s+$/;
604 0         0 NetApp::Aggregate->_parse_aggr_status_aggregate(
605             indices => $indices,
606             aggregate => $aggregate,
607             line => $line,
608             );
609             }
610              
611 0         0 my $volumes = {};
612              
613 0 0       0 if ( $aggregate->{status}->{aggr} ) {
614 0         0 while ( my $line = shift @stdout ) {
615 0 0       0 last if $line =~ /^\s+$/;
616 0         0 NetApp::Aggregate->_parse_aggr_status_volumes(
617             volumes => $volumes,
618             line => $line,
619             );
620             }
621             }
622              
623 0         0 my $plex =
624             NetApp::Aggregate->_parse_aggr_status_plex( shift @stdout );
625              
626 0         0 while ( my $line = shift @stdout ) {
627 0 0       0 last if $line =~ /^\s+$/;
628 0         0 push @{ $plex->{raidgroups} },
  0         0  
629             NetApp::Aggregate->_parse_aggr_status_raidgroup( $line );
630             }
631              
632              
633 0         0 return NetApp::Aggregate->new({
634             filer => $self,
635             %$aggregate,
636             volumes => $volumes,
637             plex => $plex,
638             });
639              
640             }
641              
642             sub create_aggregate {
643              
644 0     0 1 0 my $self = shift;
645              
646 0         0 my (%args) = validate( @_, {
647             name => { type => SCALAR },
648             raidtype => { type => SCALAR,
649             optional => 1 },
650             raidsize => { type => SCALAR,
651             optional => 1 },
652             disktype => { type => SCALAR,
653             optional => 1 },
654             diskcount => { type => SCALAR,
655             optional => 1 },
656             disksize => { type => SCALAR,
657             depends => [qw( diskcount )],
658             optional => 1 },
659             rpm => { type => SCALAR,
660             optional => 1 },
661             language => { type => SCALAR,
662             optional => 1 },
663             snaplock => { type => SCALAR,
664             optional => 1 },
665             mirrored => { type => SCALAR,
666             optional => 1 },
667             traditional => { type => SCALAR,
668             optional => 1 },
669             force => { type => SCALAR,
670             optional => 1 },
671             disks => { type => ARRAYREF,
672             optional => 1 },
673              
674             });
675              
676 0         0 my @command = ( qw( aggr create ), $args{name} );
677              
678 0 0       0 if ( $args{force} ) {
679 0         0 push @command, '-f';
680             }
681              
682 0 0       0 if ( $args{mirrored} ) {
683 0         0 push @command, '-m';
684             }
685              
686 0 0       0 if ( $args{raidtype} ) {
687 0         0 push @command, '-t', $args{raidtype};
688             }
689              
690 0 0       0 if ( $args{raidsize} ) {
691 0         0 push @command, '-r', $args{raidsize};
692             }
693              
694 0 0       0 if ( $args{disktype} ) {
695 0         0 push @command, '-T', $args{disktype};
696             }
697              
698 0 0       0 if ( $args{rpm} ) {
699 0         0 push @command, '-R', $args{rpm};
700             }
701              
702 0 0       0 if ( $args{snaplock} ) {
703 0         0 push @command, '-L', $args{snaplock};
704             }
705              
706 0 0       0 if ( $args{traditional} ) {
707 0         0 push @command, '-v';
708             }
709              
710 0 0       0 if ( $args{language} ) {
711 0         0 push @command, '-l', $args{language};
712             }
713              
714 0 0       0 if ( $args{diskcount} ) {
715 0 0       0 if ( $args{disksize} ) {
716 0         0 push @command, join( '@', $args{diskcount}, $args{disksize} );
717             } else {
718 0         0 push @command, $args{diskcount};
719             }
720             }
721              
722 0 0       0 if ( $args{disks} ) {
723 0 0       0 if ( ref $args{disks}->[0] eq 'ARRAY' ) {
724 0         0 push @command, '-d', @{ $args{disks}->[0] };
  0         0  
725 0         0 push @command, '-d', @{ $args{disks}->[1] };
  0         0  
726             } else {
727 0         0 push @command, '-d', @{ $args{disks} };
  0         0  
728             }
729             }
730              
731 0         0 $self->_run_command( command => \@command );
732              
733 0         0 return $self->get_aggregate( $args{name} );
734              
735             }
736              
737             sub destroy_aggregate {
738              
739 0     0 1 0 my $self = shift;
740              
741 0         0 my (%args) = validate( @_, {
742             name => { type => SCALAR },
743             });
744              
745 0         0 return $self->_run_command(
746             command => [qw( aggr destroy ), $args{name}, '-f'],
747             );
748              
749             }
750              
751             sub get_volume_names {
752              
753 0     0 1 0 my $self = shift;
754              
755 0         0 $self->_run_command(
756             command => [qw( vol status )],
757             );
758              
759 0         0 my @stdout = $self->_get_command_stdout;
760              
761 0         0 my $indices =
762             NetApp::Volume->_parse_vol_status_headers( shift @stdout );
763              
764 0         0 my @names = ();
765              
766 0         0 while ( my $line = shift @stdout ) {
767              
768 0         0 my $data = NetApp::Volume->_parse_vol_status_volume(
769             indices => $indices,
770             line => $line,
771             );
772              
773 0 0       0 if ( $data->{name} ) {
774 0         0 push( @names, $data->{name} );
775             }
776              
777             }
778              
779 0         0 return @names;
780              
781             }
782              
783             sub get_volumes {
784            
785 0     0 1 0 my $self = shift;
786              
787 0         0 my @volumes = ();
788              
789 0         0 foreach my $name ( $self->get_volume_names ) {
790 0         0 push @volumes, $self->get_volume( $name );
791             }
792              
793 0         0 return @volumes;
794              
795             }
796              
797             sub get_volume {
798            
799 0     0 1 0 my $self = shift;
800 0         0 my $name = shift;
801              
802 0         0 $self->_run_command(
803             command => [qw( vol status ), $name, '-v' ],
804             );
805              
806 0         0 my @stdout = $self->_get_command_stdout;
807              
808 0         0 my $indices =
809             NetApp::Volume->_parse_vol_status_headers( shift @stdout );
810              
811 0         0 my $volume = {};
812              
813 0         0 while ( my $line = shift @stdout ) {
814 0 0       0 last if $line =~ /^\s+$/;
815 0         0 NetApp::Volume->_parse_vol_status_volume(
816             indices => $indices,
817             volume => $volume,
818             line => $line,
819             );
820             }
821              
822 0         0 my $plex =
823             NetApp::Aggregate->_parse_aggr_status_plex( shift @stdout );
824              
825 0         0 while ( my $line = shift @stdout ) {
826 0 0       0 last if $line =~ /^\s+$/;
827 0         0 push @{ $plex->{raidgroups} },
  0         0  
828             NetApp::Aggregate->_parse_aggr_status_raidgroup( $line );
829             }
830              
831 0         0 $volume->{ filer } = $self;
832 0         0 $volume->{ plex } = $plex;
833              
834 0         0 return NetApp::Volume->new( $volume );
835              
836             }
837              
838             sub get_qtree_names {
839 0     0 1 0 return map { $_->get_name } shift->get_qtrees;
  0         0  
840             }
841              
842             sub get_qtrees {
843 0     0 1 0 return shift->_get_qtree_status;
844             }
845              
846             sub get_qtree {
847 0     0 1 0 return shift->_get_qtree_status( name => shift );
848             }
849              
850             sub _get_qtree_status {
851              
852 0     0   0 my $self = shift;
853 0         0 my (%args) = validate( @_, {
854             name => { type => SCALAR,
855             optional => 1 },
856             volume => { isa => 'NetApp::Volume',
857             optional => 1 },
858             });
859              
860 0 0 0     0 if ( $args{volume} && $args{volume}->get_state('restricted') ) {
861 0         0 return;
862             }
863              
864 0         0 my @command = qw(qtree status -v -i);
865              
866 0 0       0 if ( $args{name} ) {
    0          
867 0         0 my ($volume_name) = ( split( /\//, $args{name} ) )[2];
868 0         0 push @command, $volume_name;
869             } elsif ( $args{volume} ) {
870 0         0 push @command, $args{volume}->get_name;
871             }
872              
873             $self->_run_command(
874 0         0 command => \@command,
875             );
876              
877 0         0 my @stdout = $self->_get_command_stdout;
878              
879 0         0 splice( @stdout, 0, 2 ); # trash the two headers
880              
881 0         0 my @qtrees = ();
882              
883 0         0 while ( my $line = shift @stdout ) {
884 0         0 my $qtree = NetApp::Qtree->_parse_qtree_status_qtree( $line );
885 0         0 $qtree->{ filer } = $self;
886 0         0 push @qtrees, NetApp::Qtree->new( $qtree );
887             }
888              
889 0 0       0 if ( $args{name} ) {
890 0         0 my ($qtree) = grep { $_->get_name eq $args{name} } @qtrees;
  0         0  
891 0         0 return $qtree;
892             } else {
893 0         0 return @qtrees;
894             }
895              
896             }
897              
898             sub create_qtree {
899              
900 0     0 1 0 my $self = shift;
901              
902 0         0 my (%args) = validate( @_, {
903             name => { type => SCALAR },
904             mode => { type => SCALAR,
905             optional => 1 },
906             security => { type => SCALAR,
907             optional => 1 },
908             oplocks => { type => SCALAR,
909             optional => 1 },
910             });
911              
912 0         0 my @command = ( 'qtree', 'create', $args{name} );
913              
914 0 0       0 if ( $args{mode} ) {
915 0         0 push @command, '-m', sprintf( "%o", $args{mode} );
916             }
917              
918 0         0 $self->_run_command( command => \@command );
919              
920 0         0 $self->_clear_cache( method => 'get_qtree' );
921              
922 0         0 my $qtree = $self->get_qtree( $args{name} );
923              
924 0 0       0 if ( not $qtree ) {
925 0         0 croak(
926             "Unable to retrieve the qtree object for $args{name},\n",
927             "which we just created successfully!!\n",
928             );
929             }
930              
931 0 0       0 if ( exists $args{security} ) {
932 0         0 $qtree->set_security( $args{security} );
933             }
934              
935 0 0       0 if ( exists $args{oplocks} ) {
936 0         0 $qtree->set_oplocks( $args{oplocks} );
937             }
938              
939 0         0 return $qtree;
940              
941             }
942              
943             sub set_snapmirror_state {
944              
945 0     0 1 0 my $self = shift;
946 0         0 my $ident = ident $self;
947              
948 0         0 my $state = shift;
949              
950 0 0       0 if ( $state !~ /^(off|on)$/ ) {
951 0         0 croak(
952             "Invalid snapmirror state '$state'\n",
953             "Must be either 'off' or 'on'\n",
954             );
955             }
956              
957 0         0 $self->_run_command( command => [qw( snapmirror $state )] );
958              
959 0         0 $snapmirror_state_of{$ident} = $state;
960              
961 0         0 return 1;
962              
963             }
964              
965             sub get_snapmirror_state {
966              
967 0     0 1 0 my $self = shift;
968 0         0 my $ident = ident $self;
969              
970 0 0       0 if ( $snapmirror_state_of{$ident} !~ /^(off|on)$/ ) {
971 0         0 $self->get_snapmirrors;
972             }
973              
974 0         0 return $snapmirror_state_of{$ident};
975              
976             }
977              
978             sub get_snapmirrors {
979 0     0 1 0 return shift->_get_snapmirrors;
980             }
981              
982             sub _get_snapmirrors {
983              
984 0     0   0 my $self = shift;
985 0         0 my $ident = ident $self;
986              
987 0         0 my (%args) = validate( @_, {
988             volume => { isa => 'NetApp::Volume',
989             optional => 1 },
990             });
991              
992 0         0 my @command = qw( snapmirror status -l );
993              
994 0 0       0 if ( $args{volume} ) {
995 0         0 push @command, $args{volume}->get_name;
996             }
997              
998             $self->_run_command(
999 0         0 command => \@command,
1000             );
1001              
1002 0         0 my @stdout = $self->_get_command_stdout;
1003              
1004 0         0 my @snapmirrors = ();
1005              
1006 0         0 my $snapmirror = {};
1007              
1008 0         0 while ( defined (my $line = shift @stdout) ) {
1009              
1010 0 0       0 if ( $line =~ /Snapmirror is (on|off)/ ) {
1011 0         0 $snapmirror_state_of{$ident} = $1;
1012 0         0 next;
1013             }
1014              
1015 0 0       0 if ( $line =~ /^\s*$/ ) {
1016 0 0       0 if ( keys %$snapmirror ) {
1017 0         0 $snapmirror->{ filer } = $self;
1018 0         0 push @snapmirrors, NetApp::Snapmirror->new( $snapmirror );
1019 0         0 $snapmirror = {};
1020             }
1021 0         0 next;
1022             }
1023              
1024 0         0 $snapmirror = NetApp::Snapmirror->_parse_snapmirror_status(
1025             snapmirror => $snapmirror,
1026             line => $line,
1027             );
1028              
1029             }
1030              
1031 0 0       0 if ( keys %$snapmirror ) {
1032 0         0 $snapmirror->{ filer } = $self;
1033 0         0 push @snapmirrors, NetApp::Snapmirror->new( $snapmirror );
1034             }
1035              
1036 0         0 return @snapmirrors;
1037              
1038             }
1039              
1040             sub get_temporary_exports {
1041 0     0 1 0 return grep { $_->get_type eq 'temporary' } shift->get_exports;
  0         0  
1042             }
1043              
1044             sub get_permanent_exports {
1045 0     0 1 0 return grep { $_->get_type eq 'permanent' } shift->get_exports;
  0         0  
1046             }
1047              
1048             sub get_active_exports {
1049 0     0 1 0 return grep { $_->get_active } shift->get_exports;
  0         0  
1050             }
1051              
1052             sub get_inactive_exports {
1053 0     0 1 0 return grep { not $_->get_active } shift->get_exports;
  0         0  
1054             }
1055              
1056             sub get_exports {
1057              
1058 0     0 1 0 my $self = shift;
1059              
1060 0         0 $self->_run_command(
1061             command => [qw( exportfs )],
1062             );
1063              
1064 0         0 my @stdout = $self->_get_command_stdout;
1065              
1066 0         0 my %temporary = ();
1067              
1068 0         0 while ( defined (my $line = shift @stdout) ) {
1069              
1070 0         0 my $export = NetApp::Filer::Export->_parse_export( $line );
1071              
1072 0         0 $export->{ filer } = $self;
1073 0         0 $export->{ type } = 'temporary';
1074              
1075 0         0 $temporary{ $export->{path} } =
1076             NetApp::Filer::Export->new( $export );
1077              
1078             }
1079              
1080             $self->_run_command(
1081 0         0 command => [qw( rdfile /etc/exports )],
1082             );
1083              
1084 0         0 @stdout = $self->_get_command_stdout;
1085              
1086 0         0 my %permanent = ();
1087              
1088 0         0 while ( defined (my $line = shift @stdout) ) {
1089              
1090 0 0       0 next if $line =~ /^#/;
1091 0 0       0 next if $line =~ /^\s*$/;
1092              
1093 0         0 my $export = NetApp::Filer::Export->_parse_export( $line );
1094              
1095 0         0 $export->{ filer } = $self;
1096 0         0 $export->{ type } = 'permanent';
1097              
1098 0         0 my $permanent = NetApp::Filer::Export->new( $export );
1099 0         0 my $temporary = $temporary{ $export->{path} };
1100              
1101 0 0       0 if ( $temporary ) {
1102 0 0       0 if ( $temporary->compare( $permanent ) ) {
1103 0         0 delete $temporary{ $export->{path} };
1104             } else {
1105 0         0 $permanent->set_active( 0 );
1106             }
1107             }
1108              
1109 0         0 $permanent{ $export->{path} } = $permanent;
1110              
1111             }
1112              
1113 0         0 my @exports = (
1114             values %temporary,
1115             values %permanent,
1116             );
1117              
1118 0         0 return @exports;
1119              
1120             }
1121              
1122             }
1123              
1124             sub _parse_license {
1125              
1126 3     3   2314 my $class = shift;
1127 3         4 my $line = shift;
1128              
1129 3         23 $line =~ s/$RE{ws}{crop}//g;
1130              
1131 3         481 my @fields = split( /\s+/, $line );
1132              
1133 3         11 my $license = {
1134             service => $fields[0],
1135             expired => "",
1136             };
1137              
1138 3 100       9 if ( $fields[1] eq 'site' ) {
1139 2         6 $license->{type} = 'site';
1140 2         5 $license->{code} = $fields[2];
1141             } else {
1142 1         2 $license->{type} = 'node';
1143 1         3 $license->{code} = $fields[1];
1144             }
1145              
1146 3 100       14 if ( $line =~ /expired \((\d+ \w+ \d+)\)/ ) {
1147 1         5 $license->{expired} = $1;
1148             }
1149              
1150 3         11 return $license;
1151              
1152             }
1153              
1154             sub _parse_option {
1155              
1156 2     2   1500 my $class = shift;
1157 2         4 my $line = shift;
1158              
1159 2         9 $line =~ s/$RE{ws}{crop}//g;
1160 2         223 $line =~ s/\(.*\)$//g;
1161 2         9 $line =~ s/$RE{ws}{crop}//g;
1162              
1163 2         197 my @fields = split( /\s+/, $line );
1164              
1165 2 50       9 if ( not defined $fields[1] ) {
1166 0         0 $fields[1] = '';
1167             }
1168              
1169 2         9 my $option = {
1170             name => $fields[0],
1171             value => $fields[1],
1172             };
1173              
1174 2         6 return $option;
1175              
1176             }
1177              
1178             1;