--- net-telnet-cisco-1.10.orig/Changes +++ net-telnet-cisco-1.10/Changes @@ -1,69 +1,84 @@ -$Id: Changes,v 1.19 2002/06/18 16:37:02 jkeroes Exp $ - Revision history for Perl extension Net::Telnet::Cisco. -1.0 Fri Jul 14 11:11:42 PDT 2000 - - Initial release +$Id: Changes,v 1.7 2002/12/31 00:12:32 jkeroes Exp $ -1.01 Fri Jul 14 15:07:00 PDT 2000 - - Fixed CPAN installation issues -1.02 Mon Jul 24 16:22:11 PDT 2000 - - enable() enables. - - Simplified disable(). - - prompt() and is_enabled() handle prompts with '(enable)' in them. - - Added Windows installation tips to INSTALL. - - test.pl keeps a log (test.log) of the session if there were errors. +1.11 Thu Oct 24 12:36:20 PDT 2002 + - Refactored tests + - Added new warnings + - warnings() & errors() added. + - Prompt change: match an optional linefeed before hostname. + - Attempt to unbuffer output + - Doesn't autopage if an error occurs. + - ignore_warnings, warnings, more_prompt, when set in new(), aren't ignored. + - more_prompt allows optional NULL(s) at beginning-of-line + - warnings regexen //x and space bugfixes. + - internal prompt handling improved + - new Windows tips in INSTALL + - Changes file reversed. Recent changes are at the top. -1.03 Sun Jul 30 14:58:44 PDT 2000 - - Found and fixed bug in enable(), hopefully forever. - - cmd() and waitfor() properly handle multiple args. - - waitfor() handles -Match args with m... notation. - - Fixed occasional bug where last_prompt would return a - regex matching a prompt and not the prompt itself. - - Added enable() block to POD's Synopsis. - - Added "new" to the constructor in POD's Synopsis. - - Improved default prompt: - Old: /[\w\s().-]*[\$#>]\s?(?:\(enable\))?\s*$/' - New: /[\w().-]*[\$#>]\s?(?:\(enable\))?\s*$/ +1.10 Tue Jun 18 10:28:05 PDT 2002 + - Fixed warning in prompt_append() + - warnings() and ignore_warnings() allow some error-strings to be ignored. + - send_wakeup() written to help use module with Livingston Portmasters. -1.04 Thu Jan 25 15:49:57 PST 2001 - - Aaron Racine submitted a patch for a prompt bug in enable() - - Private release +1.09 Wed Mar 13 12:45:33 PST 2002 + - Using ExtUtils::MakeMaker::prompt in test.pl for noninteractive installs + - New method: ios_break() - sends control-^ + - Project has a home: NetTelnetCisco.sourceforge.net + - Defaults now listed in docs + - New method: normalize_cmd() - strips ^H, ^?, and ^U + - Autopage bugfix - 1st line of every page after the 1st was missing -1.05 Wed Aug 8 17:57:56 PDT 2001 - - enable() accepts -Name, -Password, -Passcode, and -Level args - - All args to login() are optional, including -Name - - Reworked internals of login() and enable() - - New EXAMPLES docs - - New PIX firewall "PIX Passwd: " prompt support - - New XTACACS/SecurID "PASSCODE: " prompt support - - Default cmd_prompt now anchored to beginning of line with (?m). - - New cmd_prompt, see docs. +1.08 Wed Jan 30 15:49:26 PST 2002 + - Testing: Errmode set to \&Test::More::fail + - Better error reporting from invalid prompts + - Better internal prompt handling + - Fixed argument handling in new() + - New feature: autopage() + +1.07 Tue Jan 15 12:41:36 PST 200 + - Bugfix from Leonardo Cont - used wrong errmsg in enable() 1.06 Mon Jan 14 09:42:20 PST 2002 - - Turned on warnings, minor related changes - Correctly return an error in waitfor() + - Turned on warnings, minor related changes -1.07 Tue Jan 15 12:41:36 PST 200 - - Bugfix from Leonardo Cont - used wrong errmsg in enable() +1.05 Wed Aug 8 17:57:56 PDT 2001 + - New cmd_prompt, see docs. + - Default cmd_prompt now anchored to beginning of line with (?m). + - New XTACACS/SecurID "PASSCODE: " prompt support + - New PIX firewall "PIX Passwd: " prompt support + - New EXAMPLES docs + - Reworked internals of login() and enable() + - All args to login() are optional, including -Name + - enable() accepts -Name, -Password, -Passcode, and -Level args -1.08 Wed Jan 30 15:49:26 PST 2002 - - New feature: autopage() - - Fixed argument handling in new() - - Better internal prompt handling - - Better error reporting from invalid prompts - - Testing: Errmode set to \&Test::More::fail +1.04 Thu Jan 25 15:49:57 PST 2001 + - Private release + - Aaron Racine submitted a patch for a prompt bug in enable() -1.09 Wed Mar 13 12:45:33 PST 2002 - - Autopage bugfix - 1st line of every page after the 1st was missing - - New method: normalize_cmd() - strips ^H, ^?, and ^U - - Defaults now listed in docs - - Project has a home: NetTelnetCisco.sourceforge.net - - New method: ios_break() - sends control-^ - - Using ExtUtils::MakeMaker::prompt in test.pl for noninteractive installs +1.03 Sun Jul 30 14:58:44 PDT 2000 + New: /[\w().-]*[\$#>]\s?(?:\(enable\))?\s*$/ + Old: /[\w\s().-]*[\$#>]\s?(?:\(enable\))?\s*$/' + - Improved default prompt: + - Added "new" to the constructor in POD's Synopsis. + - Added enable() block to POD's Synopsis. + regex matching a prompt and not the prompt itself. + - Fixed occasional bug where last_prompt would return a + - waitfor() handles -Match args with m... notation. + - cmd() and waitfor() properly handle multiple args. + - Found and fixed bug in enable(), hopefully forever. -1.10 Tue Jun 18 10:28:05 PDT 2002 - - send_wakeup() written to help use module with Livingston Portmasters. - - warnings() and ignore_warnings() allow some error-strings to be ignored. - - fixed warning in prompt_append() +1.02 Mon Jul 24 16:22:11 PDT 2000 + - test.pl keeps a log (test.log) of the session if there were errors. + - Added Windows installation tips to INSTALL. + - prompt() and is_enabled() handle prompts with '(enable)' in them. + - Simplified disable(). + - enable() enables. + +1.01 Fri Jul 14 15:07:00 PDT 2000 + - Fixed CPAN installation issues + +1.0 Fri Jul 14 11:11:42 PDT 2000 + - Initial release --- net-telnet-cisco-1.10.orig/Cisco.pm +++ net-telnet-cisco-1.10/Cisco.pm @@ -3,9 +3,11 @@ #----------------------------------------------------------------- # Net::Telnet::Cisco - interact with a Cisco router # -# $Id: Cisco.pm,v 1.52 2002/06/18 17:17:03 jkeroes Exp $ +# $Id: Cisco.pm,v 1.11 2002/12/31 00:12:32 jkeroes Exp $ # -# Todo: Add error and access logging. +# Code wraps at 120 chars/line. Join us. +# +# TODO: Use hash as object base instead of filestream. # # POD documentation at end of file. # @@ -14,14 +16,14 @@ require 5.005; use strict; -use Net::Telnet 3.02; +use Net::Telnet 3.03; use AutoLoader; use Carp; use vars qw($AUTOLOAD @ISA $VERSION $DEBUG); @ISA = qw(Net::Telnet); -$VERSION = '1.10'; +$VERSION = '1.10_085'; $^W = 1; $DEBUG = 0; $|++; @@ -37,68 +39,47 @@ # Add default prompt to args if none present. push @_, (-Prompt => - '/(?m:^[\w.-]+\s?(?:\(config[^\)]*\))?\s?[\$#>]\s?(?:\(enable\))?\s*$)/') + '/(?m:^[\r\b]?[\w.-]+\s?(?:\(config[^\)]*\))?\s?[\$\#>]\s?(?:\(enable\))?\s*$)/') unless grep /^-?prompt$/i, @_; # There's a new cmd_prompt in town. $self = $class->SUPER::new(@_) or return; + # *Must* define all defaults here. They're used below to parse incoming args. *$self->{net_telnet_cisco} = { - last_prompt => '', - last_cmd => '', - - always_waitfor_prompt => 1, - waitfor_pause => 0.1, - - autopage => 1, - - more_prompt => '/(?m:^\s*--More--)/', - - normalize_cmd => 1, + last_prompt => '', + last_cmd => '', - send_wakeup => 0, + waitfor_pause => 0.1, - ignore_warnings => 0, - warnings => '/(?mx:^% Unknown VPN - |^%IP routing table VRF.* does not exist. Create first$ - |^%No CEF interface information - |^%No matching route to delete$ - |^%Not all config may be removed and may reappear after reactivating/ - )/', + always_waitfor_prompt => 1, + autopage => 1, + normalize_cmd => 1, + send_wakeup => 0, + ignore_warnings => 0, + + more_prompt => '/(?m:^[\s\0]*--More--)/', + errors => '/(?mx:^Unknown\ command\ "[^\"]*"\ Use\ \'help\'\ for\ more\ info + |\%\ Unknown\ command\ or\ computer\ name + )/', + warnings => '/(?mx:^%\s?Unknown\ VPN + |^\%\s?IP\ routing\ table\ VRF.*\ does\ not\ exist\.\ Create\ first$ + |^\%\s?No\ CEF\ interface\ information + |^\%\s?No\ matching\ route\ to\ delete$ + |^\%\s?Not\ all\ config\ may\ be\ removed\ and\ may\ reappear\ after\ reactivating + |^\%\s?Warning: + )/', }; - ## Parse the args. if (@_ == 2) { # one positional arg given $host = $_[1]; - } elsif (@_ > 2) { # named args - ## Get the named args. + } elsif (@_ > 2) { # named args %args = @_; - ## Parse the errmode named arg first. - foreach (keys %args) { - $self->errmode($args{$_}) - if /^-?errmode$/i; - } - - ## Parse all other named args. - foreach (keys %args) { - if (/^-?always_waitfor_prompt$/i) { - $self->always_waitfor_prompt($args{$_}); - } - elsif (/^-?waitfor_pause$/i) { - $self->waitfor_pause($args{$_}); - } - elsif (/^-?more_prompt$/i) { - $self->more_prompt($args{$_}); - } - elsif (/^-?autopage$/i) { - $self->autopage($args{$_}); - } - elsif (/^-?normalize_cmd$/i) { - $self->normalize_cmd($args{$_}); - } - elsif (/^-?send_wakeup$/i) { - $self->send_wakeup($args{$_}); + ## Parse the errmode named arg first then all other named args. + foreach my $method ( 'errmode', keys %{ * $self->{net_telnet_cisco} } ) { + for ( grep defined, @args{$method, "-$method", "\u\L$method", "-\u\L$method" } ) { + $self->$method( $_ ); } } } @@ -154,7 +135,10 @@ my $self = shift; my $ok = 1; + select((select($self), $|=1)[$[]); # don't buffer writes + my $normalize = $self->normalize_cmd; + my @page_args; # Parse args if (@_ == 1) { @@ -164,6 +148,10 @@ while (my ($k, $v) = splice @args, 0, 2) { $ {*$self}{net_telnet_cisco}{last_cmd} = $v if $k =~ /^-?[Ss]tring$/; $normalize = $v if $k =~ /^-?[Nn]ormalize_cmd$/; + + # Save some arguments for autopaging + next if $k =~ /^(?:-?[Ss]tring|-?[Cc]md_remove_mode)$/; + push @page_args, $k, $v; } } @@ -171,57 +159,50 @@ my $old_ors = $self->output_record_separator; my $need_more = 0; my @out; + $ {*$self}{net_telnet_cisco}{err} = 0; - while(1) { + while($ {*$self}{net_telnet_cisco}{err} == 0) { # Send a space (with no newline) whenever we see a "More" prompt. if ($need_more) { $self->output_record_separator(''); # We saw a more prompt, so put it in the command output. - my @tmp = $self->last_prompt; + # + # Send the , taking care not to discard the top line. + # Also need to send the user's args to this: + + my @tmp = + ( $self->last_prompt, + $self->SUPER::cmd(String => " ", + Cmd_remove_mode => 0, + Prompt => $self->more_prompt, + @page_args, + ) + ); + + push @out, $self->normalize_cmd + ? _normalize(@tmp) + : @tmp; - # Send the , taking care not to - # discard the top line. - push @tmp, $self->SUPER::cmd(String => " ", Cmd_remove_mode => 0); + } else { + $self->output_record_separator($old_ors); - if ($self->normalize_cmd) { - push @out, _normalize(@tmp); + if (scalar @_ == 1) { + push @out, $self->autopage + ? $self->SUPER::cmd( -Prompt => $self->more_prompt, + -String => +shift ) + : $self->SUPER::cmd( +shift ); } else { - push @out, @tmp; + push @out, $self->autopage + ? $self->SUPER::cmd( -Prompt => $self->more_prompt, + @_ ) + : $self->SUPER::cmd( @_ ); } - } else { - $self->output_record_separator($old_ors); - push @out, $self->SUPER::cmd(@_); } - # Look for errors in output - for ( my ($i, $lastline) = (0, ''); - $i <= $#out; - $lastline = $out[$i++] ) { - - # This may have to be a pattern match instead. - if ( ( substr $out[$i], 0, 1 ) eq '%' ) { - if ( $out[$i] =~ /'\^' marker/ ) { # Typo & bad arg errors - chomp $lastline; - $self->error( join "\n", - "Last command and router error: ", - ( $self->last_prompt . $cmd ), - $lastline, - $out[$i], - ); - splice @out, $i - 1, 3; - } else { # All other errors. - chomp $out[$i]; - $self->error( join "\n", - "Last command and router error: ", - ( $self->last_prompt . $cmd ), - $out[$i], - ); - splice @out, $i, 2; - } - $ok = 0; - last; - } + if ($self->find_errors(@out) ) { + $ok = 0; + last; } # Restore old settings @@ -229,7 +210,9 @@ # redo the while loop if we saw a More prompt. my $more_re = $self->re_sans_delims($self->more_prompt); - if ($self->autopage && $self->last_prompt =~ /$more_re/) { + if ($self->autopage && ( $self->last_prompt =~ /$more_re/ + || $out[-1] =~ /$more_re/ ) + ) { $need_more = 1; } else { last; @@ -239,6 +222,64 @@ return wantarray ? @out : $ok; } +sub find_errors { + my ($self, @out) = @_; + + my $stream = $ {*$self}{net_telnet_cisco}; + my $cmd = $stream->{last_cmd}; + my $is_err = 0; + + # Look for errors in output + for ( my ($i, $lastline) = (0, ''); + $i <= $#out; + $lastline = $out[$i++] ) { + + # This may have to be a pattern match instead. + if ( ( substr $out[$i], 0, 1 ) eq '%' ) { + if ( $out[$i] =~ /'\^' marker/ ) { # Typo & bad arg errors + chomp $lastline; + $self->error( join "\n", + "Last command and router error: ", + ( $self->last_prompt . $cmd ), + $lastline, + $out[$i], + ); + splice @out, $i - 1, 3; + } else { # All other errors. + chomp $out[$i]; + $self->error( join "\n", + "Last command and router error: ", + ( $self->last_prompt . $cmd ), + $out[$i], + ); + splice @out, $i, 2; + } + + $is_err++; + + # Handle special case errors + } elsif ($stream->{errors}) { + my $errors_re = $self->re_sans_delims($stream->{errors}); + + if ( $out[$i] =~ /$errors_re/ ) { + chomp $out[$i]; + $self->error( join "\n", + "Last command and router error: ", + ( $self->last_prompt . $cmd ), + $out[$i], + ); + # XXX: splice out correct number of lines. This isn't flexible. + # Sure wish I had a CatOS box to experiment with. Cisco, are + # you listening? :-) + splice @out, $i, 2; + + $is_err++; + } + } + } + + return $is_err; +} # waitfor now stores prompts to $obj->last_prompt() sub waitfor { @@ -277,7 +318,6 @@ my $prompt_re = $self->re_sans_delims($self->prompt); my $more_re = $self->re_sans_delims($self->more_prompt); - # Add the current prompt if it's not already there. You can turn this behavior # off by setting always_waitfor_prompt to a false value. if ($self->always_waitfor_prompt && index($all_re, $prompt_re) == -1) { @@ -288,7 +328,7 @@ $all_re = $self->re_sans_delims($all_prompts); } - # Add the more prompt if it's not present. See the autopage() docs + # Add the more prompt if it's not present. See autopage() docs # to turn this behaviour off. if ($self->autopage && index($all_re, $more_re) == -1) { unshift @_, "-Match" if @_ == 1; @@ -340,11 +380,13 @@ $usage, $sent_wakeup, ); - my ($username, $password, $tacpass, $passcode ) = ('','','',''); + my ($username, $password, $tacpass, $passcode ) = ('') x 4; my (%args, %seen); local $_; + select((select($self), $|=1)[$[]); # don't buffer writes + ## Init vars. $timeout = $self->timeout; $self->timed_out(''); @@ -483,13 +525,17 @@ # Overridden to support ignore_warnings() +# Also sets err flag sub error { my $self = shift; + my $stream = $ {*$self}{net_telnet_cisco}; + + $stream->{err} = 1; # Ignore warnings if ($self->ignore_warnings) { my $errmsg = join '', @_; - my $warnings_re = $self->re_sans_delims($self->warnings); + my $warnings_re = $self->re_sans_delims($stream->{warnings}); return if $errmsg =~ /$warnings_re/; } @@ -502,9 +548,11 @@ my $self = shift; my $usage = 'usage: $obj->enable([Name => $name,] [Password => $password,] ' . '[Passcode => $passcode,] [Level => $level] )'; - my ($en_username, $en_password, $en_passcode, $en_level) = ('','','',''); + my ($en_username, $en_password, $en_passcode, $en_level) = ('') x 4; my ($error, $lastline, $orig_errmode, $reset, %args, %seen); + select((select($self), $|=1)[$[]); # don't buffer writes + if (@_ == 1) { # just passwd given ($en_password) = shift; } else { # named args given @@ -539,14 +587,16 @@ } }; + return &$error("enable() failed: -Level was passed an undef.") + unless defined $en_level; + # Store the old prompt without the //s around it. my ($old_prompt) = $self->re_sans_delims($self->prompt); - # We need to expect either a Password prompt or a - # typical prompt. If the user doesn't have enough - # access to run the 'enable' command, the device - # won't even query for a password, it will just - # ignore the command and display another [boring] prompt. + # We need to expect either a Password prompt or a typical + # prompt. If the user doesn't have enough access to run the + # 'enable' command, the device won't even query for a password, it + # will just ignore the command and display another [boring] prompt. $self->print("enable $en_level"); { @@ -563,7 +613,7 @@ }; if (not defined $match) { - return &$error("enable failed: access denied or bad name, passwd, etc"); + return &$error("enable failed: access denied or bad name, passwd, etc."); } elsif ($match =~ /sername|ogin/) { $self->print($en_username) or return &$error("enable failed"); $seen{login}++ @@ -587,7 +637,7 @@ } } - if (not defined $en_level or $en_level =~ /^[1-9]/) { + if (not $en_level or $en_level =~ /^[1-9]/) { # Prompts and levels over 1 give a #/(enable) prompt. return $self->is_enabled ? 1 : &$error('Failed to enter enable mode'); } else { @@ -599,6 +649,7 @@ # Leave enabled mode. sub disable { my $self = shift; + select((select($self), $|=1)[$[]); # don't buffer writes $self->cmd('disable'); return $self->is_enabled ? $self->error('Failed to exit enabled mode') : 1; } @@ -607,9 +658,11 @@ sub ios_break { my $self = shift; + select((select($self), $|=1)[$[]); # don't buffer writes + my $old_ors = $self->output_record_separator; $self->output_record_separator(''); - my $ret = $self->print("\c^"); + my $ret = $self->print("\c^b", @_); $self->output_record_separator($old_ors); return $ret; @@ -631,68 +684,40 @@ # Examines the last prompt to determine the current mode. # Some prompts may be hard set to #, so this won't always return a valid answer. -# Call 'show priv' instead. +# This is a pretty weak heuristic. $session->cmd('show priv') is the better way. +# # 1 => enabled. # undef => not enabled. sub is_enabled { $_[0]->last_prompt =~ /\#|enable|config/ ? 1 : undef } -# Typical get/set method. -sub always_waitfor_prompt { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{always_waitfor_prompt} = $arg if defined $arg; - return $stream->{always_waitfor_prompt}; -} - -# Typical get/set method. -sub waitfor_pause { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{waitfor_pause} = $arg if defined $arg; - return $stream->{waitfor_pause}; -} - -# Typical get/set method. -sub autopage { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{autopage} = $arg if defined $arg; - return $stream->{autopage}; -} - -# Typical get/set method. -sub normalize_cmd { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{normalize_cmd} = $arg if defined $arg; - return $stream->{normalize_cmd}; +# Create all get/set methods: +for my $sub (qw/always_waitfor_prompt waitfor_pause autopage + normalize_cmd send_wakeup ignore_warnings/) { + + no strict 'refs'; + + *$sub = sub { + my ($self, $arg) = @_; + my $stream = $ {*$self}{net_telnet_cisco}; + $stream->{$sub} = $arg if defined $arg; + return $stream->{$sub}; + }; } -# Typical get/set method. -sub send_wakeup { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{send_wakeup} = $arg if defined $arg; - return $stream->{send_wakeup}; -} +# Creates all prompt get/set methods: +for my $sub (qw/errors warnings more_prompt/) { -# Typical get/set method. -sub ignore_warnings { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - $stream->{ignore_warnings} = $arg if defined $arg; - return $stream->{ignore_warnings}; -} + no strict 'refs'; -# Get/set the More prompt -sub more_prompt { - my ($self, $arg) = @_; - my $stream = $ {*$self}{net_telnet_cisco}; - if (defined $arg) { - $self->_match_check($arg); - $stream->{more_prompt} = $arg; + *$sub = sub { + my ($self, $arg) = @_; + my $stream = $ {*$self}{net_telnet_cisco}; + if (defined $arg) { + $self->_match_check($arg); + $stream->{$sub} = $arg; + } + return $stream->{$sub}; } - return $stream->{more_prompt}; } # Join two or more regexen into one on "|". @@ -730,6 +755,7 @@ } # Return a Net::Telnet regular expression without the delimiters. +# XXX: an excellent candidate for memoization. sub re_sans_delims { my ($self, $str) = @_; @@ -737,7 +763,7 @@ unless $str; $self->_match_check($str); - my ($delim, $re) = $str =~ /^\s*m?\s*(\W)(.*)\1\s*$/; + my ($delim, $re) = $str =~ /^\s*m?\s*(\W)(.*)\1\s*$/ms; return $re; } @@ -753,7 +779,7 @@ 1 while s/[^\cH\c?][\cH\c?]//mg; # ^H ^? s/^.*\cU//mg; # ^U - return wantarray ? split /$/mg, $_ : $_; # ORS instead? + return wantarray ? split /$/, $_ : $_; # ORS instead? } # Lifted from Net::Telnet en toto @@ -796,9 +822,10 @@ #------------------------------ # Look for subroutines in Net::Telnet if we can't find them here. +# This ranks a 4 on the OOP naughtiness scale. sub AUTOLOAD { my ($self) = @_; - croak "$self is an [unexpected] object, aborting" if ref $self; + confess "$AUTOLOAD passed an [unexpected] object, aborting" if ref $self; $AUTOLOAD =~ s/.*::/Net::Telnet::/; goto &$AUTOLOAD; } @@ -865,30 +892,33 @@ $session = Net::Telnet::Cisco->new( [Autopage => $boolean,] # 1 - [More_prompt => $matchop,] # '/(?m:^\s*--More--)/', + [More_prompt => $matchop,] # '/(?m:^[\s\0]*--More--)/', [Always_waitfor_prompt => $boolean,] # 1 [Waitfor_pause => $milliseconds,] # 0.1 [Normalize_cmd => $boolean,] # 1 [Send_wakeup => $when,] # 0 [Ignore_warnings => $boolean,] # 0 [Warnings => $matchop,] # see docs - + [Errors => $matchop,] # see docs + # Net::Telnet arguments - [Binmode => $mode,] - [Cmd_remove_mode => $mode,] - [Dump_Log => $filename,] - [Errmode => $errmode,] - [Fhopen => $filehandle,] - [Host => $host,] - [Input_log => $file,] - [Input_record_separator => $char,] - [Option_log => $file,] - [Output_log => $file,] - [Output_record_separator => $char,] - [Port => $port,] - [Prompt => $matchop,] # see docs - [Telnetmode => $mode,] - [Timeout => $secs,] + [Binmode => $mode,] + [Cmd_remove_mode => $mode,] + [Dump_Log => $filename,] + [Errmode => $errmode,] + [Fhopen => $filehandle,] + [Host => $host,] + [Input_log = => $file,] + [Input_record_separator => $chars,] + [Option_log => $file,] + [Ors = => $chars,] + [Output_log => $file,] + [Output_record_separator => $chars,] + [Port => $port,] + [Prompt = => $matchop,] # see docs + [Rs => $chars,] + [Telnetmode => $mode,] + [Timeout => $secs,]); ); Creates a new object. Read `perldoc perlboot` if you don't understand that. @@ -911,17 +941,26 @@ $ok = $obj->cmd($string); $ok = $obj->cmd(String => $string, [Output => $ref,] + [Cmd_remove_mode => $mode,] + [Errmode => $mode,] + [Input_record_separator => $chars,] + [Ors => $chars,] + [Output_record_separator => $chars,] [Prompt => $match,] - [Timeout => $secs,] - [Cmd_remove_mode => $mode,]); + [Rs => $chars,] + [Timeout => $secs,]); @output = $obj->cmd($string); @output = $obj->cmd(String => $string, [Output => $ref,] - [Prompt => $match,] - [Timeout => $secs,] [Cmd_remove_mode => $mode,] - [Normalize_cmd => $boolean,]); + [Errmode => $mode,] + [Input_record_separator => $chars,] + [Ors => $chars,] + [Output_record_separator => $chars,] + [Prompt => $match,] + [Rs => $chars,] + [Timeout => $secs,]); Normalize_cmd has been added to the default Net::Telnet args. It lets you temporarily change whether backspace, delete, and kill @@ -945,6 +984,8 @@ ^ # beginning of line + \r? # optional linefeed + [\w.-]+ # router hostname \s? # optional space @@ -984,8 +1025,12 @@ $ok = $obj->enable($password); - $ok = $obj->enable([Name => $name,] [Password => $password,] - [Passcode => $passcode,] [Level => $level,]); + $ok = $obj->enable( + [Name => $name,] + [Password => $password,] + [Passcode => $passcode,] + [Level => $level,] + ); This method changes privilege level to enabled mode, (i.e. root) @@ -1014,7 +1059,7 @@ =item B - send a break (control-^) - $ok = $obj->ios_break; + $ok = $obj->ios_break( [ additional strings to print, ... ] ); You may have to use errmode(), fork, or threads to break at the an appropriate time. @@ -1089,7 +1134,7 @@ $prev = $obj->prompt($matchop); -Default value: '/(?m:\s*--More--)/'. +Default value: '/(?m:^(?:[\s\0]*--More--)/', Please email me if you find others. @@ -1133,16 +1178,29 @@ Default value: - /(?mx:^% Unknown VPN - |^%IP routing table VRF.* does not exist. Create first$ - |^%No CEF interface information - |^%No matching route to delete$ - |^%Not all config may be removed and may reappear after reactivating - )/ + '/(?mx:^%\s?Unknown\ VPN + |^%\s?IP\ routing\ table\ VRF.*\ does\ not\ exist\.\ Create\ first$ + |^%\s?No\ CEF\ interface\ information + |^%\s?No\ matching\ route\ to\ delete$ + |^%\s?Not\ all\ config\ may\ be\ removed\ and\ may\ reappear\ after\ reactivating + |^%\s?Warning: + )/', Not all strings that begin with a '%' are really errors. Some are just warnings. Cisco calls these the CIPMIOSWarningExpressions. +=item B - Matchop used to catch special-cased errors. + + $boolean = $obj->errors; + + $boolean = $obj->errors($matchop); + +Default value: + + '/(?mx:^Unknown\ command\ "[^\"]*"\ Use\ \'help\'\ for\ more\ info\.)/', + +Some errors don't begin with a '%'. Trap them here. + =back =head1 EXAMPLES @@ -1258,6 +1316,16 @@ . "tftp://$backup_host/$device-confg\n\n\n"); } +=head2 Sending control characters + +Use print() if you expect to get a prompt back. +Use cmd() if you don't. + + $session->print("\c^"); # send control-^ + $session->cmd("\cZ"); # send control-Z + +See also: C + =head1 SUPPORT http://NetTelnetCisco.sourceforge.net/ @@ -1293,13 +1361,14 @@ =head1 AUTHOR -Joshua_Keroes@eli.net $Date: 2002/06/18 17:17:03 $ +Joshua_Keroes@eli.net $Date: 2002/12/31 00:12:32 $ It would greatly amuse the author if you would send email to him and tell him how you are using Net::Telnet::Cisco. -As of Mar 2002, 170 people have emailed me. N::T::C is used to -help manage over 14,000 machines! Keep the email rolling in! +As of Mar 2002, over 200 people have emailed me or posted to the +Net::Telnet::Cisco site. N::T::C is used to help manage over 14,000 +machines! Keep the email rolling in! =head1 THANKS @@ -1307,7 +1376,10 @@ about. Thanks Brian Landers, Aaron Racine, Niels van Dijke, Tony Mueller, Frank Eickholt, Al Sorrell, Jebi Punnoose, Christian Alfsen, Niels van Dijke, Kevin der Kinderen, Ian Batterbee, Leonardo Cont, -Steve Meier, and Andre Bonhote. +Steve Meier, Andre Bonhote, Rob Patrick, FtR, James "mcaizjb3" Brown, +and Hiro "Paul" Protagonist. + +Paul gets a ++ for code-ninja skills. Institutions: infobot.org #perl, perlmonks.org, sourceforge.net, the geeks at geekhouse.org, and eli.net. --- net-telnet-cisco-1.10.orig/INSTALL +++ net-telnet-cisco-1.10/INSTALL @@ -44,22 +44,18 @@ 1.2.2.1 Install with PPM3, the ActiveState Perl Package Manager - 1. run PPM3 + 1. type "rep add http://telia.dl.sourceforge.net/sourceforge/nettelnetcisco/" (without the quotes) - 2. type "rep add NTC http://prdownloads.sourceforge.net/nettelnetcisco/" - (without the quotes) - - 3. type "install Net::Telnet::Cisco". + 2. type "install Net-Telnet-Cisco" - For more information, read the PPM FAQ: - http://aspn.activestate.com/ASPN/Reference/Products/ActivePerl/faq/ActivePerl-faq2.html + For more information, read the PPM FAQ: + http://aspn.activestate.com/ASPN/Reference/Products/ActivePerl/faq/ActivePerl-faq2.html 1.2.2.2 Install with PPM, v2, the older version 1. run PPM. - 2. type "set repository NTC http://prdownloads.sourceforge.net/nettelnetcisco/" - (without the quotes) + 2. type "set repository NTC http://telia.dl.sourceforge.net/sourceforge/nettelnetcisco/" (without the quotes) 3. type "install Net::Telnet::Cisco". @@ -103,5 +99,5 @@ Please include a script(1) typescript of the installation problems. -$Id: INSTALL,v 1.2 2002/06/18 17:07:39 jkeroes Exp $ +$Id: INSTALL,v 1.6 2002/12/31 00:12:32 jkeroes Exp $ __END__ --- net-telnet-cisco-1.10.orig/MANIFEST +++ net-telnet-cisco-1.10/MANIFEST @@ -2,9 +2,18 @@ Changes Cisco.pm INSTALL -MANIFEST +MANIFEST This list of files MANIFEST.SKIP Makefile.PL README TODO -test.pl +t/00_ini.t +t/10_cmd.t +t/20_errmode.t +t/30_autopage.t +t/40_always_waitfor_prompt.t +t/50_args_bugfix.t +t/60_enable.t +t/90_pod.t +t/99_cleanup.t +t/Utils.pm --- net-telnet-cisco-1.10.orig/MANIFEST.SKIP +++ net-telnet-cisco-1.10/MANIFEST.SKIP @@ -10,3 +10,6 @@ ^pm_to_blib$ ~$ ^# +login.txt +tmp.txt +logs --- net-telnet-cisco-1.10.orig/Makefile.PL +++ net-telnet-cisco-1.10/Makefile.PL @@ -1,16 +1,147 @@ +# -*- perl -*- + use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. +use ExtUtils::MakeMaker qw/prompt/; +use Term::ReadKey; +use Cwd; +use Carp; +use t::Utils; + +use vars qw/%LOGIN/; +$LOGIN{SAVELOGS} = "n"; + +# There are two files used to propagate login info: +# ./login.txt and ./tmp.txt. +# +# login.txt is used only for testing. I tire of typing the same login +# info over and over. +# +# tmp.txt is used to hand off the login info collected by Makefile.PL +# to all of the t/*.t tests. This file is written during `perl +# Makefile.PL` deleted after `make test`. It will only be created if +# the project directory has a sufficient level of perms or we can +# set it to 700. This will prevent most snooping attacks. + +#------------------------------ +# Main +#------------------------------ + +# Skip the tests here +#get_login(); +fix_perms(); + WriteMakefile( 'NAME' => 'Net::Telnet::Cisco', - 'VERSION_FROM' => 'Cisco.pm', # finds $VERSION - 'PREREQ_PM' => { Net::Telnet => 3.02, - Term::ReadKey => 2, - Test::More => undef, - Cwd => undef, - }, # e.g., Module::Name => 1.1 + 'VERSION_FROM' => 'Cisco.pm', + 'PREREQ_PM' => { Net::Telnet => 3.03, + Term::ReadKey => 2, + Test::More => 0, + Cwd => 0, + FindBin => 0, + Socket => 0, + Sys::Hostname => 0, + Carp => 0, + Config => 0, + File::Find => 0, + }, ($] ge '5.005') ? ( - 'AUTHOR' => 'Joshua Keroes (joshua@cpan.org)', - 'ABSTRACT' => 'automate Cisco management', + AUTHOR => 'Joshua Keroes (joshua@cpan.org)', + ABSTRACT => 'automate Cisco management', ) : (), ); + +exit; + +#------------------------------ +# Subs +#------------------------------ + +sub get_login { + if (-r "login.txt") { + load("login.txt"); + return; + } + + print < %LOGIN ) unless -r 'login.txt'; +} + + +# Lifted from ExtUtils::MakeMaker, with minor mods. +# +# If the user has Term::ReadKey, we can hide any passwords +# they type from shoulder-surfing attacks. +# +# Args: "Question for user", "optional default answer" +sub passprompt ($;$) { + my ($msg, $def) = @_; + + confess( "passprompt($msg, [$def]) called incorrectly" ) + unless defined $msg; + + local $| = 1; + + my $dispdef = defined $def ? "[$def] " : " "; + $def = defined $def ? $def : ""; + + print "$msg $dispdef"; + + my $ans; + my $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)); # Pipe? + + if ( $ISA_TTY ) { + if ( $Term::ReadKey::VERSION ) { + ReadMode( 'noecho' ); + chomp( $ans = ReadLine(0) ); + ReadMode( 'normal' ); + print "\n"; + } else { + chomp( $ans = ); + } + } else { + print "$def\n"; + } + + return $ans ne '' ? $ans : $def; +} --- net-telnet-cisco-1.10.orig/README +++ net-telnet-cisco-1.10/README @@ -64,4 +64,5 @@ Copyright (c) 2000-2002 Joshua Keroes, Electric Lightwave Inc. All rights reserved. This program is free software; you can - redistribute it and/or modify it under the same terms as Perl itself. \ No newline at end of file + redistribute it and/or modify it under the same terms as Perl itself. + --- net-telnet-cisco-1.10.orig/debian/changelog +++ net-telnet-cisco-1.10/debian/changelog @@ -0,0 +1,58 @@ +net-telnet-cisco (1.10-5.2) unstable; urgency=medium + + * Non-maintainer upload. + * Fix "FTBFS with '.' removed from perl's @INC": + call perl with "-I." in debian/rules. + (Closes: #834351) + + -- gregor herrmann Sun, 21 Aug 2016 20:56:52 +0200 + +net-telnet-cisco (1.10-5.1) unstable; urgency=medium + + * Non-maintainer upload. + * Fix "FTBFS with perl 5.22 in experimental (MakeMaker changes)": + use DESTDIR in debian/rules. + (Closes: #797191) + + -- gregor herrmann Sun, 06 Sep 2015 18:46:40 +0200 + +net-telnet-cisco (1.10-5) unstable; urgency=low + + * Apply change suggested in bug report to build with latest Perl version + (Closes: #467331) + * Added Homepage: to the debian/control + * Use debhelper compatibility version 5 + * Use new maintainer's email address + * Upgrade to latest Standards version, no more changes needed + + -- Javier Fernandez-Sanguino Pen~a Sat, 05 Jul 2008 01:54:23 +0200 + +net-telnet-cisco (1.10-4) unstable; urgency=low + + * Updated to latest CVS sources (this should be 1.11 when upstream + decides to publish it). This should fix an issue when using this + library with Perl 5.8 (Closes: #316434) + + -- Javier Fernandez-Sanguino Pen~a Fri, 26 Aug 2005 16:17:33 +0200 + +net-telnet-cisco (1.10-3) unstable; urgency=low + + * Removed libtest-simple-perl dependancy (Closes: #171132) + * Changed to section perl. + + -- Javier Fernandez-Sanguino Pen~a Tue, 22 Apr 2003 13:57:56 +0200 + +net-telnet-cisco (1.10-2) unstable; urgency=low + + * Changed to Arch all (Closes: #162945) + + -- Javier Fernandez-Sanguino Pen~a Mon, 7 Oct 2002 14:44:01 +0200 + +net-telnet-cisco (1.10-1) unstable; urgency=low + + * Initial Release (it's needed by the router-audit-tool packages). + * Added perl's license to the debian/copyright file to appeal the + ftpmasters :) + + -- Javier Fernandez-Sanguino Pen~a Wed, 11 Sep 2002 13:59:33 +0200 + --- net-telnet-cisco-1.10.orig/debian/compat +++ net-telnet-cisco-1.10/debian/compat @@ -0,0 +1 @@ +5 --- net-telnet-cisco-1.10.orig/debian/control +++ net-telnet-cisco-1.10/debian/control @@ -0,0 +1,22 @@ +Source: net-telnet-cisco +Priority: optional +Maintainer: Javier Fernandez-Sanguino Pen~a +Build-Depends: perl, libnet-telnet-perl (>= 3.03), libterm-readkey-perl (>= 2), libtest-simple-perl, debhelper (>> 3.0.0) +Homepage: http://nettelnetcisco.sourceforge.net/ +Standards-Version: 3.7.3 + +Package: libnet-telnet-cisco-perl +Section: perl +Architecture: all +Depends: ${perl:Depends}, libnet-telnet-perl (>= 3.03), libterm-readkey-perl (>= 2) +Description: Additional functionality to automate Cisco management + Net::Telnet::Cisco provides additional functionality to + Net::Telnet for dealing with Cisco routers. It provides a new + object that allows for remote management of routers through perl + issuing commands like you were connected directly to the router + (or switch). + . + For most management issues you might want to use the Net::SNMP + module better (it's faster, better error handling and doesn't use + up router virtual terminals) but for those things you can not do + using that module use this one. --- net-telnet-cisco-1.10.orig/debian/copyright +++ net-telnet-cisco-1.10/debian/copyright @@ -0,0 +1,34 @@ +This package was debianized by Javier Fernandez-Sanguino + on +Wed, 11 Sep 2002 13:59:33 +0200. + +It was downloaded from http://cpan.perl.org: + * http://search.cpan.org/search?dist=Net-Telnet-Cisco + * http://www.cpan.org/authors/id/J/JO/JOSHUA + +The latest version is also available at: + + http://sourceforge.net/project/showfiles.php?group_id=48856 + + + +Upstream Author: Joshua Keroes + +Copyright: + + Copyright (c) 2000-2002 Joshua Keroes, Electric Lightwave Inc. + All rights reserved. This program is free software; you can + redistribute it and/or modify it under the same terms as Perl itself. + + Perl is distributed under either: + + a) the GNU General Public License as published by the Free Software + Foundation; either version 1, or (at your option) any later + version, or + + b) the "Artistic License" which comes with Perl. + + On Debian GNU/Linux systems, the complete text of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL' and + the Artistic Licence in `/usr/share/common-licenses/Artistic'. + --- net-telnet-cisco-1.10.orig/debian/dirs +++ net-telnet-cisco-1.10/debian/dirs @@ -0,0 +1,2 @@ +usr/share/doc/ +usr/share/man --- net-telnet-cisco-1.10.orig/debian/docs +++ net-telnet-cisco-1.10/debian/docs @@ -0,0 +1,2 @@ +README +TODO --- net-telnet-cisco-1.10.orig/debian/rules +++ net-telnet-cisco-1.10/debian/rules @@ -0,0 +1,87 @@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 to 1999 by Joey Hess. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + + +ifneq (,$(findstring debug,$(DEB_BUILD_OPTIONS))) + CFLAGS += -g +endif +ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) + INSTALL_PROGRAM += -s +endif + +configure: configure-stamp +configure-stamp: + dh_testdir + # Add here commands to configure the package. + + touch configure-stamp + + +build: build-stamp +build-stamp: configure-stamp + dh_testdir + + # Add here commands to compile the package. + [ -f Makefile ] || perl -I. Makefile.PL INSTALLDIRS=vendor + $(MAKE) + + touch build-stamp + +clean: + dh_testdir + dh_testroot + rm -f build-stamp configure-stamp + + # Add here commands to clean up after the build process. + [ ! -f Makefile ] || $(MAKE) distclean + + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + + # Add here commands to install the package into debian/tmp + $(MAKE) install_vendor DESTDIR=$(CURDIR)/debian/libnet-telnet-cisco-perl + chmod a-x $(CURDIR)/debian/libnet-telnet-cisco-perl/usr/share/perl5/Net/Telnet/Cisco.pm + + + +# Build architecture-independent files here. +binary-arch: build install +# We have nothing to do by default. + +# Build architecture-dependent files here. +binary-indep: build install + dh_testdir + dh_testroot +# dh_movefiles + +# dh_installdebconf + dh_installdocs + dh_installexamples + dh_installcron + dh_installman + dh_installinfo +# dh_undocumented + dh_installchangelogs Changes + dh_link + dh_strip + dh_compress + dh_fixperms + dh_makeshlibs + dh_installdeb + dh_perl + dh_shlibdeps + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure --- net-telnet-cisco-1.10.orig/t/00_ini.t +++ net-telnet-cisco-1.10/t/00_ini.t @@ -0,0 +1,7 @@ +# -*- perl -*- + +use Test::More tests => 2; + +BEGIN { use_ok('Net::Telnet::Cisco') } + +ok($Net::Telnet::Cisco::VERSION, "\$VERSION set"); --- net-telnet-cisco-1.10.orig/t/10_cmd.t +++ net-telnet-cisco-1.10/t/10_cmd.t @@ -0,0 +1,40 @@ +# -*- perl -*- + +use Test::More tests => 8; +use Net::Telnet::Cisco; +use Carp; +use t::Utils; + +my %G = load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + log_args(), + ), "new()"; +} + +SKIP: { + skip("No Net::Telnet::Cisco session", 5) unless $S; + + ok $S->login(Name => $G{LOGIN}, + Password => $G{PASSWD}, + Passcode => $G{PASSCODE},), "login()"; + + ok $S->cmd('show clock'), "cmd() short"; + ok $S->cmd('show ver'), "cmd() medium"; + ok show_help($S), "cmd() long"; + ok $S->cmd("\b" x 6), "show ? cleanup"; + ok @out = $S->cmd(''), "cmd() empty"; + is_deeply \@out, [''], "...returned array w/ empty string"; +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/20_errmode.t +++ net-telnet-cisco-1.10/t/20_errmode.t @@ -0,0 +1,92 @@ +# -*- perl -*- + +#use Test::More qw/no_plan/; +use Test::More tests => 17; + +use Net::Telnet::Cisco; +use FindBin; +use Carp; +use t::Utils; + +my %G = load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + Timeout => 3, + log_args(), + ), "new()"; +} + +SKIP: { + skip("No Net::Telnet::Cisco session", 11) unless $S; + + ok $S->login(Name => $G{LOGIN}, + Password => $G{PASSWD}, + Passcode => $G{PASSCODE},), "login()"; + + @help = show_help($S); + ok @help, "cmd()"; + ok $S->cmd("\b" x 6), "show ? cleanup"; + + $donttouch = 'virgin'; + ok $S->errmode( sub { $donttouch = 'hussy'} ), "errmode closure"; + is $donttouch, 'virgin', "errmode shouldn't eval CODE"; + + # breaks + my $errmsg = ''; + sub handler { + $errmsg = $S->errmsg; + $S->timed_out(0); + $S->timeout(10); + $S->ios_break; + } + ok $S->errmode( \&handler ), "set errmode(errmode())"; + + # Turn off autopaging. This will display a more prompt, thus pausing until we timeout. + is $S->autopage(0), 0, "turn off autopage"; + + $S->timeout(10); + + local $SIG{'__DIE__'} = \&confess; + @short = show_help($S); + + like $errmsg, "/timed-out/", "error reports a timeout"; + ok @short <= @help, "ios_break()"; + + # XXX search log for "\cZ" + + is $S->autopage(1), 1, "turn on autopage"; + ok $S->cmd("\b" x 6), "show ? cleanup"; + + # Error handling + my $seen = 0; + ok $S->timeout(3), "set timeout(1)"; + + sub incr { $seen++ } + + ok $S->errmode(\&incr), "set errmode(closure)"; + $S->cmd( "Small_Change_got_rained_on_with_his_own_thirty_eight" + . "_And_nobody_flinched_down_by_the_arcade"); + + # $seen should be incrememnted to 1. + is $seen, 1, "error() called"; + + # $seen should not be incremented (it should remain 1) + ok $S->errmode('return'), "no errmode()"; + $S->cmd( "Brother_my_cup_is_empty_" + . "And_I_havent_got_a_penny_" + . "For_to_buy_no_more_whiskey_" + . "I_have_to_go_home"); + is $seen, 1, "don't call error()"; +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/30_autopage.t +++ net-telnet-cisco-1.10/t/30_autopage.t @@ -0,0 +1,80 @@ +# -*- perl -*- + +use Test::More tests => 11; +use Net::Telnet::Cisco; +use FindBin; +use Carp; +use t::Utils; + +my %G = load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + log_args(), + ), "new()"; +} + +SKIP: { + skip("No Net::Telnet::Cisco session", 9) unless $S; + + ok $S->login(Name => $G{LOGIN}, + Password => $G{PASSWD}, + Passcode => $G{PASSCODE},), "login()"; + + ok $S->autopage, "autopage() on"; + my @out = $S->cmd('show ver'); + unlike $out[-1], '/--More--/', "autopage() last line"; + unlike $S->last_prompt, '/--More--/', "autopage() last prompt"; + + my %logs = log_args(); + open LOG, "< $logs{Input_log}" or die "Can't open log: $!"; + my $log = join "", ; + close LOG; + + # Remove last prompt, which isn't present in @out + $log =~ s/\cJ\cJ.*\Z//m; + + # Strip ^Hs from log + $log = Net::Telnet::Cisco::_normalize($log); + is my $count = ($log =~ tr/\cH//), 0, "_normalize()"; + + # get rid of "show ver" line and turn @out into a string. + shift @out; + my $out = join "", @out; + $out =~ s/\cJ\cJ.*\Z//m; + + my $i = index $log, $out; + is $i + length $out, length $log, "autopage() 1.09 bugfix"; + + # Turn off autopaging. We should timeout with a More prompt + # on the last line. + is $S->autopage(0), 0, "autopage() off"; + + # Turn off error handling; we *want* to time-out now. + $S->errmode('return'); + $S->errmsg(''); + + show_help($S, -Timeout => 1); + ok $S->timed_out, "timed_out()"; + like $S->errmsg, '/timed-out/', "autopage() not called"; + ok $S->cmd("\b" x 6), "show ? cleanup"; + + # Restore error handling + $S->errmode(\&confess); + + # Cancel out of the "show interfaces" + $S->cmd("\cZ"); + + $S->close; +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/40_always_waitfor_prompt.t +++ net-telnet-cisco-1.10/t/40_always_waitfor_prompt.t @@ -0,0 +1,45 @@ +# -*- perl -*- + +use Test::More tests => 8; +use Net::Telnet::Cisco; +use FindBin; +use Carp; +use t::Utils; + +my %G =load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + log_args(), + ), "new()"; +} + +SKIP: { + skip("No Net::Telnet::Cisco session", 7) unless $S; + + ok $S->login(Name => $G{LOGIN}, + Password => $G{PASSWD}, + Passcode => $G{PASSCODE},), "login()"; + + ok $S->always_waitfor_prompt(1), "always_waitfor_prompt()"; + ok $S->print("show clock") + && $S->waitfor("/not_a_real_prompt/"), "waitfor() autochecks for prompt()"; + + is $S->always_waitfor_prompt(0), 0, "don't always_waitfor_prompt()"; + ok $S->timeout(3), "set timeout to 3 seconds"; + + eval { $S->print("show clock") && $S->waitfor("/not_a_real_prompt/") }; + ok $S->timed_out, "waitfor() timedout"; + like $@, "/pattern match timed-out/", "Got 'pattern match timed-out' error"; +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/50_args_bugfix.t +++ net-telnet-cisco-1.10/t/50_args_bugfix.t @@ -0,0 +1,29 @@ +# -*- perl -*- + +use Test::More tests => 2; +use Net::Telnet::Cisco; +use FindBin; +use Carp; +use t::Utils; + +my %G =load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + Prompt => "/broken_pre1.08/", + log_args(), + ), "new()"; + + is $S->prompt, '/broken_pre1.08/', "new(args) 1.08 bugfix"; +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/60_enable.t +++ net-telnet-cisco-1.10/t/60_enable.t @@ -0,0 +1,44 @@ +# -*- perl -*- + +use Test::More tests => 6; +use Net::Telnet::Cisco; +use FindBin; +use Carp; +use t::Utils; + +my %G =load(); +my $S; + +SKIP: { + skip("Router unknown", 1) unless $G{ROUTER}; + skip("Login or password unknown", 1) unless $G{LOGIN} || $G{PASSWD}; + + ok $S = Net::Telnet::Cisco->new( Errmode => \&confess, + Host => $G{ROUTER}, + log_args(), + ), "new()"; +} + +SKIP: { + skip("No Net::Telnet::Cisco session", 5) unless $S; + skip("Won't enter enabled mode without an enable password", 5) + unless $G{ENABLE}; + + ok $S->login(Name => $G{LOGIN}, + Password => $G{PASSWD}, + Passcode => $G{PASSCODE},), "login()"; + + ok $S->disable, "disable()"; + ok $S->enable($G{ENABLE}), "enable()"; + ok $S->is_enabled, "is_enabled()"; + + eval { $S->enable(Level => undef) }; + like $@, 'Level was passed an undef', "enable() -Level bugfix"; + +} + +END { + cleanup(savelogs => $G{SAVELOGS}, + failed => scalar grep {$_ == 0} Test::More->builder->summary, + ); +}; --- net-telnet-cisco-1.10.orig/t/90_pod.t +++ net-telnet-cisco-1.10/t/90_pod.t @@ -0,0 +1,59 @@ +# -*- perl -*- + +use Test::More; +use File::Find; +use Config; +use Cwd qw/abs_path/; +use Socket; +use Sys::Hostname; + +$VERBOSE = 0; +$TEST_NET = '207.173.0'; + +#------------------------------------------------------------ +# Main +#------------------------------------------------------------ + +my $host = hostname(); +my $addr = inet_ntoa(scalar gethostbyname($host || 'localhost')); +my $cwd = abs_path(); +my $blib = $cwd =~ /t$/ ? "$cwd/../blib" : "$cwd/blib"; +my %pod_files = (); +my $podchecker = "$Config{prefix}/bin/podchecker"; + +if ($addr =~ /^$TEST_NET/) { + die "Can't find podchecker" unless -e $podchecker; +} + +find({ wanted => \&pod_files, follow => 1 }, $blib); +my $num_tests = ((scalar keys %pod_files) * 2); +plan tests => $num_tests; + +SKIP: { + skip "POD testing on non-dev machines", $num_tests + if $addr !~ /^$TEST_NET/; + + for my $fullpath (sort keys %pod_files) { + my $file = $pod_files{$fullpath}; + my $out = `$podchecker $fullpath 2>&1`; + + is $?, 0, "No system errors checking $file"; + unlike $out, '/(?si:WARNING|ERROR)/', "POD syntax check of $file" + or diag $out; + } +} + +exit; + +#------------------------------------------------------------ +# Subs +#------------------------------------------------------------ + +sub pod_files { + printf STDERR "%-24s", "$_..." if $VERBOSE; + return unless -f $File::Find::name; + + open F, "< $File::Find::name" or die "Can't open $_: $!"; + $pod_files{$File::Find::name} = $_ if grep /^=head/, ; + close F or warn $!; +} --- net-telnet-cisco-1.10.orig/t/99_cleanup.t +++ net-telnet-cisco-1.10/t/99_cleanup.t @@ -0,0 +1,83 @@ +# -*- perl -*- +# +# Not tests, these are cleanup routines. +# + +use Test::More tests => 1; +use ExtUtils::MakeMaker; +use File::Path; +use t::Utils; +use Cwd; + +my %G; +eval { %G =load() }; +if ($@ =~ /Login data not available/) { + pass "Temp files deleted"; + exit; +} + +rm_tmp(); +rm_logs(); +test_notice(); + +pass; + +exit; + +#------------------------------------------------------------ +# Subs +#------------------------------------------------------------ + +sub rm_tmp { + diag "Deleting tempfiles..."; + + if (-e "tmp.txt") { + if (unlink "tmp.txt") { + diag "done.\n" + } else { + diag "Can't delete tmp.txt. Help! $!"; + } + } +} + +sub rm_logs { + diag " + +============================================================ + WARNING! WARNING! WARNING! + + + $G{LOGDIR} + contains logs with security information. + In `perl Makefile.PL` you asked to save them. + We saved them. Delete them when you see fit. + + + ALART! BWEEOOOP! ACHTUNG! +============================================================ + +" if scalar glob <$G{LOGDIR}/*>; +} + +sub test_notice { + diag " +============================================================ + WARNING! WARNING! WARNING! + + + You are using a persistent login file for testing + Net::Telnet::Cisco. Your router, login and passwords + will NOT be deleted automatically! + + + Don't forget to remove the data + when you're done with this command: + + rm $FindBin::Bin/../login.txt + + + ALART! BWEEOOOP! ACHTUNG! +============================================================ +" if -r "login.txt"; + +} --- net-telnet-cisco-1.10.orig/t/Utils.pm +++ net-telnet-cisco-1.10/t/Utils.pm @@ -0,0 +1,156 @@ +# -*- perl -*- +# +# Utils.pm - Tools for Tests! +# +# Exports some globals and provides Helpful Subs +# +# jkeroes $Id: Utils.pm,v 1.1 2002/12/31 00:11:49 jkeroes Exp $ + +package main; + +use File::Basename; +use Test::More; +use FindBin qw/$Bin/; +use File::Path qw/mkpath/; + +use Cwd; + +# Defaults +$LOGDIR = "$Bin/../logs"; # Only valid for files in t/*.t +$SAVELOGS = 'n'; + +sub fatal (@;); + +#------------------------------------------------------------ +# Subs +#------------------------------------------------------------ + +# Runs the 'show ?' command +sub show_help { + my $session = shift; + + # The prompt will look something like: + # + # "gw01.phnx#show " + # + my $prompt = $session->prompt; + $prompt =~ s{\$\)/$}{\)/}; + + # could play wantarray games here but... whatever. + my @out = $session->cmd(Ors => '', + String => 'show ?', + Prompt => $prompt, + @_, + ); + + return @out; +} + + +# Ensure the argument (or current directory if called without args) +# is mode 0700. +sub fixmode { + my $dir = shift || cwd(); + + my $mode = (stat $dir)[2]; + chmod 0700, $dir or fatal < $SAVELOGS, LOGDIR => $LOGDIR ); + fatal "No login data. Run `perl Makefile.PL` again.\n" unless $file; + + open FH, "< $file" or return %h; + while () { + next if /^\s*\#/; # skip comments + chomp; + my ($k, $v) = split; + + $h{$k} = $v; + } + close FH or warn $!; + + return %h; +} + +# Accepts: $filename, %hash +# Saves to a TSV file. +sub save { + my $file = shift || "tmp.txt"; + + print "Saving login info to '$file'... "; + + open FH, "> $file" or fatal "Can't open '$file' for write: $!"; + chmod 0700, $file or fatal "Can't set '$file to 0700: $!"; + + my %h = @_; + while (my ($k, $v) = each %h) { + print FH "$k\t$v\n"; + } + + close FH or warn $!; + + print "done.\n"; +} + +# Returns logging args for N::T::C->new() +sub log_args { + my $progname = basename(shift || $0); + $progname =~ s/\.t$//; + + return ( Input_log => "$LOGDIR/$progname.input", + Dump_log => "$LOGDIR/$progname.dump", + Output_log => "$LOGDIR/$progname.output", + ); +} + +# Remove logs. +# +# The user was queried in MakeMaker.PL whether he wanted to deleted logs: +# (A)lways +# (N)ever +# only on (F)ailure +# +# We default to Always because things are more secure that way. +# +# Usage: +# cleanup( savelogs => a | n | f, +# failed => integer +# ); +sub cleanup { + my %args = (savelogs => $SAVELOGS, failed => 0, @_, ); + + $args{savelogs} = defined $args{savelogs} ? $args{savelogs} : $SAVELOGS; + $args{failed} = defined $args{failed} ? $args{failed} : 0; + + my $progname = basename($0); + $progname =~ s/\.t$//; + + if ( $args{savelogs} eq 'n' + || $args{savelogs} eq 'f' && ! $args{failed}) { + my @goners = <$LOGDIR/$progname.*>; + my $cnt = unlink @goners; + warn "Problems deleting @goners: $!" unless scalar @goners == $cnt; + diag "Logs deleted." if $ENV{TEST_VERBOSE}; + } else { + diag "Logs saved."; + } +} + +sub fatal (@;) { Test::More->builder->BAILOUT(@_) } + +1; --- net-telnet-cisco-1.10.orig/tmp.txt +++ net-telnet-cisco-1.10/tmp.txt @@ -0,0 +1 @@ +SAVELOGS n