=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.15 retrieving revision 1.25 diff -u -r1.15 -r1.25 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/09/07 03:59:03 1.15 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2007/01/17 20:48:46 1.25 @@ -1,5 +1,5 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.14 2006/09/07 02:49:34 andrew Exp $ +# $RedRiver: Trango.pm,v 1.24 2007/01/17 19:00:51 andrew Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -14,13 +14,13 @@ use Net::Telnet::Trango; my $t = new Net::Telnet::Trango ( Timeout => 5 ); - + $t->open( Host => $fox ) or die "Error connecting: $!"; $t->login('password') or die "Couldn't log in: $!"; - + # Do whatever - + $t->exit; $t->close; @@ -28,12 +28,19 @@ Perl access to the telnet interface on Trango Foxes, SUs and APs. -Another handy feature is that it will parse the output from certain commands that is in the format "[key1] value1 [key2] value2" and put those in a hashref that is returned. This makes using the output from things like sysinfo very easy to do. +Another handy feature is that it will parse the output from certain +commands that is in the format "[key1] value1 [key2] value2" and put +those in a hashref that is returned. This makes using the output from +things like sysinfo very easy to do. =head2 EXPORT None +=head1 METHODS + +=over + =cut our $VERSION = '0.01'; @@ -157,7 +164,7 @@ =pod -=head1 METHODS +=back =head2 ACCESSORS @@ -192,7 +199,8 @@ =item login_banner -returns the banner that is displayed when first connected at login. Only set after a successful open() +returns the banner that is displayed when first connected at login. +Only set after a successful open() This is usually only set internally @@ -201,6 +209,11 @@ returns the output from the last cmd() that was run as an array ref This is usually only set internally +=item last_error + +returns the last error reported. Should contain the the last entry in +last_lines + =back =head2 ALIASES @@ -219,7 +232,9 @@ =head2 COMMANDS -Most of these are just shortcuts to C METHOD)>, as such they accept the same options as C. Specifically they take a named paramater "args", for example: +Most of these are just shortcuts to C METHOD)>, +as such they accept the same options as C. +Specifically they take a named paramater "args", for example: C 'on')> would enable tftpd =over @@ -246,6 +261,11 @@ reboots the trango and closes the connection +=item remarks + +Takes an optional argument, which sets the remarks. +If there is no argument, returns the current remarks. + =item sulog returns an array ref of hashes containing each log line. @@ -274,6 +294,14 @@ returns the output from the eth list command +=item su_info + +You need to pass in args => and it will return the info for that suid. + +=item save_ss + +saves the config. Returns 1 on success, undef on failure. + =cut @@ -286,12 +314,16 @@ sulog => { decode => 'sulog', expect => $success }, 'exit' => { no_prompt => 1, cmd_disconnects => 1 }, reboot => { no_prompt => 1, cmd_disconnects => 1 }, + remarks => { decode => 'all', expect => $success }, save_sudb => { String => 'save sudb', expect => $success }, syslog => { expect => $success }, 'pipe' => { }, # XXX needs a special decode maclist => { decode => 'maclist' }, maclist_reset => { String => 'maclist reset', expect => 'done' }, eth_link => { String => 'eth link', expect => $success }, + su_info => { String => 'su info', decode => 'all', expect => $success }, + save_ss => { String => 'save ss', expect => $success }, + opmode => { decode => 'all', expect => $success }, # eth r, w and reset??? #su password??? #_bootloader @@ -314,6 +346,7 @@ Timeout last_lines last_vals + last_error ); sub AUTOLOAD @@ -329,8 +362,8 @@ } if (exists $COMMANDS{$method}) { - $method = shift if (@_ == 1); $COMMANDS{$method}{'String'} ||= $method; + $COMMANDS{$method}{'args'} .= ' ' . shift if (@_ == 1); return $self->cmd(%{ $COMMANDS{$method} }, @_); } @@ -348,7 +381,9 @@ =item open -Calls Net::Telnet::open() then makes sure you get a password prompt so you are ready to login() and parses the login banner so you can get host_type() and firmware_version() +Calls Net::Telnet::open() then makes sure you get a password prompt so +you are ready to login() and parses the login banner so you can get +host_type() and firmware_version() =cut @@ -357,7 +392,7 @@ my $self = shift; unless ( $self->SUPER::open(@_) ) { - #$! = "Couldn't connect to " . $self->Host . ": $!"; + $self->last_error("Couldn't connect to " . $self->Host . ": $!"); return undef; } @@ -366,8 +401,8 @@ -match => '/password: ?$/i', -errmode => "return", ) ) { - #$! = "problem connecting to host (" . $self->Host . "): " . - # $self->lastline; + $self->last_error("problem connecting to host (" . $self->Host . "): " . + $self->lastline); return undef; } @@ -382,7 +417,8 @@ =item login -Calls open() if not already connected, then sends the password and sets logged_in() if successful +Calls open() if not already connected, then sends the password and sets +logged_in() if successful =cut @@ -401,7 +437,7 @@ -match => $self->prompt, -errmode => "return", ) ) { - #$! = "login ($self->Host) failed: " . $self->lastline; + $self->last_error("login ($self->Host) failed: " . $self->lastline); return undef; } @@ -414,7 +450,9 @@ =item parse_login_banner -Takes a login banner (what you get when you first connect to the Trango) or reads what is already in login_banner() then parses it and sets host_type() and firmware_version() as well as login_banner() +Takes a login banner (what you get when you first connect to the Trango) +or reads what is already in login_banner() then parses it and sets +host_type() and firmware_version() as well as login_banner() =cut @@ -442,23 +480,19 @@ =item su_password -C +C If no suid is specified, +the default is "all". =cut sub su_password { my $self = shift; - my $su = shift || '!'; my $new_pass = shift || ''; + my $su = shift || 'all'; - unless (defined $su) { - warn "No su passed!" - #return undef; - } - unless (defined $new_pass) { - warn "No new password!" + $self->last_error("No new password"); #return undef; } @@ -487,10 +521,22 @@ my $new_subnet = shift; my $new_gateway = shift; - return undef unless $suid =~ /^\d+$/; - return undef unless $new_ip; - return undef unless $new_subnet; - return undef unless $new_gateway; + if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); + return undef; + } + unless ($new_ip) { + $self->last_error("no new_ip passed"); + return undef; + } + unless ($new_subnet) { + $self->last_error("no new_subnet passed"); + return undef; + } + unless ($new_gateway) { + $self->last_error("no new_gateway passed"); + return undef; + } # su ipconfig return $self->cmd(String => 'su ipconfig ' . @@ -579,28 +625,29 @@ my $mac = shift; if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); return undef; } unless (lc($type) eq 'reg' || lc($type) eq 'pr') { - warn "Invalid type '$type'!"; + $self->last_error("Invalid type '$type'"); return undef; } if ($cir =~ /\D/) { - warn "Invalid CIR '$cir'!"; + $self->last_error("Invalid CIR '$cir'"); return undef; } if ($mir =~ /\D/) { - warn "Invalid MIR '$mir'!"; + $self->last_error("Invalid MIR '$mir'"); return undef; } my $new_mac = $mac; $new_mac =~ s/[^0-9A-Fa-f]//; unless (length $new_mac == 12) { - warn "Invalid MAC '$mac'!"; + $self->last_error("Invalid MAC '$mac'"); return undef; } $new_mac = join ' ', $new_mac =~ /../g; @@ -633,7 +680,9 @@ my $self = shift; my $suid = shift; - if (lc($suid) ne 'all' || $suid =~ /\D/) { + #if (lc($suid) ne 'all' || $suid =~ /\D/) { + if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); return undef; } @@ -665,18 +714,22 @@ my $value = shift; if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); return undef; } if (lc($opt) eq 'cir' or lc($opt) eq 'mir') { if ($value =~ /\D/) { + $self->last_error("Invalid $opt '$value'"); return undef; } } elsif (lc($opt) eq 'su2su') { if ($value =~ /[^0-9A-Za-f]/) { + $self->last_error("Invalid MAC '$value'"); return undef; } } else { + $self->last_error("Invalid option '$opt'"); return undef; } @@ -731,23 +784,29 @@ =item cmd -This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango. +This does most of the work. At the heart, it calls Net::Telnet::cmd() +but it also does some special stuff for Trango. Normally returns the last lines from from the command Also accepts these options: I -- if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output +- if this is true, then it will send the output lines to _decode_lines() +and then returns the decoded output I -- if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false +- if this is true, it then sets logged_in() to false, then it will +close() the connection and then sets is_connected() to false I -- if this is set (usually to 'Success.') it will check for that in the last line of output and if it does not, will return undef because the command probably failed +- if this is set (usually to 'Success.') it will check for that in the +last line of output and if it does not, will return undef because the +command probably failed I -- a string containing the command line options that are passed to the command +- a string containing the command line options that are passed to the +command =cut @@ -778,20 +837,17 @@ $cfg{'Timeout'} ||= $self->Timeout; unless ($cfg{'String'}) { - #$! = "No command passed"; - #warn "No command passed\n"; + $self->last_error("No command passed"); return undef; } unless ($self->is_connected) { - #$! = "Not connected"; - #warn "Not connected\n"; + $self->last_error("Not connected"); return undef; } unless ($self->logged_in) { - #$! = "Not logged in"; - #warn "Not logged in\n"; + $self->last_error("Not logged in"); return undef; } @@ -846,7 +902,7 @@ return @lines; } } else { - #$! = "Error with command ($cfg{'string'}): $last"; + $self->last_error("Error with command ($cfg{'String'}): $last"); return undef; } } @@ -860,9 +916,9 @@ my %conf; my $key = ''; - my $val = ''; + my $val = undef; my $in_key = 0; - my $in_val = 0; + my $in_val = 1; foreach my $line (@lines) { next if $line =~ /$success$/; @@ -878,15 +934,17 @@ $in_val = 0; } else { $in_key = 0; - $in_val = 0; + $in_val = 1; } if ($key) { $key =~ s/^\s+//; $key =~ s/\s+$//; - $val =~ s/^\s+//; - $val =~ s/\s+$//; + if (defined $val) { + $val =~ s/^\s+//; + $val =~ s/\s+$//; + } if ($key eq 'Checksum' && $last_key) { # Special case for these bastids. @@ -918,7 +976,7 @@ if (%conf) { return \%conf; } else { - return undef; + return $val; } } @@ -1018,15 +1076,21 @@ =head1 SEE ALSO -Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm +Trango Documentation - +http://www.trangobroadband.com/support/product_docs.htm L =head1 TODO -There are still a lot of commands that are not accessed directly. If you call them (as cmd("command + args") or whatever) and it works, please send me examples that work and I will try to get it incorporated into the next version of the script. +There are still a lot of commands that are not accessed directly. If +you call them (as cmd("command + args") or whatever) and it works, +please send me examples that work and I will try to get it incorporated +into the next version of the script. -I also want to be able to parse the different types of output from commands like su, sudb all and anything else that would be better available as a perl datastructure. +I also want to be able to parse the different types of output from +commands like su, sudb all and anything else that would be better +available as a perl datastructure. =head1 AUTHOR