Annotation of trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm, Revision 1.5
1.1 andrew 1: package Net::Telnet::Trango;
1.5 ! andrew 2: # $RedRiver: Trango.pm,v 1.4 2005/12/30 20:26:41 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.5 ! andrew 260: 'exit' => { no_prompt => 1, cmd_disconnects => 1 },
! 261: reboot => { no_prompt => 1, 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
1.5 ! andrew 282: last_vals
1.2 andrew 283: );
1.1 andrew 284:
285: sub AUTOLOAD
286: {
287: my $self = shift;
288:
289: my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
290: or die "Weird: $AUTOLOAD";
291:
1.2 andrew 292: if (exists $ALIASES{$method}) {
293: $method = $ALIASES{$method};
294: return $self->$method(@_);
295: }
1.1 andrew 296:
1.2 andrew 297: if (exists $COMMANDS{$method}) {
1.3 andrew 298: $method = shift if (@_ == 1);
1.2 andrew 299: $COMMANDS{$method}{'String'} ||= $method;
300: return $self->cmd(%{ $COMMANDS{$method} }, @_);
1.1 andrew 301: }
302:
303: if (exists $ACCESS{$method}) {
1.2 andrew 304: my $prev = $PRIVATE{$method};
305: ($PRIVATE{$method}) = @_ if @_;
306: return $prev;
1.1 andrew 307: }
308:
309: $method = "SUPER::$method";
310: return $self->$method(@_);
311: }
312:
1.2 andrew 313: =pod
314:
315: =item open
316:
1.3 andrew 317: 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()
318:
1.2 andrew 319: =cut
320:
321: sub open
1.1 andrew 322: {
323: my $self = shift;
324:
1.3 andrew 325: unless ( $self->SUPER::open(@_) ) {
1.2 andrew 326: #$! = "Couldn't connect to " . $self->Host . ": $!";
327: return undef;
1.1 andrew 328: }
329:
1.3 andrew 330: ## Get to login prompt
1.1 andrew 331: unless ($self->waitfor(
1.3 andrew 332: -match => '/password: ?$/i',
333: -errmode => "return",
334: ) ) {
335: #$! = "problem connecting to host (" . $self->Host . "): " .
336: # $self->lastline;
1.1 andrew 337: return undef;
338: }
339:
1.2 andrew 340: $self->parse_login_banner($self->lastline);
1.1 andrew 341:
342: $self->is_connected(1);
343:
1.2 andrew 344: return $self->is_connected;
1.1 andrew 345: }
346:
1.2 andrew 347: =pod
348:
349: =item login
350:
1.3 andrew 351: Calls open() if not already connected, then sends the password and sets logged_in() if successful
352:
1.2 andrew 353: =cut
354:
1.1 andrew 355: sub login
356: {
357: my $self = shift;
358:
1.2 andrew 359: unless ($self->is_connected) {
360: $self->open or return undef;
361: }
362:
1.1 andrew 363: my $password = shift;
364:
365: $self->print($password);
366: unless ($self->waitfor(
367: -match => $self->prompt,
368: -errmode => "return",
369: ) ) {
1.2 andrew 370: #$! = "login ($self->Host) failed: " . $self->lastline;
1.1 andrew 371: return undef;
372: }
373:
374: $self->logged_in(1);
375:
376: return $self->logged_in;
377: }
378:
1.2 andrew 379: =pod
380:
381: =item parse_login_banner
382:
1.3 andrew 383: 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()
384:
1.2 andrew 385: =cut
386:
387: sub parse_login_banner
1.1 andrew 388: {
389: my $self = shift;
390:
1.2 andrew 391: if (@_) {
392: $self->login_banner(@_);
393: }
394:
395: my $banner = $self->login_banner;
1.1 andrew 396:
397: my ($type, $ver) = $banner =~
398: /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;
399:
1.2 andrew 400: $self->login_banner($banner);
1.1 andrew 401: $self->host_type($type);
402: $self->firmware_version($ver);
403:
1.2 andrew 404: return 1;
1.1 andrew 405: }
406:
1.2 andrew 407: =pod
408:
1.5 ! andrew 409: =item su_password
! 410:
! 411: C<su_password('all'|suid, 'new_password')>
! 412:
! 413: =cut
! 414:
! 415: sub su_password
! 416: {
! 417: my $self = shift;
! 418: my $su = shift || '!';
! 419: my $new_pass = shift || '';
! 420:
! 421: unless (defined $su) {
! 422: warn "No su passed!"
! 423: #return undef;
! 424: }
! 425:
! 426: unless (defined $new_pass) {
! 427: warn "No new password!"
! 428: #return undef;
! 429: }
! 430:
! 431: return $self->cmd(String => 'su password ' .
! 432: $su . ' ' .
! 433: $new_pass . ' ' .
! 434: $new_pass,
! 435: expect => $success,
! 436: );
! 437: }
! 438:
! 439:
! 440: =pod
! 441:
! 442: =item sudb_view
! 443:
! 444: returns a reference to an array of hashes each containing:
! 445:
! 446: suid
! 447: type
! 448: cir
! 449: mir
! 450: mac
! 451:
! 452: =cut
! 453:
! 454: sub sudb_view
! 455: {
! 456: my $self = shift;
! 457:
! 458: my @lines = $self->cmd( String => 'sudb view', expect => $success );
! 459:
! 460: return undef unless @lines;
! 461:
! 462: my @sus;
! 463: foreach (@lines) {
! 464: if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9a-fA-F]+)/) {
! 465: my %s = (
! 466: suid => $1,
! 467: type => $2,
! 468: cir => $3,
! 469: mir => $4,
! 470: mac => $5,
! 471: );
! 472: push @sus, \%s;
! 473: }
! 474: }
! 475:
! 476: return \@sus;
! 477: }
! 478:
! 479: =pod
! 480:
1.2 andrew 481: =item enable_tftpd
482:
1.3 andrew 483: runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
484:
1.2 andrew 485: =cut
486:
487: sub enable_tftpd
1.1 andrew 488: {
489: my $self = shift;
490:
1.2 andrew 491: my $vals = $self->tftpd( args => 'on' );
1.1 andrew 492:
1.2 andrew 493: if ($vals->{'Tftpd'} eq 'listen') {
494: return $vals;
495: } else {
496: return undef;
497: }
1.1 andrew 498: }
499:
1.2 andrew 500: =pod
1.1 andrew 501:
1.2 andrew 502: =item disable_tftpd
1.1 andrew 503:
1.3 andrew 504: runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
505:
1.2 andrew 506: =cut
1.1 andrew 507:
1.2 andrew 508: sub disable_tftpd
1.1 andrew 509: {
510: my $self = shift;
511:
1.2 andrew 512: my $vals = $self->tftpd( args => 'off' );
1.1 andrew 513:
1.2 andrew 514: if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
1.1 andrew 515: return $vals;
516: } else {
517: return undef;
518: }
519: }
520:
1.2 andrew 521: =pod
1.1 andrew 522:
1.2 andrew 523: =item cmd
1.1 andrew 524:
1.3 andrew 525: This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango.
526:
527: Normally returns the last lines from from the command
528:
529: Also accepts these options:
530:
531: I<decode>
532: - if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output
533:
534: I<cmd_disconnects>
535: - if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false
536:
537: I<expect>
538: - 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
539:
540: I<args>
541: - a string containing the command line options that are passed to the command
542:
1.2 andrew 543: =cut
1.1 andrew 544:
545: sub cmd
546: {
547: my $self = shift;
548:
1.2 andrew 549: my @valid_net_telnet_opts = qw(
550: String
551: Output
552: Cmd_remove_mode
553: Errmode
554: Input_record_separator
555: Ors
556: Output_record_separator
557: Prompt
558: Rs
559: Timeout
560: );
561:
562: my %cfg;
563: if (@_ == 2) {
564: $cfg{'String'} = shift;
565: } elsif (@_ > 2) {
566: %cfg = @_;
567: }
1.1 andrew 568:
1.2 andrew 569: $cfg{'Timeout'} ||= $self->Timeout;
570:
571: unless ($cfg{'String'}) {
572: #$! = "No command passed";
1.3 andrew 573: #warn "No command passed\n";
1.1 andrew 574: return undef;
575: }
576:
577: unless ($self->is_connected) {
1.2 andrew 578: #$! = "Not connected";
1.3 andrew 579: #warn "Not connected\n";
1.1 andrew 580: return undef;
581: }
582:
583: unless ($self->logged_in) {
1.2 andrew 584: #$! = "Not logged in";
1.3 andrew 585: #warn "Not logged in\n";
1.1 andrew 586: return undef;
587: }
588:
589:
1.2 andrew 590: my %cmd;
591: foreach (@valid_net_telnet_opts) {
592: if (exists $cfg{$_}) {
593: $cmd{$_} = $cfg{$_};
594: }
595: }
596: if ($cfg{'args'}) {
597: $cmd{'String'} .= ' ' . $cfg{'args'};
598: }
1.5 ! andrew 599: my @lines;
! 600: unless ($cfg{'no_prompt'}) {
! 601: @lines = $self->SUPER::cmd(%cmd);
! 602: } else {
! 603: $self->print($cmd{'String'});
! 604: @lines = $self->lastline;
! 605: }
1.1 andrew 606:
1.2 andrew 607: $self->last_lines(\@lines);
608:
609: my $vals = 1;
610: if ($cfg{'decode'}) {
1.4 andrew 611: if ($cfg{'decode'} eq 'each') {
612: $vals = _decode_each_line(@lines);
613: } elsif ($cfg{'decode'} eq 'sulog') {
614: $vals = _decode_sulog(@lines);
615: } else {
616: $vals = _decode_lines(@lines);
617: }
1.1 andrew 618: }
1.5 ! andrew 619:
! 620: $self->last_vals($vals);
1.1 andrew 621:
1.2 andrew 622:
1.1 andrew 623: my $last = $self->lastline;
624:
1.2 andrew 625: if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
626: if ($cfg{'cmd_disconnects'}) {
627: $self->logged_in(0);
628: $self->close;
629: $self->is_connected(0);
630: }
631:
632: if ($cfg{'decode'}) {
633: return $vals;
634: } else {
635: return @lines;
636: }
1.1 andrew 637: } else {
1.2 andrew 638: #$! = "Error with command ($cfg{'string'}): $last";
1.1 andrew 639: return undef;
640: }
641: }
642:
1.2 andrew 643: #=item _decode_lines
644:
1.1 andrew 645: sub _decode_lines
646: {
647: my @lines = @_;
648:
649: my %conf;
650:
651: my $key = '';
652: my $val = '';
653: my $in_key = 0;
654: my $in_val = 0;
655:
656: foreach my $line (@lines) {
1.4 andrew 657: next if $line =~ /$success$/;
658:
1.1 andrew 659: my @chars = split //, $line;
660:
661: my $last_key = '';
662: foreach my $c (@chars) {
663:
664: if ($c eq '[' || $c eq "\r" || $c eq "\n") {
665: if ($c eq '[') {
666: $in_key = 1;
667: $in_val = 0;
668: } else {
669: $in_key = 0;
670: $in_val = 0;
671: }
672:
673: if ($key) {
674: $key =~ s/^\s+//;
675: $key =~ s/\s+$//;
676:
677: $val =~ s/^\s+//;
678: $val =~ s/\s+$//;
679:
680: if ($key eq 'Checksum' && $last_key) {
681: # Special case for these bastids.
682: my $new = $last_key;
683: $new =~ s/\s+\S+$//;
684: $key = $new . " " . $key;
685: }
686:
687: $last_key = $key;
688: $conf{$key} = $val;
689: $key = '';
690: $val = '';
691: }
692:
693: } elsif ($c eq ']') {
694: $in_val = 1;
695: $in_key = 0;
696: $c = shift @chars;
697:
698: } elsif ($in_key) {
699: $key .= $c;
700:
701: } elsif ($in_val) {
702: $val .= $c;
703: }
704: }
705: }
706:
707: if (%conf) {
708: return \%conf;
709: } else {
1.4 andrew 710: return undef;
711: }
712: }
713:
714: #=item _decode_each_line
715:
716: sub _decode_each_line
717: {
718: my @lines = @_;
719: my @decoded;
720: foreach my $line (@lines) {
721: my $decoded = _decode_lines($line);
722: push @decoded, $decoded if defined $decoded;
723: }
724: return \@decoded;
725: }
726:
727: #=item _decode_sulog
728:
729: sub _decode_sulog
730: {
731: my @lines = @_;
732: my @decoded;
733: my $last_tm;
734: foreach my $line (@lines) {
735: my $decoded = _decode_lines($line);
736:
737: if (defined $decoded) {
738: if ($decoded->{'tm'}) {
739: $last_tm = $decoded->{'tm'};
740: next;
741: } else {
742: $decoded->{'tm'} = $last_tm;
743: }
744: next unless $last_tm;
745:
746: push @decoded, $decoded if defined $decoded;
747: }
1.1 andrew 748: }
1.4 andrew 749: return \@decoded;
1.1 andrew 750: }
1.2 andrew 751:
752: 1;
753: __END__
754:
755: =back
756:
757: =head1 SEE ALSO
758:
759: Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
760:
761: L<Net::Telnet>
762:
763: =head1 TODO
764:
765: 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.
766:
767: 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.
768:
769: =head1 AUTHOR
770:
771: Andrew Fresh E<lt>andrew@rraz.netE<gt>
772:
773: =head1 COPYRIGHT AND LICENSE
774:
775: Copyright (C) 2005 by Andrew Fresh
776:
777: This library is free software; you can redistribute it and/or modify
778: it under the same terms as Perl itself, either Perl version 5.8.7 or,
779: at your option, any later version of Perl 5 you may have available.
780:
781:
782: =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