Annotation of trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm, Revision 1.4
1.1 andrew 1: package Net::Telnet::Trango;
1.4 ! andrew 2: # $RedRiver: Trango.pm,v 1.3 2005/12/30 19:26:06 andrew Exp $
1.2 andrew 3: use strict;
4: use warnings;
1.1 andrew 5: use base 'Net::Telnet';
6:
1.2 andrew 7: =pod
8:
9: =head1 NAME
10:
11: Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface
12:
13: =head1 SYNOPSIS
14:
15: use Net::Telnet::Trango;
1.3 andrew 16: my $t = new Net::Telnet::Trango ( Timeout => 5 );
1.2 andrew 17:
1.3 andrew 18: my ($type, $version) = $t->open( Host => $fox );
1.2 andrew 19:
20: unless (defined $type && defined $version) {
21: die "Error connecting: $!";
22: }
23:
24: $t->login('password') or die "Couldn't log in: $!";
25:
26: # Do whatever
27:
28: $t->exit;
29: $t->close;
30:
31: =head1 DESCRIPTION
32:
33: Perl access to the telnet interface on Trango Foxes, SUs and APs.
34:
35: 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.
36:
37: =head2 EXPORT
38:
39: None
40:
41: =cut
42:
43: our $VERSION = '0.01';
44:
1.1 andrew 45: my %PRIVATE = (
46: is_connected => 0,
47: logged_in => 0,
48: );
49:
1.2 andrew 50: =pod
51:
1.4 ! andrew 52: =item new
! 53:
! 54: Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
! 55:
! 56: =cut
! 57:
! 58: sub new
! 59: {
! 60: my $class = shift;
! 61:
! 62: my %args;
! 63: if (@_ == 1) {
! 64: $args{'Host'} = shift;
! 65: } else {
! 66: %args = @_;
! 67: }
! 68:
! 69: $args{'Prompt'} ||= '/#> *$/';
! 70:
! 71: foreach my $key (keys %args) {
! 72: $PRIVATE{$key} = $args{$key};
! 73: }
! 74:
! 75: my $self = $class->SUPER::new(%args);
! 76: bless $self if ref $self;
! 77:
! 78: return $self;
! 79: }
! 80:
! 81: # _password <new password> <new password>
! 82: # ? [command]
! 83: # apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
! 84: # arp -bcast <on|off>
! 85: # bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
! 86: # bye
! 87: # cf2cf ap [default|<size>]
! 88: # date
! 89: # date <month> <day> <year>
! 90: # freq scantable
! 91: # freq channeltable
! 92: # freq writescan [<ch#> <h|v>]
! 93: # freq writechannel [<ch#> <freq>] ...
! 94: # freq <ch #> <h|v>
! 95: # help [command]
! 96: # heater [<on temp> <off temp>]
! 97: # ipconfig [<new ip> <new subnet mask> <new gateway>]
! 98: # log [<# of entries, 1..179>]
! 99: # log <sum> <# of entries, 1..179>
! 100: # logout
! 101: # opmode [ap [y]]
! 102: # password
! 103: # ping <ip addr>
! 104: # polar <h|v>
! 105: # power <setism|setunii> <max|min|<dBm>>
! 106: # reboot
! 107: # restart
! 108: # remarks [<str>]
! 109: # rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
! 110: # rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
! 111: # sysinfo
! 112: # set suid <id>
! 113: # set apid <id>
! 114: # set baseid <id>
! 115: # set defaultopmode [<ap|su> <min,0..10>]
! 116: # set defaultopmode off
! 117: # set snmpcomm [<read | write | trap (id or setall)> <str>]
! 118: # set mir [on|off]
! 119: # set mir threshold <kbps>
! 120: # set rssitarget [<ism|unii> <dBm>]
! 121: # set serviceradius [<ism | unii> <miles>]
! 122: # ssrssi <ch #> <h|v>
! 123: # su [<suid>|all]
! 124: # su changechannel <all|suid> <ch#> <h|v>
! 125: # su ipconfig <suid> <new ip> <new subnet> <new gateway>
! 126: # su [live|poweroff|priority]
! 127: # su <ping|info|status> <suid>
! 128: # su powerleveling <all|suid>
! 129: # su reboot <all|suid>
! 130: # su restart <all|suid>
! 131: # su testrflink <all|suid> [r]
! 132: # su testrflink <setlen> [64..1600]
! 133: # su testrflink <aptx> [20..100]
! 134: # su sw <suid|all> <sw #> <on|off>
! 135: # sudb [dload | view]
! 136: # sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
! 137: # sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
! 138: # sudb delete <all|<suid>>
! 139: # sudb modify <suid> <cir|mir> <kbps>
! 140: # sudb modify <suid> <su2su> <group id,hex>
! 141: # sudb view
! 142: # sulog [lastmins | sampleperiod <1..60>]
! 143: # sulog [<# of entry,1..18>]
! 144: # survey <ism|unii> <time, sec> <h|v>
! 145: # sw [<sw #> <on|off>]
! 146: # temp
! 147: # tftpd [on|off]
! 148: # time
! 149: # time <hour> <min> <sec>
! 150: # save <mainimage|fpgaimage> <current chksum> <new chksum>
! 151: # save <systemsetting|sudb>
! 152: # updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
! 153: # updateflash <systemsetting|sudb>
! 154:
! 155: =pod
! 156:
1.2 andrew 157: =head1 METHODS
158:
159: =head2 ACCESSORS
160:
161: =over
162:
163: =item Host
164:
165: returns the name of the host that you are accessing
166:
167: =item firmware_version
168:
169: returns the firmware version on the trango if available otherwise undef.
170: Available after a successful open()
171: This is usually only set internally
172:
173: =item host_type
174:
175: returns the type of host from the login banner for example M5830S or M5300S.
176: Available after a successful open()
177: This is usually only set internally
178:
179: =item is_connected
180:
181: returns 1 after a successful open() otherwise undef
182: This is usually only set internally
183:
184: =item logged_in
185:
186: returns 1 after a successful login() 0 if it failed and undef if
187: login() was never called
188: This is usually only set internally
189:
190: =item login_banner
191:
192: returns the banner that is displayed when first connected at login. Only set after a successful open()
193:
194: This is usually only set internally
195:
196: =item last_lines
197:
198: returns the output from the last cmd() that was run as an array ref
199: This is usually only set internally
200:
201: =back
202:
203: =head2 ALIASES
204:
205: =over
206:
207: =item bye
208:
209: alias of exit()
210:
1.3 andrew 211: =item restart
1.2 andrew 212:
1.3 andrew 213: alias of reboot()
1.2 andrew 214:
215: =back
216:
217: =head2 COMMANDS
218:
219: Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>, as such they accept the same options as C<cmd()>. Specifically they take a named paramater "args", for example:
220: C<tftpd(args =E<gt> 'on')> would enable tftpd
221:
222: =over
223:
224: =item tftpd
225:
226: Returns a hash ref of the decoded output from the command.
227:
228: Also see enable_tftpd() and disable_tftpd() as those check for correct output
229:
230: =item ver
231:
232: Returns a hash ref of the decoded output from the command.
233:
234: =item sysinfo
235:
236: Returns a hash ref of the decoded output from the command.
237:
238: =item exit
239:
240: exits the command session with the trango and closes the connection
241:
242: =item reboot
243:
244: reboots the trango and closes the connection
245:
1.4 ! andrew 246: =item sulog
! 247:
! 248: returns an array ref of hashes containing each log line.
! 249:
1.2 andrew 250: =cut
251:
252:
253: my $success = 'Success.';
254: my %COMMANDS = (
1.4 ! andrew 255: tftpd => { decode => 'all', expect => $success },
! 256: ver => { decode => 'all' },
! 257: sysinfo => { decode => 'all', expect => $success },
! 258: updateflash => { decode => 'all', expect => $success },
! 259: sulog => { decode => 'sulog', expect => $success },
1.2 andrew 260: 'exit' => { Prompt => '//', cmd_disconnects => 1 },
261: reboot => { Prompt => '//', cmd_disconnects => 1 },
1.3 andrew 262: #su password???
263: #_bootloader
264: #temp
265: #heater
1.2 andrew 266: );
267:
268: my %ALIASES = (
269: bye => 'exit',
270: restart => 'reboot',
271: );
272:
273: my %ACCESS = map { $_ => 1 } qw(
274: firmware_version
275: host_type
276: Host
277: is_connected
278: logged_in
279: login_banner
280: Timeout
281: last_lines
282: );
1.1 andrew 283:
284: sub AUTOLOAD
285: {
286: my $self = shift;
287:
288: my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
289: or die "Weird: $AUTOLOAD";
290:
1.2 andrew 291: if (exists $ALIASES{$method}) {
292: $method = $ALIASES{$method};
293: return $self->$method(@_);
294: }
1.1 andrew 295:
1.2 andrew 296: if (exists $COMMANDS{$method}) {
1.3 andrew 297: $method = shift if (@_ == 1);
1.2 andrew 298: $COMMANDS{$method}{'String'} ||= $method;
299: return $self->cmd(%{ $COMMANDS{$method} }, @_);
1.1 andrew 300: }
301:
302: if (exists $ACCESS{$method}) {
1.2 andrew 303: my $prev = $PRIVATE{$method};
304: ($PRIVATE{$method}) = @_ if @_;
305: return $prev;
1.1 andrew 306: }
307:
308: $method = "SUPER::$method";
309: return $self->$method(@_);
310: }
311:
1.2 andrew 312: =pod
313:
314: =item open
315:
1.3 andrew 316: 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()
317:
1.2 andrew 318: =cut
319:
320: sub open
1.1 andrew 321: {
322: my $self = shift;
323:
1.3 andrew 324: unless ( $self->SUPER::open(@_) ) {
1.2 andrew 325: #$! = "Couldn't connect to " . $self->Host . ": $!";
326: return undef;
1.1 andrew 327: }
328:
1.3 andrew 329: ## Get to login prompt
1.1 andrew 330: unless ($self->waitfor(
1.3 andrew 331: -match => '/password: ?$/i',
332: -errmode => "return",
333: ) ) {
334: #$! = "problem connecting to host (" . $self->Host . "): " .
335: # $self->lastline;
1.1 andrew 336: return undef;
337: }
338:
1.2 andrew 339: $self->parse_login_banner($self->lastline);
1.1 andrew 340:
341: $self->is_connected(1);
342:
1.2 andrew 343: return $self->is_connected;
1.1 andrew 344: }
345:
1.2 andrew 346: =pod
347:
348: =item login
349:
1.3 andrew 350: Calls open() if not already connected, then sends the password and sets logged_in() if successful
351:
1.2 andrew 352: =cut
353:
1.1 andrew 354: sub login
355: {
356: my $self = shift;
357:
1.2 andrew 358: unless ($self->is_connected) {
359: $self->open or return undef;
360: }
361:
1.1 andrew 362: my $password = shift;
363:
364: $self->print($password);
365: unless ($self->waitfor(
366: -match => $self->prompt,
367: -errmode => "return",
368: ) ) {
1.2 andrew 369: #$! = "login ($self->Host) failed: " . $self->lastline;
1.1 andrew 370: return undef;
371: }
372:
373: $self->logged_in(1);
374:
375: return $self->logged_in;
376: }
377:
1.2 andrew 378: =pod
379:
380: =item parse_login_banner
381:
1.3 andrew 382: 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()
383:
1.2 andrew 384: =cut
385:
386: sub parse_login_banner
1.1 andrew 387: {
388: my $self = shift;
389:
1.2 andrew 390: if (@_) {
391: $self->login_banner(@_);
392: }
393:
394: my $banner = $self->login_banner;
1.1 andrew 395:
396: my ($type, $ver) = $banner =~
397: /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;
398:
1.2 andrew 399: $self->login_banner($banner);
1.1 andrew 400: $self->host_type($type);
401: $self->firmware_version($ver);
402:
1.2 andrew 403: return 1;
1.1 andrew 404: }
405:
1.2 andrew 406: =pod
407:
408: =item enable_tftpd
409:
1.3 andrew 410: runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
411:
1.2 andrew 412: =cut
413:
414: sub enable_tftpd
1.1 andrew 415: {
416: my $self = shift;
417:
1.2 andrew 418: my $vals = $self->tftpd( args => 'on' );
1.1 andrew 419:
1.2 andrew 420: if ($vals->{'Tftpd'} eq 'listen') {
421: return $vals;
422: } else {
423: return undef;
424: }
1.1 andrew 425: }
426:
1.2 andrew 427: =pod
1.1 andrew 428:
1.2 andrew 429: =item disable_tftpd
1.1 andrew 430:
1.3 andrew 431: runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
432:
1.2 andrew 433: =cut
1.1 andrew 434:
1.2 andrew 435: sub disable_tftpd
1.1 andrew 436: {
437: my $self = shift;
438:
1.2 andrew 439: my $vals = $self->tftpd( args => 'off' );
1.1 andrew 440:
1.2 andrew 441: if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
1.1 andrew 442: return $vals;
443: } else {
444: return undef;
445: }
446: }
447:
1.2 andrew 448: =pod
1.1 andrew 449:
1.2 andrew 450: =item cmd
1.1 andrew 451:
1.3 andrew 452: This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango.
453:
454: Normally returns the last lines from from the command
455:
456: Also accepts these options:
457:
458: I<decode>
459: - if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output
460:
461: I<cmd_disconnects>
462: - if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false
463:
464: I<expect>
465: - 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
466:
467: I<args>
468: - a string containing the command line options that are passed to the command
469:
1.2 andrew 470: =cut
1.1 andrew 471:
472: sub cmd
473: {
474: my $self = shift;
475:
1.2 andrew 476: my @valid_net_telnet_opts = qw(
477: String
478: Output
479: Cmd_remove_mode
480: Errmode
481: Input_record_separator
482: Ors
483: Output_record_separator
484: Prompt
485: Rs
486: Timeout
487: );
488:
489: my %cfg;
490: if (@_ == 2) {
491: $cfg{'String'} = shift;
492: } elsif (@_ > 2) {
493: %cfg = @_;
494: }
1.1 andrew 495:
1.2 andrew 496: $cfg{'Timeout'} ||= $self->Timeout;
497:
498: unless ($cfg{'String'}) {
499: #$! = "No command passed";
1.3 andrew 500: #warn "No command passed\n";
1.1 andrew 501: return undef;
502: }
503:
504: unless ($self->is_connected) {
1.2 andrew 505: #$! = "Not connected";
1.3 andrew 506: #warn "Not connected\n";
1.1 andrew 507: return undef;
508: }
509:
510: unless ($self->logged_in) {
1.2 andrew 511: #$! = "Not logged in";
1.3 andrew 512: #warn "Not logged in\n";
1.1 andrew 513: return undef;
514: }
515:
516:
1.2 andrew 517: my %cmd;
518: foreach (@valid_net_telnet_opts) {
519: if (exists $cfg{$_}) {
520: $cmd{$_} = $cfg{$_};
521: }
522: }
523: if ($cfg{'args'}) {
524: $cmd{'String'} .= ' ' . $cfg{'args'};
525: }
526: my @lines = $self->SUPER::cmd(%cmd);
1.1 andrew 527:
1.2 andrew 528: $self->last_lines(\@lines);
529:
530: my $vals = 1;
531: if ($cfg{'decode'}) {
1.4 ! andrew 532: if ($cfg{'decode'} eq 'each') {
! 533: $vals = _decode_each_line(@lines);
! 534: } elsif ($cfg{'decode'} eq 'sulog') {
! 535: $vals = _decode_sulog(@lines);
! 536: } else {
! 537: $vals = _decode_lines(@lines);
! 538: }
1.1 andrew 539: }
540:
1.2 andrew 541:
1.1 andrew 542: my $last = $self->lastline;
543:
1.2 andrew 544: if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
545: if ($cfg{'cmd_disconnects'}) {
546: $self->logged_in(0);
547: $self->close;
548: $self->is_connected(0);
549: }
550:
551: if ($cfg{'decode'}) {
552: return $vals;
553: } else {
554: return @lines;
555: }
1.1 andrew 556: } else {
1.2 andrew 557: #$! = "Error with command ($cfg{'string'}): $last";
1.1 andrew 558: return undef;
559: }
560: }
561:
1.2 andrew 562: #=item _decode_lines
563:
1.1 andrew 564: sub _decode_lines
565: {
566: my @lines = @_;
567:
568: my %conf;
569:
570: my $key = '';
571: my $val = '';
572: my $in_key = 0;
573: my $in_val = 0;
574:
575: foreach my $line (@lines) {
1.4 ! andrew 576: next if $line =~ /$success$/;
! 577:
1.1 andrew 578: my @chars = split //, $line;
579:
580: my $last_key = '';
581: foreach my $c (@chars) {
582:
583: if ($c eq '[' || $c eq "\r" || $c eq "\n") {
584: if ($c eq '[') {
585: $in_key = 1;
586: $in_val = 0;
587: } else {
588: $in_key = 0;
589: $in_val = 0;
590: }
591:
592: if ($key) {
593: $key =~ s/^\s+//;
594: $key =~ s/\s+$//;
595:
596: $val =~ s/^\s+//;
597: $val =~ s/\s+$//;
598:
599: if ($key eq 'Checksum' && $last_key) {
600: # Special case for these bastids.
601: my $new = $last_key;
602: $new =~ s/\s+\S+$//;
603: $key = $new . " " . $key;
604: }
605:
606: $last_key = $key;
607: $conf{$key} = $val;
608: $key = '';
609: $val = '';
610: }
611:
612: } elsif ($c eq ']') {
613: $in_val = 1;
614: $in_key = 0;
615: $c = shift @chars;
616:
617: } elsif ($in_key) {
618: $key .= $c;
619:
620: } elsif ($in_val) {
621: $val .= $c;
622: }
623: }
624: }
625:
626: if (%conf) {
627: return \%conf;
628: } else {
1.4 ! andrew 629: return undef;
! 630: }
! 631: }
! 632:
! 633: #=item _decode_each_line
! 634:
! 635: sub _decode_each_line
! 636: {
! 637: my @lines = @_;
! 638: my @decoded;
! 639: foreach my $line (@lines) {
! 640: my $decoded = _decode_lines($line);
! 641: push @decoded, $decoded if defined $decoded;
! 642: }
! 643: return \@decoded;
! 644: }
! 645:
! 646: #=item _decode_sulog
! 647:
! 648: sub _decode_sulog
! 649: {
! 650: my @lines = @_;
! 651: my @decoded;
! 652: my $last_tm;
! 653: foreach my $line (@lines) {
! 654: my $decoded = _decode_lines($line);
! 655:
! 656: if (defined $decoded) {
! 657: if ($decoded->{'tm'}) {
! 658: $last_tm = $decoded->{'tm'};
! 659: next;
! 660: } else {
! 661: $decoded->{'tm'} = $last_tm;
! 662: }
! 663: next unless $last_tm;
! 664:
! 665: push @decoded, $decoded if defined $decoded;
! 666: }
1.1 andrew 667: }
1.4 ! andrew 668: return \@decoded;
1.1 andrew 669: }
1.2 andrew 670:
671: 1;
672: __END__
673:
674: =back
675:
676: =head1 SEE ALSO
677:
678: Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
679:
680: L<Net::Telnet>
681:
682: =head1 TODO
683:
684: 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.
685:
686: 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.
687:
688: =head1 AUTHOR
689:
690: Andrew Fresh E<lt>andrew@rraz.netE<gt>
691:
692: =head1 COPYRIGHT AND LICENSE
693:
694: Copyright (C) 2005 by Andrew Fresh
695:
696: This library is free software; you can redistribute it and/or modify
697: it under the same terms as Perl itself, either Perl version 5.8.7 or,
698: at your option, any later version of Perl 5 you may have available.
699:
700:
701: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Trango.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet