File Coverage

blib/lib/Net/SSH2/Cisco.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             package Net::SSH2::Cisco;
2              
3             ##################################################
4             # Michael Vincent
5             # www.VinsWorld.com
6             ##################################################
7              
8             # NOTE: This module is basically a cut/paste of:
9             # 70% Net::Telnet
10             # 20% Net::Telnet::Cisco
11             # 5% Net::SSH2(::Channel)
12             # 5% original hack to make it all work together
13             #
14             # - I tried to create a child class of Net::SSH2 to no avail due to
15             # the C-type inside-out object it returns and my lack of experience.
16             #
17             # - I tried to pass a Net::SSH2 connetion to Net::Telnet(::Cisco) fhopen()
18             # method, but it returned:
19             #
20             # Not a GLOB reference at [...]/perl/vendor/lib/Net/Telnet.pm line 679.
21             #
22             # - I tried to use Net::Telnet in my @ISA with AUTOLOAD to leverage the
23             # accessors and code already written, but I'm not creating a Net::Telnet
24             # object and I couldn't get it to work.
25             #
26             # That left me the (?only?) option - to write this Franken-module "liberally
27             # borrowing" from much smarter, more talented programmers than I.
28              
29 1     1   16421 use strict;
  1         4  
  1         26  
30 1     1   5 use warnings;
  1         2  
  1         53  
31              
32             our $VERSION = '0.01';
33             our @ISA;
34              
35 1     1   1324 use Net::SSH2 0.51;
  0            
  0            
36             use Socket qw(inet_ntoa AF_INET IPPROTO_TCP);
37             my $HAVE_IO_Socket_IP = 0;
38             eval "use IO::Socket::IP -register";
39             if(!$@) {
40             $HAVE_IO_Socket_IP = 1;
41             push @ISA, "IO::Socket::IP"
42             } else {
43             require IO::Socket::INET;
44             push @ISA, "IO::Socket::INET"
45             }
46              
47             my $AF_INET6 = eval { Socket::AF_INET6() };
48             my $AF_UNSPEC = eval { Socket::AF_UNSPEC() };
49             my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() };
50             my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };
51              
52             $|++;
53              
54             ##################################################
55             # Start Public Module
56             ##################################################
57              
58             sub new {
59             my $self = shift;
60             my $class = ref($self) || $self;
61              
62             my ($fh_open, $host);
63             my %params = (
64             always_waitfor_prompt => 1,
65             autopage => 1,
66             bin_mode => 0,
67             blocking => 0,
68             cmd_prompt => '/(?m:^(?:[\w.\/]+\:)?[\w.-]+\s?(?:\(config[^\)]*\))?\s?[\$#>]\s?(?:\(enable\))?\s*$)/',
69             cmd_rm_mode => "auto",
70             dumplog => '',
71             eofile => 1,
72             errormode => "die",
73             errormsg => "",
74             fh_open => undef,
75             host => "localhost",
76             ignore_warnings => 0,
77             inputlog => '',
78             last_cmd => '',
79             last_prompt => '',
80             maxbufsize => 1_048_576,
81             more_prompt => '/(?m:^\s*--More--)/',
82             normalize_cmd => 1,
83             ofs => "",
84             opened => '',
85             outputlog => '',
86             ors => "\n",
87             peer_family => 'ipv4',
88             port => 22,
89             rs => "\n",
90             send_wakeup => 0,
91             time_out => 10,
92             timedout => '',
93             waitfor_clear => 1,
94             waitfor_pause => 0.2,
95             warnings => '/(?mx:^% Unknown VPN
96             |^%IP routing table VRF.* does not exist. Create first$
97             |^%No CEF interface information
98             |^%No matching route to delete$
99             |^%Not all config may be removed and may reappear after reactivating/
100             )/',
101             );
102              
103             $params{_SSH_} = Net::SSH2->new() or return;
104             $self = bless \%params, $class;
105              
106             my %args;
107             if (@_ == 1) {
108             ($host) = @_
109             } else {
110             %args = @_;
111             for (keys(%args)) {
112             if (/^-?always_waitfor_prompt$/i) {
113             $self->always_waitfor_prompt($args{$_});
114             } elsif (/^-?autopage$/i) {
115             $self->autopage($args{$_})
116             } elsif (/^-?binmode$/i) {
117             $self->binmode($args{$_})
118             } elsif (/^-?blocking$/i) {
119             $self->blocking($args{$_})
120             } elsif (/^-?cmd_remove_mode$/i) {
121             $self->cmd_remove_mode($args{$_})
122             } elsif (/^-?dump_log$/i) {
123             $self->dump_log($args{$_})
124             or return;
125             } elsif (/^-?errmode$/i) {
126             $self->errmode($args{$_})
127             } elsif (/^-?family$/i) {
128             $self->family($args{$_})
129             } elsif (/^-?fhopen$/i) {
130             $fh_open = $args{$_}
131             } elsif (/^-?host$/i) {
132             $host = $args{$_}
133             } elsif (/^-?input_log$/i) {
134             $self->input_log($args{$_})
135             or return;
136             } elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
137             $self->input_record_separator($args{$_})
138             } elsif (/^-?max_buffer_length$/i) {
139             $self->max_buffer_length($args{$_})
140             } elsif (/^-?normalize_cmd$/i) {
141             $self->normalize_cmd($args{$_})
142             } elsif (/^-?output_field_separator$/i or /^-?ofs$/i) {
143             $self->output_field_separator($args{$_})
144             } elsif (/^-?output_log$/i) {
145             $self->output_log($args{$_})
146             or return;
147             } elsif (/^-?output_record_separator$/i or /^-?ors$/i) {
148             $self->output_record_separator($args{$_})
149             } elsif (/^-?port$/i) {
150             $self->port($args{$_})
151             } elsif (/^-?prompt$/i) {
152             $self->prompt($args{$_})
153             } elsif (/^-?send_wakeup$/i) {
154             $self->send_wakeup($args{$_})
155             } elsif (/^-?timeout$/i) {
156             $self->timeout($args{$_})
157             } elsif (/^-?waitfor_clear$/i) {
158             $self->waitfor_clear($args{$_});
159             } elsif (/^-?waitfor_pause$/i) {
160             $self->waitfor_pause($args{$_});
161             } else {
162             # pass through
163             #$params{$_} = $args{$_}
164             &_croak($self, "bad named parameter \"$_\" given " .
165             "to " . ref($self) . "::new()");
166             }
167             }
168             }
169              
170             # $self->open in the if statement so open() not called
171             # if neither 'fh' nor 'host' are provided.
172             if (defined $fh_open) {
173             $self->fhopen($fh_open);
174             $self->open or return
175             } elsif (defined $host) {
176             $self->host($host);
177             $self->open or return
178             }
179              
180             return $self
181             }
182              
183             sub always_waitfor_prompt {
184             my ($self, $arg) = @_;
185             $self->{always_waitfor_prompt} = $arg if defined $arg;
186             return $self->{always_waitfor_prompt}
187             }
188              
189             sub autopage {
190             my ($self, $arg) = @_;
191             $self->{autopage} = $arg if defined $arg;
192             return $self->{autopage}
193             }
194              
195             sub binmode {
196             my ($self, $arg) = @_;
197             $self->{bin_mode} = $arg if defined $arg;
198             return $self->{bin_mode}
199             }
200              
201             sub blocking {
202             my ($self, $arg) = @_;
203             $self->{blocking} = $arg if defined $arg;
204             return $self->{blocking}
205             }
206              
207             sub close {
208             my ($self) = @_;
209              
210             $self->{eofile} = 1;
211             $self->{opened} = '';
212             if (defined $self->{_SSH_CHAN_}) {
213             $self->{_SSH_CHAN_}->close
214             }
215             if (defined $self->{_SSH_}) {
216             $self->{_SSH_}->disconnect
217             }
218             delete $self->{_SSH_CHAN_};
219             delete $self->{_SSH_};
220             1
221             }
222              
223             sub cmd {
224             my ($self, @args) = @_;
225              
226             my $string = '';
227             my $chan = $self->{_SSH_CHAN_};
228             my $clear = $self->{waitfor_clear};
229             my $normal = $self->{normalize_cmd};
230             my $ors = $self->{ors};
231             my $pause = $self->{waitfor_pause};
232             my $prompt = $self->{cmd_prompt};
233             my $rm = $self->{cmd_rm_mode};
234             my $rs = $self->{rs};
235             my $timeout = $self->{time_out};
236              
237             if (!defined $chan) {
238             &_croak($self, "no login " .
239             "for " . ref($self) . "::cmd()");
240             }
241              
242             my $ok = 1;
243             $self->{timedout} = '';
244              
245             my $arg_errmode = &_extract_arg_errmode($self, \@args);
246             local $self->{errormode} = $arg_errmode if $arg_errmode;
247              
248             my $output = [];
249             my $output_ref;
250             if (@_ == 2) {
251             ($string) = ($_[1])
252             } else {
253             my %args = @args;
254             for (keys(%args)) {
255             if (/^-?string$/i) {
256             $string = $args{$_}
257             } elsif (/^-?cmd_remove_mode$/i) {
258             $rm = _parse_cmd_remove_mode($self, $args{$_})
259             } elsif (/^-?input_record_separator$/i or /^-?rs$/i) {
260             $rs = $args{$_}
261             } elsif (/^-?normalize_cmd$/i) {
262             $normal = $args{$_}
263             } elsif (/^-?output$/i) {
264             $output_ref = $args{$_};
265             if (defined($output_ref) and ref($output_ref) eq "ARRAY") {
266             $output = $output_ref;
267             }
268             } elsif (/^-?output_record_separator$/i or /^-?ors$/i) {
269             $ors = $args{$_}
270             } elsif (/^-?prompt$/i) {
271             $prompt = &_parse_prompt($self, $args{$_})
272             or return;
273             } elsif (/^-?timeout$/i) {
274             $timeout = _parse_timeout($self, $args{$_})
275             } elsif (/^-?waitfor_clear$/i) {
276             $clear = $args{$_}
277             } elsif (/^-?waitfor_pause$/i) {
278             $pause = _parse_waitfor_pause($self, $args{$_})
279             or return
280             } else {
281             # pass through
282             #$params{$_} = $args{$_}
283             &_croak($self, "bad named parameter \"$_\" given " .
284             "to " . ref($self) . "::cmd()");
285             }
286             }
287             }
288              
289             #prep
290             local $self->{time_out} = $timeout;
291             local $self->{waitfor_clear} = $clear;
292             $self->errmsg("");
293             chomp $string;
294             $self->{last_cmd} = $string;
295              
296             my ($lines, $last_prompt);
297             {
298             local $self->{errormode} = "return";
299              
300             #send
301             $self->put($string . $ors);
302              
303             #wait
304             select(undef,undef,undef,$pause); # sleep
305              
306             #read
307             ($lines, $last_prompt) = $self->waitfor($prompt);
308             }
309              
310             return $self->error("command timed-out") if $self->timed_out;
311             return $self->error($self->errmsg) if $self->errmsg ne "";
312              
313             ## Split lines into an array, keeping record separator at end of line.
314             my $firstpos = 0;
315             my $rs_len = length $rs;
316             while ((my $lastpos = index($lines, $rs, $firstpos)) > -1) {
317             push(@$output, substr($lines, $firstpos, $lastpos - $firstpos + $rs_len));
318             $firstpos = $lastpos + $rs_len
319             }
320             if ($firstpos < length $lines) {
321             push @$output, substr($lines, $firstpos)
322             }
323              
324             # clean up
325             if ($rm eq "auto") {
326             if ((defined @$output[0]) and (@$output[0] =~ /^$string(?:\r)?(?:\n)?/)) {
327             shift @$output
328             }
329             } else {
330             while ($rm--) {
331             shift @$output
332             }
333             }
334             ## Ensure at least a null string when there's no command output - so
335             ## "true" is returned in a list context.
336             unless (@$output) {
337             @$output = ("")
338             }
339              
340             # Look for errors in output
341             for ( my ($i, $lastline) = (0, '');
342             $i <= $#{$output};
343             $lastline = $output->[$i++] ) {
344              
345             # This may have to be a pattern match instead.
346             if ( ( substr $output->[$i], 0, 1 ) eq '%' ) {
347             if ( $output->[$i] =~ /'\^' marker/ ) { # Typo & bad arg errors
348             chomp $lastline;
349             $self->error( join "\n",
350             "Last command and router error: ",
351             ( $self->last_prompt . $string ),
352             $lastline,
353             $output->[$i],
354             );
355             splice @$output, $i - 1, 3;
356             } else { # All other errors.
357             chomp $output->[$i];
358             $self->error( join "\n",
359             "Last command and router error: ",
360             ( $self->last_prompt . $string ),
361             $output->[$i],
362             );
363             splice @$output, $i, 2;
364             }
365             $ok = 0;
366             last;
367             }
368             }
369              
370             if ($normal) {
371             @$output = _normalize (@$output);
372             }
373              
374             ## Return command output via named arg, if requested.
375             if (defined $output_ref) {
376             if (ref($output_ref) eq "SCALAR") {
377             $$output_ref = join "", @$output;
378             } elsif (ref($output_ref) eq "HASH") {
379             %$output_ref = @$output;
380             }
381             }
382              
383             wantarray ? @$output : $ok
384             }
385              
386             sub cmd_remove_mode {
387             my ($self, $arg) = @_;
388              
389             if (defined $arg) {
390             if (defined (my $r = _parse_cmd_remove_mode($self, $arg))) {
391             $self->{cmd_rm_mode} = $r
392             }
393             }
394             return $self->{cmd_rm_mode}
395             }
396              
397             sub connect { &open }
398              
399             sub disable {
400             my $self = shift;
401             $self->cmd('disable');
402             if ($self->is_enabled) {
403             return $self->error("Failed to exit enabled mode")
404             }
405             1
406             }
407              
408             sub dump_log {
409             my ($self, $name) = @_;
410              
411             my $fh = $self->{dumplog};
412              
413             if (@_ >= 2) {
414             if (!defined($name) or $name eq "") { # input arg is ""
415             ## Turn off logging.
416             $fh = "";
417             } elsif (&_is_open_fh($name)) { # input arg is an open fh
418             ## Use the open fh for logging.
419             $fh = $name;
420             select((select($fh), $|=1)[$[]); # don't buffer writes
421             } elsif (!ref $name) { # input arg is filename
422             ## Open the file for logging.
423             $fh = &_fname_to_handle($self, $name)
424             or return;
425             select((select($fh), $|=1)[$[]); # don't buffer writes
426             } else {
427             return $self->error("bad Dump_log argument ",
428             "\"$name\": not filename or open fh");
429             }
430             $self->{dumplog} = $fh;
431             }
432             $fh;
433             }
434              
435             sub enable {
436             my $self = shift;
437              
438             my ($en_username, $en_password, $en_passcode, $en_level) = ('','','','');
439             my ($error, $lastline, $orig_errmode, $reset, %seen);
440             my $chan = $self->{_SSH_CHAN_};
441             my $ors = $self->{ors};
442             my $timeout = $self->{time_out};
443              
444             if (!defined $chan) {
445             &_croak($self, "no login " .
446             "for " . ref($self) . "::enable()");
447             }
448              
449             $self->{timedout} = '';
450              
451             if (@_ == 1) { # just passwd given
452             ($en_password) = @_
453             } else {
454             my %args = @_;
455             foreach (keys %args) {
456             if (/^-?name$|^-?login$|^-?user/i) {
457             $en_username = $args{$_}
458             } elsif (/^-?passw/i) {
459             $en_password = $args{$_}
460             } elsif (/^-?passc/i) {
461             $en_passcode = $args{$_}
462             } elsif (/^-?level$/i) {
463             $en_level = $args{$_}
464             } elsif (/^-?timeout$/i) {
465             $timeout = $args{$_}
466             } else {
467             # pass through
468             #$params{$_} = $args{$_}
469             &_croak($self, "bad named parameter \"$_\" given " .
470             "to " . ref($self) . "::enable()");
471             }
472             }
473             }
474              
475             local $self->{time_out} = $timeout;
476              
477             ## Create a subroutine to generate an error for user.
478             # $error = sub {
479             # my($errmsg) = @_;
480              
481             # if ($self->timed_out) {
482             # return $self->error($errmsg);
483             # } elsif ($self->eof) {
484             # ($lastline = $self->lastline) =~ s/\n+//;
485             # return $self->error($errmsg, ": ", $lastline);
486             # } else {
487             # return $self->error($errmsg);
488             # }
489             # };
490              
491             # Store the old prompt without the //s around it.
492             my ($old_prompt) = _prep_regex($self->{cmd_prompt});
493              
494             # We need to expect either a Password prompt or a
495             # typical prompt. If the user doesn't have enough
496             # access to run the 'enable' command, the device
497             # won't even query for a password, it will just
498             # ignore the command and display another [boring] prompt.
499             $self->put("enable " . $en_level . $ors);
500              
501             select(undef,undef,undef,$self->{waitfor_pause}); # sleep
502              
503             {
504             my ($prematch, $match) = $self->waitfor(
505             -match => '/[Ll]ogin[:\s]*$/',
506             -match => '/[Uu]sername[:\s]*$/',
507             -match => '/[Pp]assw(?:or)?d[:\s]*$/',
508             -match => '/(?i:Passcode)[:\s]*$/',
509             -match => "/$old_prompt/",
510             ) or do {
511             return &$error("read eof waiting for enable login or password prompt")
512             if $self->eof;
513             return &$error("timed-out waiting for enable login or password prompt");
514             };
515              
516             if (not defined $match) {
517             return $self->error("enable failed: access denied or bad name, passwd, etc")
518             } elsif ($match =~ /sername|ogin/) {
519             if (!defined $self->put($en_username . $ors)) {
520             return $self->error("enable failed")
521             }
522             $self->{last_prompt} = $match;
523             if ($seen{login}++) {
524             return $self->error("enable failed: access denied or bad username")
525             }
526             redo
527             } elsif ($match =~ /[Pp]assw/ ) {
528             if (!defined $self->put($en_password . $ors)) {
529             return $self->error("enable failed")
530             }
531             $self->{last_prompt} = $match;
532             if ($seen{passwd}++) {
533             return $self->error("enable failed: access denied or bad password")
534             }
535             redo
536             } elsif ($match =~ /(?i:Passcode)/ ) {
537             if (!defined $self->put($en_passcode . $ors)) {
538             return $self->error("enable failed")
539             }
540             $self->{last_prompt} = $match;
541             if ($seen{passcode}++) {
542             return $self->error("enable failed: access denied or bad passcode")
543             }
544             redo
545             } elsif ($match =~ /$old_prompt/) {
546             ## Success! Exit the block.
547             $self->{last_prompt} = $match;
548             last
549             } else {
550             return $self->error("enable received unexpected prompt. Aborting.")
551             }
552             }
553              
554             if (not defined $en_level or $en_level =~ /^[1-9]/) {
555             # Prompts and levels over 1 give a #/(enable) prompt.
556             if ($self->is_enabled) {
557             return 1
558             } else {
559             return $self->error("Failed to enter enable mode")
560             }
561             } else {
562             # Assume success
563             return 1
564             }
565             }
566              
567             sub eof {
568             my ($self) = @_;
569             exists $self->{_SSH_CHAN_} ? ($self->{_SSH_CHAN_}->eof or $self->{eofile}) : $self->{eofile};
570             }
571              
572             sub errmode {
573             my ($self, $arg) = @_;
574              
575             if (defined $arg) {
576             if (defined (my $r = _parse_errmode($self, $arg))) {
577             $self->{errormode} = $r
578             }
579             }
580             return $self->{errormode}
581             }
582              
583             sub errmsg {
584             my ($self, @errmsgs) = @_;
585              
586             if (@_ >= 2) {
587             $self->{errormsg} = join "", @errmsgs;
588             }
589              
590             return $self->{errormsg}
591             }
592              
593             sub error {
594             my ($self, @errmsg) = @_;
595              
596             if ($self->ignore_warnings) {
597             my $errmsg = join '', @errmsg;
598             my $warnings_re = _prep_regex($self->warnings);
599             return if $errmsg =~ /$warnings_re/;
600             }
601              
602             my ($errmsg, $func, $mode, @args);
603             local $_;
604              
605             if (@_ >= 2) {
606             ## Put error message in the object.
607             $errmsg = join "", @errmsg;
608             $self->{errormsg} = $errmsg;
609             ## Do the error action as described by error mode.
610             $mode = $self->{errormode};
611             if (ref($mode) eq "CODE") {
612             &$mode($errmsg);
613             return;
614             } elsif (ref($mode) eq "ARRAY") {
615             ($func, @args) = @$mode;
616             &$func(@args);
617             return;
618             } elsif ($mode =~ /^return$/i) {
619             return;
620             } else { # die
621             if ($errmsg =~ /\n$/) {
622             die $errmsg;
623             } else {
624             ## Die and append caller's line number to message.
625             &_croak($self, $errmsg);
626             }
627             }
628             } else {
629             return $self->{errormsg} ne "";
630             }
631             }
632              
633             sub family {
634             my ($self, $arg) = @_;
635              
636             if (defined $arg) {
637             if (defined (my $r = _parse_family($self, $arg))) {
638             $self->{peer_family} = $r
639             }
640             }
641             return $self->{peer_family}
642             }
643              
644             sub fhopen{
645             my ($self, $arg) = @_;
646             $self->{fh_open} = $arg if defined $arg;
647             return $self->{fh_open}
648             }
649              
650             sub host {
651             my ($self, $arg) = @_;
652             $self->{host} = $arg if defined $arg;
653             return $self->{host}
654             }
655              
656             sub ignore_warnings {
657             my ($self, $arg) = @_;
658             $self->{ignore_warnings} = $arg if defined $arg;
659             return $self->{ignore_warnings}
660             }
661              
662             sub input_log {
663             my ($self, $name) = @_;
664              
665             my $fh = $self->{inputlog};
666              
667             if (@_ >= 2) {
668             if (!defined($name) or $name eq "") { # input arg is ""
669             ## Turn off logging.
670             $fh = "";
671             } elsif (&_is_open_fh($name)) { # input arg is an open fh
672             ## Use the open fh for logging.
673             $fh = $name;
674             select((select($fh), $|=1)[$[]); # don't buffer writes
675             } elsif (!ref $name) { # input arg is filename
676             ## Open the file for logging.
677             $fh = &_fname_to_handle($self, $name)
678             or return;
679             select((select($fh), $|=1)[$[]); # don't buffer writes
680             } else {
681             return $self->error("bad Input_log argument ",
682             "\"$name\": not filename or open fh");
683             }
684             $self->{inputlog} = $fh;
685             }
686             $fh;
687             }
688              
689             sub input_record_separator {
690             my ($self, $arg) = @_;
691             $self->{rs} = $arg if (defined $arg and length $arg);
692             return $self->{rs}
693             }
694              
695             sub ios_break {
696             my ($self, $arg) = @_;
697              
698             my $chan = $self->{_SSH_CHAN_};
699             my $ret;
700             if (defined $arg) {
701             $ret = $self->put("\c^$arg")
702             } else {
703             $ret = $self->put("\c^")
704             }
705              
706             return $ret;
707             }
708              
709             sub is_enabled { $_[0]->last_prompt =~ /\#|enable|config/ ? 1 : undef }
710              
711             sub last_cmd {
712             my $self = shift;
713             exists $self->{last_cmd} ? $self->{last_cmd} : undef
714             }
715              
716             sub last_prompt {
717             my $self = shift;
718             exists $self->{last_prompt} ? $self->{last_prompt} : undef
719             }
720              
721             sub login {
722             my ($self, @args) = @_;
723              
724             if (!$self->{opened}) {
725             &_croak($self, "no connect " .
726             "for " . ref($self) . "::login()");
727             }
728              
729             my $bin = $self->{bin_mode};
730             my $block = $self->{blocking};
731             my $prompt = $self->{cmd_prompt};
732             my $timeout = $self->{time_out};
733             my $ssh = $self->{_SSH_};
734             my $sent_wakeup = 0;
735             my ($user, $pass);
736              
737             $self->{timedout} = '';
738              
739             my $arg_errmode = &_extract_arg_errmode($self, \@args);
740             local $self->{errormode} = $arg_errmode if $arg_errmode;
741              
742             if (@_ == 3) { # just username and passwd given
743             ($user, $pass) = (@_[1,2])
744             } else {
745             my %args = @args;
746             for (keys(%args)) {
747             if (/^-?(?:user)?name$/i) {
748             $user = $args{$_}
749             } elsif (/^-?passw(?:ord)?$/i) {
750             $pass = $args{$_}
751             } elsif (/^-?prompt$/i) {
752             $prompt = _parse_prompt($self, $args{$_})
753             or return
754             } elsif (/^-?timeout$/i) {
755             $timeout = _parse_timeout($self, $args{$_})
756             } else {
757             # pass through
758             #$params{$_} = $args{$_}
759             &_croak($self, "bad named parameter \"$_\" given ",
760             "to " . ref($self) . "::login()");
761             }
762             }
763             }
764              
765             if (!defined $user) {
766             &_croak($self,"username argument not given to " . ref($self) . "::login()")
767             }
768             if (!defined $pass) {
769             &_croak($self,"password argument not given to " . ref($self) . "::login()")
770             }
771              
772             local $self->{time_out} = $timeout;
773              
774             # This is where we'd do 'connect' send_wakeup if Net::SSH2 supported
775             if ($self->{send_wakeup} eq 'connect') {
776             $sent_wakeup = 1;
777              
778             # my $old_sep = $self->output_record_separator;
779             # $self->output_record_separator("\n");
780             # $self->print('');
781             # $self->output_record_separator($old_sep);
782             }
783              
784             AUTH:
785             if ($ssh->auth_password($user, $pass)) {
786             my $chan = $ssh->channel();
787             $chan->blocking($block); # 0 Needed on Windows
788             $chan->shell();
789             if ($bin) {
790             CORE::binmode ($chan)
791             }
792             $self->{_SSH_CHAN_} = $chan;
793             # flush buffer, read off first prompt
794             $self->waitfor($self->{cmd_prompt});
795             } else {
796             # This is where we'd do 'timeout' send_wakeup if Net::SSH2 supported
797             if ($sent_wakeup == 0 && $self->{send_wakeup} eq 'timeout') {
798             $sent_wakeup = 1;
799              
800             # my $old_sep = $self->output_record_separator;
801             # $self->output_record_separator("\n");
802             # $self->print('');
803             # $self->output_record_separator($old_sep);
804              
805             # goto AUTH;
806             }
807             my ($errcode, $errname, $errstr) = $ssh->error;
808             return $self->error("Net::SSH2 error $errcode:$errname [$errstr]\nauthentication failed for user - `$user'")
809             }
810             1
811             }
812              
813             sub max_buffer_length {
814             my ($self, $arg) = @_;
815              
816             my $minbufsize = 512;
817              
818             if (defined $arg) {
819             if ($arg =~ /^\d+$/) {
820             $self->{maxbufsize} = $arg
821             } else {
822             &_carp($self, "ignoring bad Max_buffer_length " .
823             "argument \"$arg\": it's not a positive integer");
824             }
825             }
826              
827             ## Adjust up values that are too small.
828             if ($self->{maxbufsize} < $minbufsize) {
829             $self->{maxbufsize} = $minbufsize;
830             }
831              
832             return $self->{maxbufsize}
833             }
834              
835             sub more_prompt {
836             my ($self, $arg) = @_;
837              
838             if (defined $arg) {
839             $self->_match_check($arg);
840             $self->{more_prompt} = $arg;
841             }
842             return $self->{more_prompt};
843             }
844              
845             sub normalize_cmd {
846             my ($self, $arg) = @_;
847             $self->{normalize_cmd} = $arg if defined $arg;
848             return $self->{normalize_cmd}
849             }
850              
851             sub ofs { &output_field_separator; }
852              
853             sub open {
854             my ($self, @args) = @_;
855              
856             return 1 if $self->{opened};
857              
858             my $ssh = $self->{_SSH_};
859             my $family = $self->{peer_family};
860             my $fh = $self->{fh_open};
861             my $host = $self->{host};
862             my $port = $self->{port};
863             my $timeout = $self->{time_out};
864              
865             $self->{timedout} = '';
866              
867             my $arg_errmode = &_extract_arg_errmode($self, \@args);
868             local $self->{errormode} = $arg_errmode if $arg_errmode;
869              
870             if (@_ == 2) {
871             ($host) = $_[1]
872             } else {
873             my %args = @args;
874             for (keys(%args)) {
875             if (/^-?fhopen$/i) {
876             $fh = $args{$_}
877             } elsif (/^-?host$/i) {
878             $host = $args{$_}
879             } elsif (/^-?family$/i) {
880             $family = _parse_family($self, $args{$_})
881             } elsif (/^-?port$/i) {
882             $port = _parse_port($self, $args{$_})
883             } elsif (/^-?timeout$/i) {
884             $timeout = _parse_timeout($self, $args{$_})
885             } else {
886             # pass through
887             #$params{$_} = $args{$_}
888             &_croak($self, "bad named parameter \"$_\" given ",
889             "to " . ref($self) . "::connect()");
890             }
891             }
892             }
893              
894             local $self->{time_out} = $timeout;
895              
896             my $r;
897             # IO::Socket object provided
898             if (defined $fh) {
899             $r = $ssh->connect($fh)
900             # host provided
901             } else {
902             # resolve
903             if (defined(my $res = _resolv($self, $host, _parse_family_to_num($self, $family)))) {
904             $host = $res->{addr};
905             $port = $res->{port} || $port
906             } else {
907             return $self->error($self->errmsg)
908             }
909             # connect if IPv4
910             if ($family eq 'ipv4') {
911             $r = $ssh->connect($host, $port, Timeout => $timeout)
912              
913             # if IPv6, Net::SSH2 doesn't yet support,
914             # so need to create our own IO::Socket::IP
915             } else {
916             my $socket = IO::Socket::IP->new(
917             PeerHost => $host,
918             PeerPort => $port,
919             Timeout => $timeout,
920             Family => _parse_family_to_num($self, $family)
921             );
922             if (!$socket) {
923             return $self->error("unable to connect to [$family] host - `$host:$port'")
924             }
925             $r = $ssh->connect($socket);
926             }
927             }
928             if (! $r) {
929             my ($errcode, $errname, $errstr) = $ssh->error;
930             return $self->error("Net::SSH2 error - $errcode:$errname = $errstr\nunable to connect to host - `$host:$port'")
931             }
932              
933             $self->{eofile} = '';
934             $self->{errormsg} = "";
935             $self->{opened} = 1;
936             $self->{timedout} = '';
937             1
938             }
939              
940             sub ors { &output_record_separator }
941              
942             sub output_field_separator {
943             my ($self, $arg) = @_;
944             $self->{ofs} = $arg if (defined $arg and length $arg);
945             return $self->{ofs}
946             }
947              
948             sub output_log {
949             my ($self, $name) = @_;
950              
951             my $fh = $self->{outputlog};
952              
953             if (@_ >= 2) {
954             if (!defined($name) or $name eq "") { # input arg is ""
955             ## Turn off logging.
956             $fh = "";
957             } elsif (&_is_open_fh($name)) { # input arg is an open fh
958             ## Use the open fh for logging.
959             $fh = $name;
960             select((select($fh), $|=1)[$[]); # don't buffer writes
961             } elsif (!ref $name) { # input arg is filename
962             ## Open the file for logging.
963             $fh = &_fname_to_handle($self, $name)
964             or return;
965             select((select($fh), $|=1)[$[]); # don't buffer writes
966             } else {
967             return $self->error("bad Output_log argument ",
968             "\"$name\": not filename or open fh");
969             }
970             $self->{outputlog} = $fh;
971             }
972             $fh;
973             }
974              
975             sub output_record_separator {
976             my ($self, $arg) = @_;
977             $self->{ors} = $arg if (defined $arg and length $arg);
978             return $self->{ors}
979             }
980              
981             sub port {
982             my ($self, $arg) = @_;
983              
984             if (defined $arg) {
985             if (defined (my $r = _parse_port($self, $arg))) {
986             $self->{port} = $r
987             }
988             }
989             return $self->{port}
990             }
991              
992             sub print {
993             my ($self) = shift;
994              
995             $self->{timedout} = '';
996              
997             return $self->error("write error: filehandle isn't open")
998             unless $self->{opened};
999              
1000             ## Add field and record separators.
1001             my $buf = join($self->{"ofs"}, @_) . $self->{"ors"};
1002              
1003             if ($self->{outputlog}) {
1004             &_log_print($self->{outputlog}, $buf);
1005             }
1006              
1007             &_put($self, \$buf, "print");
1008             }
1009              
1010             sub prompt {
1011             my ($self, $arg) = @_;
1012              
1013             if (defined $arg) {
1014             if (defined (my $r = _parse_prompt($self, $arg))) {
1015             $self->{cmd_prompt} = $r
1016             }
1017             }
1018             return $self->{cmd_prompt}
1019             }
1020              
1021             sub put {
1022             my ($self, @args) = @_;
1023              
1024             local $_;
1025              
1026             my $binmode = $self->{bin_mode};
1027             my $timeout = $self->{time_out};
1028             $self->{timedout} = '';
1029              
1030             my $arg_errmode = &_extract_arg_errmode($self, \@args);
1031             local $self->{errormode} = $arg_errmode if $arg_errmode;
1032              
1033             my $buf;
1034             if (@_ == 2) {
1035             $buf = $_[1];
1036             } elsif (@_ > 2) {
1037             my (undef, %args) = @_;
1038             foreach (keys %args) {
1039             if (/^-?binmode$/i) {
1040             $binmode = $args{$_};
1041             } elsif (/^-?string$/i) {
1042             $buf = $args{$_};
1043             } elsif (/^-?timeout$/i) {
1044             $timeout = &_parse_timeout($self, $args{$_});
1045             } else {
1046             &_croak($self, "bad named parameter \"$_\" given ",
1047             "to " . ref($self) . "::put()");
1048             }
1049             }
1050             }
1051              
1052             ## If any args given, override corresponding instance data.
1053             local $self->{bin_mode} = $binmode;
1054             local $self->{time_out} = $timeout;
1055              
1056             ## Check for errors.
1057             return $self->error("write error: filehandle isn't open")
1058             unless $self->{opened};
1059              
1060             if ($self->{outputlog}) {
1061             &_log_print($self->{outputlog}, $buf);
1062             }
1063              
1064             &_put($self, \$buf, "put");
1065             }
1066              
1067             sub rs { &input_record_separator }
1068              
1069             sub send_wakeup {
1070             my ($self, $arg) = @_;
1071             $self->{send_wakeup} = $arg if defined $arg;
1072             return $self->{send_wakeup}
1073             }
1074              
1075             sub sock {
1076             my $self = shift;
1077             exists $self->{_SSH_} ? $self->{_SSH_}->sock : undef
1078             }
1079              
1080             sub ssh2 {
1081             my $self = shift;
1082             exists $self->{_SSH_} ? $self->{_SSH_} : undef
1083             }
1084              
1085             sub ssh2_chan {
1086             my $self = shift;
1087             exists $self->{_SSH_CHAN_} ? $self->{_SSH_CHAN_} : undef
1088             }
1089              
1090             sub timed_out {
1091             my $self = shift;
1092             exists $self->{timedout} ? $self->{timedout} : undef
1093             }
1094              
1095             sub timeout {
1096             my ($self, $arg) = @_;
1097              
1098             if (defined $arg) {
1099             if (defined (my $r = _parse_timeout($self, $arg))) {
1100             $self->{time_out} = $r
1101             }
1102             }
1103             return $self->{time_out}
1104             }
1105              
1106             sub waitfor {
1107             my ($self, @args) = @_;
1108              
1109             my $ap = $self->{autopage};
1110             my $awfp = $self->{always_waitfor_prompt};
1111             my $binmode = $self->{bin_mode};
1112             my $chan = $self->{_SSH_CHAN_};
1113             my $clear = $self->{waitfor_clear};
1114             my $cmd = $self->{last_cmd};
1115             my $rm = $self->{cmd_rm_mode};
1116             my $timeout = $self->{time_out};
1117              
1118             if (!defined $chan) {
1119             &_croak($self, "no login " .
1120             "for " . ref($self) . "::waitfor()");
1121             }
1122              
1123             local $@;
1124             local $_;
1125             my $DONE = 0;
1126             my $MORE = _prep_regex($self->{more_prompt});
1127             my $PROMPT = _prep_regex($self->{cmd_prompt});
1128             my ($match, $buffer, $errmode);
1129             my @matches;
1130             if ($awfp) {
1131             push @matches, $PROMPT
1132             }
1133              
1134             $self->{timedout} = '';
1135             return if $self->{eofile};
1136             return unless @args;
1137              
1138             if (@_ == 2) {
1139             push @matches, _prep_regex($_[1])
1140             } else {
1141             my $arg;
1142             while (($_, $arg) = splice @args, 0, 2 ) {
1143             if (/^-?binmode$/i) {
1144             $binmode = $arg
1145             } elsif (/^-?errmode$/i) {
1146             $errmode = &_parse_errmode($self, $arg);
1147             } elsif (/^-?match$/i) {
1148             push @matches, _prep_regex($arg)
1149             } elsif (/^-?string$/i) {
1150             $arg =~ s/'/\\'/g; # quote ticks
1151             push @matches, $arg
1152             } elsif (/^-?timeout$/i) {
1153             $timeout = _parse_timeout($self, $arg)
1154             } elsif (/^-?waitfor_clear$/i) {
1155             $clear = $arg
1156             } else {
1157             # pass through
1158             #$params{$_} = $args{$_}
1159             &_croak($self, "bad named parameter \"$_\" given " .
1160             "to " . ref($self) . "::waitfor()");
1161             }
1162             }
1163             }
1164              
1165             local $self->{errormode} = $errmode if defined $errmode;
1166             local $self->{waitfor_clear} = $clear;
1167              
1168             eval {
1169             local $SIG{ALRM} = sub { die "timed-out\n" };
1170             alarm $timeout;
1171              
1172             if ($self->{waitfor_clear}) {
1173             $chan->flush;
1174             }
1175              
1176             # Read until $DONE
1177             while (1) {
1178             last if $DONE;
1179             last if $self->eof;
1180             my $buf;
1181             # Read chunk
1182             while (defined (my $len = $chan->read($buf,$self->{maxbufsize}))) {
1183              
1184             ## Display network traffic if requested.
1185             if ($self->{dumplog} and ($buf ne '')) {
1186             &_log_dump('<', $self->{dumplog}, \$buf, 0, $len);
1187             }
1188              
1189             # input logging
1190             if ($self->{inputlog}) {
1191             &_log_print($self->{inputlog}, $buf);
1192             }
1193              
1194             # Found match then $DONE
1195             for my $m (@matches) {
1196             if ($buf =~ /($m)/) {
1197             $match = $1;
1198             $buf =~ s/$m//;
1199             $DONE++
1200             }
1201             }
1202             # autopage
1203             if ($ap and ($buf =~ /($MORE)/)) {
1204             #$buf =~ s/$MORE//g;
1205             $self->put(" ");
1206             }
1207             $buffer .= $buf
1208             }
1209             }
1210             };
1211             alarm 0;
1212             if ($@ =~ /^timed-out$/) {
1213             $self->errmsg("timed-out during read");
1214             $self->{timedout} = 1;
1215             # If previous call to waitfor timed out, there may still be
1216             # stuff in the channel - e.g., "show run" takes time to "build
1217             # configuration" and that may time out, but the output will fill
1218             # the channel after the return and if term length is a finite
1219             # value - like the default 24 - a MORE prompt is waiting. So
1220             # we need to send a character to cancel that; otherwise, the first
1221             # character of the subsequent $chan->write() (usually from cmd())
1222             # will "disappear" from the output - satisfying the MORE prompt
1223             # and being lost forever.
1224             # The following is 'Control-Shift-Z', which breaks a MORE and
1225             # returns the prompt.
1226             #$chan->write("\cZ")
1227             if ($self->{waitfor_clear}) {
1228             $self->ios_break("Z")
1229             }
1230             }
1231              
1232             if (defined $match and ($match =~ /$PROMPT/)) {
1233             $self->{last_prompt} = $match
1234             }
1235              
1236             wantarray ? ($buffer, $match) : 1;
1237             }
1238              
1239             sub waitfor_clear {
1240             my ($self, $arg) = @_;
1241             $self->{waitfor_clear} = $arg if defined $arg;
1242             return $self->{waitfor_clear}
1243             }
1244              
1245             sub waitfor_pause {
1246             my ($self, $arg) = @_;
1247              
1248             if (defined $arg) {
1249             if (defined (my $r = _parse_waitfor_pause($self, $arg))) {
1250             $self->{waitfor_pause} = $r
1251             }
1252             }
1253             return $self->{waitfor_pause}
1254             }
1255              
1256             #### PRIVATE ####
1257              
1258             sub _append_lineno {
1259             my ($obj, @msgs) = @_;
1260              
1261             my ( $file, $line, $pkg);
1262              
1263             ## Find the caller that's not in object's class or one of its base classes.
1264             ($pkg, $file , $line) = &_user_caller($obj);
1265             join("", @msgs, " at ", $file, " line ", $line, "\n");
1266             }
1267              
1268             sub _carp {
1269             my ($self) = @_;
1270              
1271             $self->{errormsg} = &_append_lineno(@_);
1272             warn $self->{errormsg}, "\n";
1273             }
1274              
1275             sub _croak {
1276             my ($self) = @_;
1277              
1278             $self->{errormsg} = &_append_lineno(@_);
1279             die $self->{errormsg}, "\n";
1280             }
1281              
1282             sub _extract_arg_errmode {
1283             my ($self, $args) = @_;
1284             my (%args);
1285             local $_;
1286             my $errmode = '';
1287              
1288             ## Check for named parameters.
1289             return '' unless @$args >= 2;
1290              
1291             ## Rebuild args without errmode parameter.
1292             %args = @$args;
1293             @$args = ();
1294              
1295             ## Extract errmode arg.
1296             foreach (keys %args) {
1297             if (/^-?errmode$/i) {
1298             $errmode = &_parse_errmode($self, $args{$_});
1299             } else {
1300             push @$args, $_, $args{$_};
1301             }
1302             }
1303             $errmode;
1304             }
1305              
1306             sub _fname_to_handle {
1307             my ($self, $filename) = @_;
1308              
1309             no strict "refs";
1310              
1311             my $fh = &_new_handle();
1312             CORE::open $fh, ">", $filename
1313             or return $self->error("problem creating $filename: $!");
1314              
1315             $fh;
1316             }
1317              
1318             sub _is_open_fh {
1319             my ($fh) = @_;
1320             my $is_open = '';
1321             local $@;
1322              
1323             eval {
1324             local $SIG{"__DIE__"} = "DEFAULT";
1325             $is_open = defined(fileno $fh);
1326             };
1327              
1328             $is_open;
1329             }
1330              
1331             sub _log_dump {
1332             my ($direction, $fh, $data, $offset, $len) = @_;
1333              
1334             my $addr = 0;
1335             $len = length($$data) - $offset
1336             if !defined $len;
1337             return 1 if $len <= 0;
1338              
1339             my ($hexvals, $line);
1340             ## Print data in dump format.
1341             while ($len > 0) {
1342             ## Convert up to the next 16 chars to hex, padding w/ spaces.
1343             if ($len >= 16) {
1344             $line = substr $$data, $offset, 16;
1345             } else {
1346             $line = substr $$data, $offset, 16;
1347             }
1348             $hexvals = unpack("H*", $line);
1349             $hexvals .= ' ' x (32 - length $hexvals);
1350              
1351             ## Place in 16 columns, each containing two hex digits.
1352             $hexvals = sprintf("%s %s %s %s " x 4, unpack("a2" x 16, $hexvals));
1353              
1354             ## For the ASCII column, change unprintable chars to a period.
1355             $line =~ s/[\000-\037,\177-\237]/./g;
1356              
1357             ## Print the line in dump format.
1358             &_log_print($fh, sprintf("%s 0x%5.5lx: %s%s\n",
1359             $direction, $addr, $hexvals, $line));
1360              
1361             $addr += 16;
1362             $offset += 16;
1363             $len -= 16;
1364             }
1365              
1366             &_log_print($fh, "\n");
1367              
1368             1;
1369             }
1370              
1371             sub _log_print {
1372             my ($fh, $buf) = @_;
1373             local $\ = '';
1374              
1375             if (ref($fh) eq "GLOB") { # fh is GLOB ref
1376             print $fh $buf;
1377             } else { # fh isn't GLOB ref
1378             $fh->print($buf);
1379             }
1380             }
1381              
1382             sub _match_check {
1383             my ($self, $code) = @_;
1384             my $error;
1385             my @warns = ();
1386             local $@;
1387              
1388             ## Use eval to check for syntax errors or warnings.
1389             {
1390             local $SIG{"__DIE__"} = "DEFAULT";
1391             local $SIG{"__WARN__"} = sub { push @warns, @_ };
1392             local $^W = 1;
1393             local $_ = '';
1394             eval "\$_ =~ $code;";
1395             }
1396             if ($@) {
1397             ## Remove useless lines numbers from message.
1398             ($error = $@) =~ s/ at \(eval \d+\) line \d+.?//;
1399             chomp $error;
1400             return $self->error("bad match operator: $error");
1401             } elsif (@warns) {
1402             ## Remove useless lines numbers from message.
1403             ($error = shift @warns) =~ s/ at \(eval \d+\) line \d+.?//;
1404             $error =~ s/ while "strict subs" in use//;
1405             chomp $error;
1406             return $self->error("bad match operator: $error");
1407             }
1408              
1409             1;
1410             }
1411              
1412             sub _new_handle {
1413             if ($INC{"IO/Handle.pm"}) {
1414             return IO::Handle->new;
1415             } else {
1416             require FileHandle;
1417             return FileHandle->new;
1418             }
1419             }
1420              
1421             sub _normalize {
1422             $_ = join "", @_;
1423              
1424             1 while s/[^\cH\c?][\cH\c?]//mg; # ^H ^?
1425             s/^.*\cU//mg; # ^U
1426              
1427             return wantarray ? split /$/m, $_ : $_; # ORS instead?
1428             }
1429              
1430             sub _parse_cmd_remove_mode {
1431             my ($self, $arg) = @_;
1432              
1433             my $crm;
1434             if ($arg =~ /^\d+$/) {
1435             $crm = $arg
1436             } elsif ($arg =~ /^\s*auto\s*$/i) {
1437             $crm = "auto"
1438             } else {
1439             &_carp($self, "ignoring bad Cmd_remove_mode " .
1440             "argument \"$arg\": it's not \"auto\" or a " .
1441             "non-negative integer");
1442             $crm = $self->{cmd_rm_mode}
1443             }
1444             $crm
1445             }
1446              
1447             sub _parse_errmode {
1448             my ($self, $errmode) = @_;
1449              
1450             ## Set the error mode.
1451             if (!defined $errmode) {
1452             &_carp($self, "ignoring undefined Errmode argument");
1453             $errmode = $self->{errormode};
1454             } elsif ($errmode =~ /^\s*return\s*$/i) {
1455             $errmode = "return";
1456             } elsif ($errmode =~ /^\s*die\s*$/i) {
1457             $errmode = "die";
1458             } elsif (ref($errmode) eq "CODE") {
1459             } elsif (ref($errmode) eq "ARRAY") {
1460             unless (ref($errmode->[0]) eq "CODE") {
1461             &_carp($self, "ignoring bad Errmode argument: " .
1462             "first list item isn't a code ref");
1463             $errmode = $self->{errormode};
1464             }
1465             } else {
1466             &_carp($self, "ignoring bad Errmode argument \"$errmode\"");
1467             $errmode = $self->{errormode};
1468             }
1469             $errmode;
1470             }
1471              
1472             sub _parse_family {
1473             my ($self, $arg) = @_;
1474              
1475             my $family;
1476             if ($arg =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) {
1477             if ($arg =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) {
1478             $family = 'ipv4' # AF_INET
1479             } else {
1480             if (!$HAVE_IO_Socket_IP) {
1481             return $self->error("IO::Socket::IP required for IPv6")
1482             }
1483             $family = 'ipv6' # $AF_INET6
1484             }
1485             } else {
1486             return $self->error("bad Family argument \"$arg\": " .
1487             "must be \"ipv4\" or \"ipv6\"");
1488             }
1489             $family
1490             }
1491              
1492             sub _parse_family_to_num {
1493             my ($self, $arg) = @_;
1494             if ($arg eq 'ipv4') {
1495             return AF_INET
1496             } elsif ($arg eq 'ipv6') {
1497             return $AF_INET6
1498             } else {
1499             return $self->error("invalid address family - `$arg'");
1500             }
1501             }
1502              
1503             sub _parse_port {
1504             my ($self, $arg) = @_;
1505              
1506             my $port;
1507             if ($arg =~ /^\d{1,5}$/) {
1508             if (($arg > 0) and ($arg < 65536)) {
1509             $port = $arg
1510             } else {
1511             return $self->error("not a valid port - `$arg'")
1512             }
1513             } else {
1514             return $self->error("port not a valid number - `$arg'")
1515             }
1516             $port
1517             }
1518              
1519             sub _parse_prompt {
1520             my ($self, $prompt) = @_;
1521              
1522             unless (defined $prompt) {
1523             $prompt = "";
1524             }
1525              
1526             return $self->error("bad Prompt argument \"$prompt\": " .
1527             "missing opening delimiter of match operator")
1528             unless $prompt =~ m(^\s*/) or $prompt =~ m(^\s*m\s*\W);
1529              
1530             $prompt;
1531             }
1532              
1533             sub _parse_timeout {
1534             my ($self, $arg) = @_;
1535              
1536             my $timeout;
1537             if ($arg =~ /^\d+$/) {
1538             $timeout = $arg
1539             } else {
1540             return $self->error("not a valid timeout - `$arg'")
1541             }
1542             $timeout
1543             }
1544              
1545             sub _parse_waitfor_pause {
1546             my ($self, $arg) = @_;
1547              
1548             my $wfp;
1549             if ($arg =~ /^[0-9]*\.?[0-9]+$/) {
1550             $wfp = $arg
1551             } else {
1552             return $self->error("not a valid waitfor_pause - `$arg'")
1553             }
1554             $wfp
1555             }
1556              
1557             sub _put {
1558             my ($self, $buf, $subname) = @_;
1559              
1560             return $self->error("write error: filehandle isn't open")
1561             unless $self->{opened};
1562              
1563             if (exists $self->{_SSH_CHAN_}) {
1564             my $nwrote = $self->{_SSH_CHAN_}->write($$buf);
1565              
1566             ## Display network traffic if requested.
1567             if ($self->{dumplog}) {
1568             &_log_dump('>', $self->{dumplog}, $buf, 0, $nwrote);
1569             }
1570             } else {
1571             return $self->error("Net::SSH2::Channel not created")
1572             }
1573             1
1574             }
1575              
1576             sub _prep_regex {
1577             my ($regex) = @_;
1578             # strip leading / if found
1579             $regex =~ s/^\///;
1580             # strip trailing / if found
1581             $regex =~ s/\/$//;
1582              
1583             return $regex
1584             }
1585              
1586             ##################################################
1587             # DNS hostname resolution
1588             # return:
1589             # $host->{name} = host - as passed in
1590             # $host->{host} = host - as passed in without :port
1591             # $host->{port} = OPTIONAL - if :port, then value of port
1592             # $host->{addr} = resolved numeric address
1593             # $host->{family} = AF_INET/6
1594             ############################
1595             sub _resolv {
1596             my ($self, $name, $family) = @_;
1597              
1598             my %h;
1599             $h{name} = $name;
1600              
1601             # Default to IPv4 for backward compatiblity
1602             # THIS MAY CHANGE IN THE FUTURE!!!
1603             if (!defined $family) {
1604             $family = AF_INET
1605             }
1606              
1607             # START - host:port
1608             my $cnt = 0;
1609              
1610             # Count ":"
1611             $cnt++ while ($name =~ m/:/g);
1612              
1613             # 0 = hostname or IPv4 address
1614             if ($cnt == 0) {
1615             $h{host} = $name
1616             # 1 = IPv4 address with port
1617             } elsif ($cnt == 1) {
1618             ($h{host}, $h{port}) = split /:/, $name
1619             # >=2 = IPv6 address
1620             } elsif ($cnt >= 2) {
1621             #IPv6 with port - [2001::1]:port
1622             if ($name =~ /^\[.*\]:\d{1,5}$/) {
1623             ($h{host}, $h{port}) = split /:([^:]+)$/, $name # split after last :
1624             # IPv6 without port
1625             } else {
1626             $h{host} = $name
1627             }
1628             }
1629              
1630             # Clean up host
1631             $h{host} =~ s/\[//g;
1632             $h{host} =~ s/\]//g;
1633             # Clean up port
1634             if (defined $h{port} && (($h{port} !~ /^\d{1,5}$/) || ($h{port} < 1) || ($h{port} > 65535))) {
1635             $self->errmsg("Invalid port `$h{port}' in `$name'");
1636             return undef
1637             }
1638             # END - host:port
1639              
1640             # address check
1641             # new way
1642             if ($Socket::VERSION >= 1.94) {
1643             my %hints = (
1644             family => $AF_UNSPEC,
1645             protocol => IPPROTO_TCP,
1646             flags => $AI_NUMERICHOST
1647             );
1648              
1649             # numeric address, return
1650             my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
1651             if (defined $getaddr[0]) {
1652             $h{addr} = $h{host};
1653             $h{family} = $getaddr[0]->{family};
1654             return \%h
1655             }
1656             # old way
1657             } else {
1658             # numeric address, return
1659             my $ret = gethostbyname($h{host});
1660             if (defined $ret && (inet_ntoa($ret) eq $h{host})) {
1661             $h{addr} = $h{host};
1662             $h{family} = AF_INET;
1663             return \%h
1664             }
1665             }
1666              
1667             # resolve
1668             # new way
1669             if ($Socket::VERSION >= 1.94) {
1670             my %hints = (
1671             family => $family,
1672             protocol => IPPROTO_TCP
1673             );
1674              
1675             my ($err, @getaddr) = Socket::getaddrinfo($h{host}, undef, \%hints);
1676             if (defined $getaddr[0]) {
1677             my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr}, $NI_NUMERICHOST);
1678             if (defined $address) {
1679             $h{addr} = $address;
1680             $h{addr} =~ s/\%(.)*$//; # remove %ifID if IPv6
1681             $h{family} = $getaddr[0]->{family};
1682             return \%h
1683             } else {
1684             $self->errmsg("getnameinfo($getaddr[0]->{addr}) failed - $err");
1685             return undef
1686             }
1687             } else {
1688             my $LASTERROR = sprintf "getaddrinfo($h{host},,%s) failed - $err", ($family == AF_INET) ? "AF_INET" : "AF_INET6";
1689             $self->errmsg($LASTERROR);
1690             return undef
1691             }
1692             # old way
1693             } else {
1694             if ($family == $AF_INET6) {
1695             $self->errmsg("Socket >= 1.94 required for IPv6 - found Socket $Socket::VERSION");
1696             return undef
1697             }
1698              
1699             my @gethost = gethostbyname($h{host});
1700             if (defined $gethost[4]) {
1701             $h{addr} = inet_ntoa($gethost[4]);
1702             $h{family} = AF_INET;
1703             return \%h
1704             } else {
1705             $self->errmsg("gethostbyname($h{host}) failed - $^E");
1706             return undef
1707             }
1708             }
1709             }
1710              
1711             sub _user_caller {
1712             my ($obj) = @_;
1713              
1714             my ($class, $curr_pkg, $file, $i, $line, $pkg, %isa, @isa);
1715             local $@;
1716             local $_;
1717              
1718             ## Create a boolean hash to test for isa. Make sure current
1719             ## package and the object's class are members.
1720             $class = ref $obj;
1721             @isa = eval "\@${class}::ISA";
1722             push @isa, $class;
1723             ($curr_pkg) = caller 1;
1724             push @isa, $curr_pkg;
1725             %isa = map { $_ => 1 } @isa;
1726              
1727             ## Search back in call frames for a package that's not in isa.
1728             $i = 1;
1729             while (($pkg, $file, $line) = caller ++$i) {
1730             next if $isa{$pkg};
1731              
1732             return ($pkg, $file, $line);
1733             }
1734              
1735             ## If not found, choose outer most call frame.
1736             ($pkg, $file, $line) = caller --$i;
1737             return ($pkg, $file, $line);
1738             }
1739              
1740             1;
1741              
1742             __END__