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