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