[BACK]Return to Trango.pm CVS log [TXT][DIR] Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet

Annotation of trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm, Revision 1.30

1.14      andrew      1: package Net::Telnet::Trango;
1.30    ! andrew      2: # $RedRiver: Trango.pm,v 1.29 2007/02/01 17:58:33 andrew Exp $
1.14      andrew      3: use strict;
                      4: use warnings;
                      5: use base 'Net::Telnet';
                      6:
                      7: =pod
                      8:
                      9: =head1 NAME
                     10:
1.26      andrew     11: Net::Telnet::Trango
                     12: - Perl extension for accessing the Trango telnet interface
1.14      andrew     13:
                     14: =head1 SYNOPSIS
                     15:
                     16:   use Net::Telnet::Trango;
                     17:   my $t = new Net::Telnet::Trango ( Timeout => 5 );
1.24      andrew     18:
1.14      andrew     19:   $t->open( Host => $fox ) or die "Error connecting: $!";
                     20:
                     21:   $t->login('password') or die "Couldn't log in: $!";
1.24      andrew     22:
1.14      andrew     23:   # Do whatever
1.24      andrew     24:
1.14      andrew     25:   $t->exit;
                     26:   $t->close;
                     27:
                     28: =head1 DESCRIPTION
                     29:
                     30: Perl access to the telnet interface on Trango Foxes, SUs and APs.
                     31:
1.20      andrew     32: Another handy feature is that it will parse the output from certain
                     33: commands that is in the format "[key1] value1 [key2] value2" and put
                     34: those in a hashref that is returned.  This makes using the output from
                     35: things like sysinfo very easy to do.
1.14      andrew     36:
                     37: =head2 EXPORT
                     38:
                     39: None
                     40:
1.24      andrew     41: =head1 METHODS
                     42:
                     43: =over
                     44:
1.14      andrew     45: =cut
                     46:
                     47: our $VERSION = '0.01';
                     48:
                     49: my %PRIVATE = (
                     50:   is_connected => 0,
                     51:   logged_in => 0,
                     52: );
                     53:
                     54: =pod
                     55:
1.26      andrew     56: =item B<new>
1.14      andrew     57:
1.26      andrew     58: - Creates a new Net::Telnet::Trango object.
                     59:
                     60:        new([Options from Net::Telnet,]
                     61:            [Decode => 0,]);
                     62:
                     63: Same as new from L<Net::Telnet> but sets the default Trango Prompt:
                     64: '/#> *$/'
1.14      andrew     65:
                     66: It also takes an optional parameter 'Decode'.  If not defined it
                     67: defaults to 1, if it is set to 0, it will not decode the output and
1.27      mike       68: instead return a reference to an array of the lines that were returned
                     69: from the command.
1.14      andrew     70:
                     71: =cut
                     72:
                     73: sub new
                     74: {
                     75:   my $class = shift;
                     76:
                     77:   my %args;
                     78:   if (@_ == 1) {
                     79:     $args{'Host'} = shift;
                     80:   } else {
                     81:     %args = @_;
                     82:   }
                     83:
                     84:   $args{'Prompt'}  ||= '/#> *$/';
                     85:
                     86:   foreach my $key (keys %args) {
                     87:     $PRIVATE{$key} = $args{$key};
                     88:   }
                     89:   $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'};
                     90:   delete $args{'Decode'};
                     91:
                     92:   my $self = $class->SUPER::new(%args);
                     93:   bless $self if ref $self;
                     94:
                     95:   return $self;
                     96: }
                     97:
                     98: #  _password <new password> <new password>
                     99: #  ? [command]
                    100: #  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
                    101: #  arp -bcast <on|off>
                    102: #  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
                    103: #  bye
                    104: #  cf2cf ap [default|<size>]
                    105: #  date
                    106: #  date <month> <day> <year>
                    107: #  freq scantable
                    108: #  freq channeltable
                    109: #  freq writescan [<ch#> <h|v>]
                    110: #  freq writechannel [<ch#> <freq>] ...
                    111: #  freq <ch #> <h|v>
                    112: #  help [command]
                    113: #  heater [<on temp> <off temp>]
                    114: #  ipconfig [<new ip> <new subnet mask> <new gateway>]
                    115: #  log [<# of entries, 1..179>]
                    116: #  log <sum> <# of entries, 1..179>
                    117: #  logout
                    118: #  opmode [ap [y]]
                    119: #  password
                    120: #  ping <ip addr>
                    121: #  polar <h|v>
                    122: #  power <setism|setunii> <max|min|<dBm>>
                    123: #  reboot
                    124: #  restart
                    125: #  remarks [<str>]
                    126: #  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
                    127: #  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
                    128: #  sysinfo
                    129: #  set suid <id>
                    130: #  set apid <id>
                    131: #  set baseid <id>
                    132: #  set defaultopmode [<ap|su> <min,0..10>]
                    133: #  set defaultopmode off
                    134: #  set snmpcomm [<read | write | trap (id or setall)> <str>]
                    135: #  set mir [on|off]
                    136: #  set mir threshold <kbps>
                    137: #  set rssitarget [<ism|unii> <dBm>]
                    138: #  set serviceradius [<ism | unii> <miles>]
                    139: #  ssrssi <ch #> <h|v>
                    140: #  su [<suid>|all]
                    141: #  su changechannel <all|suid> <ch#> <h|v>
                    142: #  su ipconfig <suid> <new ip> <new subnet> <new gateway>
                    143: #  su [live|poweroff|priority]
                    144: #  su <ping|info|status> <suid>
                    145: #  su powerleveling <all|suid>
                    146: #  su reboot <all|suid>
                    147: #  su restart <all|suid>
                    148: #  su testrflink <all|suid> [r]
                    149: #  su testrflink <setlen> [64..1600]
                    150: #  su testrflink <aptx> [20..100]
                    151: #  su sw <suid|all> <sw #> <on|off>
                    152: #  sudb [dload | view]
                    153: #  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
                    154: #  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
                    155: #  sudb delete <all|<suid>>
                    156: #  sudb modify <suid> <cir|mir> <kbps>
                    157: #  sudb modify <suid> <su2su> <group id,hex>
                    158: #  sudb view
                    159: #  sulog [lastmins | sampleperiod <1..60>]
                    160: #  sulog [<# of entry,1..18>]
                    161: #  survey <ism|unii> <time, sec> <h|v>
                    162: #  sw [<sw #> <on|off>]
                    163: #  temp
                    164: #  tftpd [on|off]
                    165: #  time
                    166: #  time <hour> <min> <sec>
                    167: #  save <mainimage|fpgaimage> <current chksum> <new chksum>
                    168: #  save <systemsetting|sudb>
                    169: #  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
                    170: #  updateflash <systemsetting|sudb>
                    171:
                    172: =pod
                    173:
1.24      andrew    174: =back
1.14      andrew    175:
                    176: =head2 ACCESSORS
                    177:
1.26      andrew    178: These are usually only set internally.
                    179:
1.14      andrew    180: =over
                    181:
1.26      andrew    182: =item B<firmware_version>
1.14      andrew    183:
1.26      andrew    184: - returns the firmware version
1.14      andrew    185:
1.26      andrew    186: Returns the firmware version if available, otherwise undef.
1.14      andrew    187:
1.26      andrew    188: It should be available after a successful open().
1.14      andrew    189:
1.26      andrew    190: =item B<host_type>
                    191:
                    192: - return the type of host you are connected to.
1.14      andrew    193:
                    194: returns the type of host from the login banner for example M5830S or M5300S.
                    195:
1.26      andrew    196: Should be available after a successful open().
                    197:
                    198: =item B<is_connected>
                    199:
                    200: - Status of the connection to host.
                    201:
                    202: returns 1 when connected, undef otherwise.
                    203:
                    204: =item B<logged_in>
1.14      andrew    205:
1.26      andrew    206: - Status of being logged in to the host.
1.14      andrew    207:
1.26      andrew    208: returns 1 after a successful login(), 0 if it failed and undef if
                    209: login() was never called.
1.14      andrew    210:
1.26      andrew    211: =item B<login_banner>
1.14      andrew    212:
1.26      andrew    213: - The banner when first connecting to the host.
1.14      andrew    214:
1.20      andrew    215: returns the banner that is displayed when first connected at login.
1.26      andrew    216: Only set after a successful open().
1.14      andrew    217:
1.26      andrew    218: =item B<last_lines>
1.14      andrew    219:
1.26      andrew    220: - The last lines of output from the last cmd().
1.14      andrew    221:
1.26      andrew    222: returns, as an array ref, the output from the last cmd() that was run.
1.14      andrew    223:
1.26      andrew    224: =item B<last_error>
1.25      andrew    225:
1.26      andrew    226: - A text output of the last error that was encountered.
                    227:
                    228: returns the last error reported.  Probably contains the last entry in
                    229: last_lines.
1.25      andrew    230:
1.14      andrew    231: =back
                    232:
                    233: =head2 ALIASES
                    234:
                    235: =over
                    236:
1.26      andrew    237: =item B<bye>
1.14      andrew    238:
1.26      andrew    239: - alias of L<exit()>.
1.14      andrew    240:
1.26      andrew    241: =item B<restart>
1.14      andrew    242:
1.26      andrew    243: - alias of L<reboot()>.
1.14      andrew    244:
                    245: =back
                    246:
                    247: =head2 COMMANDS
                    248:
1.19      andrew    249: Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
                    250: as such they accept the same options as C<cmd()>.
                    251: Specifically they take a named paramater "args", for example:
1.14      andrew    252: C<tftpd(args =E<gt> 'on')> would enable tftpd
                    253:
                    254: =over
                    255:
1.26      andrew    256: =item B<tftpd>
                    257:
                    258: - Returns a hash ref of the decoded output from the
                    259: command.
1.14      andrew    260:
1.26      andrew    261: Also see enable_tftpd() and disable_tftpd() as those check that it was
                    262: successfully changed.
1.14      andrew    263:
1.26      andrew    264: =item B<ver>
1.14      andrew    265:
1.26      andrew    266: - Returns a hash ref of the decoded output from the
                    267: command.
1.14      andrew    268:
1.26      andrew    269: =item B<sysinfo>
1.14      andrew    270:
1.26      andrew    271: - Returns a hash ref of the decoded output from the
                    272: command.
1.14      andrew    273:
1.26      andrew    274: =item B<exit>
1.14      andrew    275:
1.26      andrew    276: - exits the command session with the Trango and closes
                    277: the connection
1.14      andrew    278:
1.26      andrew    279: =item B<reboot>
1.14      andrew    280:
1.26      andrew    281: - reboots the Trango and closes the connection
1.14      andrew    282:
1.26      andrew    283: =item B<remarks>
1.14      andrew    284:
1.26      andrew    285: - Set or retrieve the remarks.
1.17      andrew    286:
1.18      andrew    287: Takes an optional argument, which sets the remarks.
                    288: If there is no argument, returns the current remarks.
1.17      andrew    289:
1.26      andrew    290:   my $old_remarks = $t->remarks();
                    291:   $t->remarks($new_remarks);
                    292:
                    293: =item B<sulog>
                    294:
                    295: - returns an array ref of hashes containing each log
                    296: line.
                    297:
                    298: =item B<save_sudb>
1.14      andrew    299:
1.26      andrew    300: - returns true on success, undef on failure
1.14      andrew    301:
1.26      andrew    302: =item B<syslog>
1.14      andrew    303:
1.26      andrew    304: - returns the output from the syslog command
1.14      andrew    305:
1.26      andrew    306: =item B<pipe>
1.14      andrew    307:
1.26      andrew    308: - returns the output from the pipe command
1.14      andrew    309:
1.26      andrew    310: =item B<maclist>
1.14      andrew    311:
1.26      andrew    312: -  returns the output from the maclist command
1.14      andrew    313:
1.26      andrew    314: =item B<maclist_reset>
1.14      andrew    315:
1.26      andrew    316: - resets the maclist.
1.14      andrew    317:
1.26      andrew    318: No useful output.
1.14      andrew    319:
1.26      andrew    320: =item B<eth_list>
1.14      andrew    321:
1.26      andrew    322: - returns the output from the eth list command
1.14      andrew    323:
1.26      andrew    324: =item B<su_info>
1.14      andrew    325:
1.26      andrew    326: - returns information about the SU.
1.17      andrew    327:
1.26      andrew    328: You need to pass in the $suid and it will return the info for that suid.
1.17      andrew    329:
1.26      andrew    330:   $t->su_info($suid);
1.17      andrew    331:
1.26      andrew    332: =item B<save_ss>
                    333:
                    334: - saves the config.
                    335:
                    336: Returns 1 on success, undef on failure.
1.17      andrew    337:
1.14      andrew    338: =cut
                    339:
                    340:
1.27      mike      341: my $success = 'Success\\.';
1.14      andrew    342: my %COMMANDS = (
                    343:   tftpd       => { decode => 'all',   expect => $success },
                    344:   ver         => { decode => 'all' },
                    345:   sysinfo     => { decode => 'all',   expect => $success },
                    346:   updateflash => { decode => 'all',   expect => $success },
                    347:   sulog       => { decode => 'sulog', expect => $success },
                    348:   'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
                    349:   reboot      => { no_prompt => 1, cmd_disconnects => 1 },
1.17      andrew    350:   remarks     => { decode => 'all', expect => $success },
1.14      andrew    351:   save_sudb   => { String => 'save sudb', expect => $success },
                    352:   syslog      => { expect => $success },
                    353:   'pipe'      => { }, # XXX needs a special decode
                    354:   maclist     => { decode => 'maclist' },
                    355:   maclist_reset => { String => 'maclist reset', expect => 'done' },
                    356:   eth_link    => { String => 'eth link', expect => $success },
1.17      andrew    357:   su_info     => { String => 'su info', decode => 'all', expect => $success },
                    358:   save_ss     => { String => 'save ss', expect => $success },
1.21      andrew    359:   opmode      => { decode => 'all',   expect => $success },
1.14      andrew    360:   # eth r, w and reset???
                    361:   #su password???
                    362:   #_bootloader
                    363:   #temp
                    364:   #heater
                    365: );
                    366:
                    367: my %ALIASES = (
                    368:   bye     => 'exit',
                    369:   restart => 'reboot',
1.27      mike      370:   Host    => 'host',
1.14      andrew    371: );
                    372:
                    373: my %ACCESS = map { $_ => 1 } qw(
                    374:   firmware_version
                    375:   host_type
                    376:   is_connected
                    377:   logged_in
                    378:   login_banner
                    379:   Timeout
                    380:   last_lines
                    381:   last_vals
1.25      andrew    382:   last_error
1.29      andrew    383:   Decode
1.14      andrew    384: );
                    385:
                    386: sub AUTOLOAD
                    387: {
                    388:   my $self = shift;
                    389:
                    390:   my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
                    391:     or die "Weird: $AUTOLOAD";
                    392:
                    393:   if (exists $ALIASES{$method}) {
                    394:     $method = $ALIASES{$method};
                    395:     return $self->$method(@_);
                    396:   }
                    397:
                    398:   if (exists $COMMANDS{$method}) {
1.30    ! andrew    399:     my %cmd;
        !           400:     foreach my $k (keys %{ $COMMANDS{$method} }) {
        !           401:       $cmd{$k} = $COMMANDS{$method}{$k};
        !           402:     }
        !           403:     $cmd{'String'} ||= $method;
        !           404:     $cmd{'args'}   .= ' ' . shift if (@_ == 1);
        !           405:     return $self->cmd(%cmd, @_);
1.14      andrew    406:   }
                    407:
                    408:   if (exists $ACCESS{$method}) {
                    409:     my $prev = $PRIVATE{$method};
                    410:     ($PRIVATE{$method}) = @_ if @_;
                    411:     return $prev;
                    412:   }
                    413:
                    414:   $method = "SUPER::$method";
                    415:   return $self->$method(@_);
                    416: }
                    417:
                    418: =pod
                    419:
1.26      andrew    420: =item B<open>
                    421:
                    422: - Open a connection to a Trango AP.
1.14      andrew    423:
1.20      andrew    424: Calls Net::Telnet::open() then makes sure you get a password prompt so
                    425: you are ready to login() and parses the login banner so you can get
                    426: host_type() and firmware_version()
1.14      andrew    427:
                    428: =cut
                    429:
                    430: sub open
                    431: {
                    432:   my $self = shift;
                    433:
                    434:   unless ( $self->SUPER::open(@_) ) {
1.27      mike      435:     $self->last_error("Couldn't connect to " . $self->host . ":  $!");
1.29      andrew    436:     return;
1.14      andrew    437:   }
                    438:
                    439:   ## Get to login prompt
                    440:   unless ($self->waitfor(
                    441:       -match => '/password: ?$/i',
                    442:       -errmode => "return",
                    443:     ) ) {
1.27      mike      444:     $self->last_error("problem connecting to host (" . $self->host . "): " .
1.25      andrew    445:         $self->lastline);
1.29      andrew    446:     return;
1.14      andrew    447:   }
                    448:
                    449:   $self->parse_login_banner($self->lastline);
                    450:
                    451:   $self->is_connected(1);
                    452:
                    453:   return $self->is_connected;
                    454: }
                    455:
                    456: =pod
                    457:
1.26      andrew    458: =item B<login>
                    459:
                    460: - Login to the AP.
1.14      andrew    461:
1.20      andrew    462: Calls open() if not already connected, then sends the password and sets
                    463: logged_in() if successful
1.14      andrew    464:
                    465: =cut
                    466:
                    467: sub login
                    468: {
                    469:   my $self = shift;
                    470:
                    471:   unless ($self->is_connected) {
1.29      andrew    472:     $self->open or return;
1.14      andrew    473:   }
                    474:
                    475:   my $password = shift;
                    476:
                    477:   $self->print($password);
                    478:   unless ($self->waitfor(
                    479:     -match => $self->prompt,
                    480:     -errmode => "return",
                    481:   ) ) {
1.27      mike      482:     $self->last_error("login ($self->host) failed: " . $self->lastline);
1.29      andrew    483:     return;
1.14      andrew    484:   }
                    485:
                    486:   $self->logged_in(1);
                    487:
                    488:   return $self->logged_in;
                    489: }
                    490:
                    491: =pod
                    492:
1.26      andrew    493: =item B<parse_login_banner>
                    494:
                    495: - Converts the login_banner to some useful
                    496: variables.
1.14      andrew    497:
1.20      andrew    498: Takes a login banner (what you get when you first connect to the Trango)
                    499: or reads what is already in login_banner() then parses it and sets
                    500: host_type() and firmware_version() as well as login_banner()
1.14      andrew    501:
                    502: =cut
                    503:
                    504: sub parse_login_banner
                    505: {
                    506:   my $self = shift;
                    507:
                    508:   if (@_) {
                    509:     $self->login_banner(@_);
                    510:   }
                    511:
                    512:   my $banner = $self->login_banner;
                    513:
1.28      mike      514:   my ($type, $sep1, $subtype, $sep2, $ver) = $banner =~
                    515:     /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
                    516:
                    517:   $type .= $sep1 . $subtype;
                    518:   $ver = $subtype . $sep2 . $ver;
1.14      andrew    519:
                    520:   $self->login_banner($banner);
                    521:   $self->host_type($type);
                    522:   $self->firmware_version($ver);
                    523:
                    524:   return 1;
                    525: }
                    526:
                    527: =pod
                    528:
1.26      andrew    529: =item B<su_password>
1.14      andrew    530:
1.26      andrew    531: - Set the password on SUs connected to the AP.
                    532:
                    533: su_password('new_password'[, 'suid']) If no suid is specified,
1.23      mike      534: the default is "all".
1.14      andrew    535:
1.26      andrew    536:   $t->su_password('good_pass', 5);
                    537:
1.14      andrew    538: =cut
                    539:
                    540: sub su_password
                    541: {
                    542:   my $self     = shift;
                    543:   my $new_pass = shift || '';
1.23      mike      544:   my $su       = shift || 'all';
1.14      andrew    545:
                    546:   unless (defined $new_pass) {
1.25      andrew    547:     $self->last_error("No new password");
1.29      andrew    548:     #return;
1.14      andrew    549:   }
                    550:
                    551:   return $self->cmd(String => 'su password ' .
                    552:                      $su . ' ' .
                    553:                      $new_pass . ' ' .
                    554:                      $new_pass,
                    555:                      expect => $success,
                    556:                     );
                    557: }
                    558:
                    559: =pod
                    560:
1.26      andrew    561: =item B<su_ipconfig>
                    562:
                    563: - Change IP configuration on SUs connected to
                    564: the AP.
1.14      andrew    565:
1.26      andrew    566: su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
                    567:
                    568:   $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );
1.14      andrew    569:
                    570: =cut
                    571:
                    572: sub su_ipconfig
                    573: {
                    574:        my $self        = shift;
                    575:
                    576:        my $suid        = shift;
                    577:        my $new_ip      = shift;
                    578:        my $new_subnet  = shift;
                    579:        my $new_gateway = shift;
                    580:
1.25      andrew    581:        if ($suid =~ /\D/) {
                    582:                $self->last_error("Invalid suid '$suid'");
1.29      andrew    583:                return;
1.25      andrew    584:        }
                    585:        unless ($new_ip) {
                    586:                $self->last_error("no new_ip passed");
1.29      andrew    587:                return;
1.25      andrew    588:        }
                    589:        unless ($new_subnet) {
                    590:                $self->last_error("no new_subnet passed");
1.29      andrew    591:                return;
1.25      andrew    592:        }
                    593:        unless ($new_gateway) {
                    594:                $self->last_error("no new_gateway passed");
1.29      andrew    595:                return;
1.25      andrew    596:        }
1.14      andrew    597:
                    598:        # su ipconfig <suid> <new ip> <new subnet> <new gateway>
                    599:        return $self->cmd(String => 'su ipconfig ' .
                    600:                      $suid       . ' ' .
                    601:                      $new_ip     . ' ' .
                    602:                      $new_subnet . ' ' .
                    603:                      $new_gateway,
                    604:                      expect => $success,
                    605:                     );
                    606: }
                    607:
                    608: =pod
                    609:
1.26      andrew    610: =item B<sudb_view>
1.14      andrew    611:
1.26      andrew    612: - Returns the output from the sudb view command
1.14      andrew    613:
1.26      andrew    614: returns a reference to an array of hashes each containing these keys
                    615: 'suid', 'type', 'cir', 'mir' and 'mac'
1.14      andrew    616:
                    617: =cut
                    618:
                    619: sub sudb_view
                    620: {
                    621:   my $self = shift;
                    622:
1.29      andrew    623:   my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];
1.14      andrew    624:
1.29      andrew    625:   return unless @{ $lines };
1.14      andrew    626:
                    627:   unless ($PRIVATE{'Decode'}) {
1.29      andrew    628:     return $lines;
1.14      andrew    629:   }
                    630:
                    631:   my @sus;
1.29      andrew    632:   foreach (@{ $lines }) {
1.14      andrew    633:     next unless $_;
                    634:     if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
                    635:       my %s = (
                    636:         suid => $1,
                    637:         type => $2,
                    638:         cir  => $3,
                    639:         mir  => $4,
                    640:         mac  => $5,
                    641:       );
                    642:
                    643:          $s{'mac'} =~ s/\s//g;
                    644:          $s{'mac'} = uc($s{'mac'});
                    645:
                    646:       push @sus, \%s;
                    647:     }
                    648:   }
                    649:
                    650:   return \@sus;
                    651: }
                    652:
                    653: =pod
                    654:
1.26      andrew    655: =item B<sudb_add>
1.14      andrew    656:
                    657: Takes the following paramaters
                    658:
                    659:        suid : numeric,
                    660:        type : (reg|pr)
                    661:        cir  : numeric,
                    662:        mir  : numeric,
                    663:        mac  : Almost any format, it will be reformatted,
                    664:
                    665: and returns true on success or undef otherwise.
                    666:
1.26      andrew    667:   $t->sudb_add($suid, 'reg', $cir, $mir, $mac);
                    668:
1.14      andrew    669: You should save_sudb() after calling this, or your changes  will be lost
                    670: when the AP is rebooted.
                    671:
                    672: =cut
                    673:
                    674: sub sudb_add
                    675: {
                    676:        my $self = shift;
                    677:        my $suid = shift;
                    678:        my $type = shift;
                    679:        my $cir  = shift;
                    680:        my $mir  = shift;
                    681:        my $mac  = shift;
                    682:
                    683:        if ($suid =~ /\D/) {
1.25      andrew    684:                $self->last_error("Invalid suid '$suid'");
1.29      andrew    685:                return;
1.14      andrew    686:        }
                    687:
                    688:        unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
1.25      andrew    689:                $self->last_error("Invalid type '$type'");
1.29      andrew    690:                return;
1.14      andrew    691:        }
                    692:
                    693:        if ($cir =~ /\D/) {
1.25      andrew    694:                $self->last_error("Invalid CIR '$cir'");
1.29      andrew    695:                return;
1.14      andrew    696:        }
                    697:
                    698:        if ($mir =~ /\D/) {
1.25      andrew    699:                $self->last_error("Invalid MIR '$mir'");
1.29      andrew    700:                return;
1.14      andrew    701:        }
                    702:
                    703:        my $new_mac = $mac;
                    704:        $new_mac =~ s/[^0-9A-Fa-f]//;
                    705:        unless (length $new_mac == 12) {
1.25      andrew    706:                $self->last_error("Invalid MAC '$mac'");
1.29      andrew    707:                return;
1.14      andrew    708:        }
                    709:        $new_mac = join ' ', $new_mac =~ /../g;
                    710:
                    711:        my $string = 'sudb add ' .
                    712:                $suid . ' ' .
                    713:                $type . ' ' .
                    714:                $cir  . ' ' .
                    715:                $mir  . ' ' .
                    716:                $new_mac;
                    717:
                    718:
                    719:        return $self->cmd( String => $string, expect => $success );
                    720: }
                    721:
                    722: =pod
                    723:
1.26      andrew    724: =item B<sudb_delete>
1.14      andrew    725:
                    726: Takes either 'all' or the  suid of the su to delete
                    727: and returns true on success or undef otherwise.
                    728:
1.26      andrew    729:   $t->sudb_delete($suid);
                    730:
1.14      andrew    731: You should save_sudb() after calling this, or your changes  will be lost
                    732: when the AP is rebooted.
                    733:
                    734: =cut
                    735:
                    736: sub sudb_delete
                    737: {
                    738:        my $self = shift;
                    739:        my $suid = shift;
                    740:
1.25      andrew    741:        #if (lc($suid) ne 'all' || $suid =~ /\D/) {
                    742:        if ($suid =~ /\D/) {
                    743:                $self->last_error("Invalid suid '$suid'");
1.29      andrew    744:                return;
1.14      andrew    745:        }
                    746:
                    747:        return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
                    748: }
                    749:
                    750: =pod
                    751:
1.26      andrew    752: =item B<sudb_modify>
1.14      andrew    753:
1.26      andrew    754: Takes either the  suid of the su to change
1.14      andrew    755: as well as what you are changing, either "cir, mir or su2su"
                    756: and returns true on success or undef otherwise.
                    757:
                    758: cir and mir also take a value to set the cir/mir to.
                    759:
                    760: su2su takes a group id parameter that is in hex.
                    761:
1.26      andrew    762:   $t->sudb_modify($suid, 'cir', 512);
                    763:
1.14      andrew    764: You should save_sudb() after calling this, or your changes  will be lost
                    765: when the AP is rebooted.
                    766:
                    767: =cut
                    768:
                    769: sub sudb_modify
                    770: {
                    771:        my $self  = shift;
                    772:        my $suid  = shift;
                    773:        my $opt   = shift;
                    774:        my $value = shift;
                    775:
                    776:        if ($suid =~ /\D/) {
1.25      andrew    777:                $self->last_error("Invalid suid '$suid'");
1.29      andrew    778:                return;
1.14      andrew    779:        }
                    780:
                    781:        if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {
                    782:                if ($value =~ /\D/) {
1.25      andrew    783:                        $self->last_error("Invalid $opt '$value'");
1.29      andrew    784:                        return;
1.14      andrew    785:                }
                    786:        } elsif (lc($opt) eq 'su2su') {
                    787:                if ($value =~ /[^0-9A-Za-f]/) {
1.25      andrew    788:                        $self->last_error("Invalid MAC '$value'");
1.29      andrew    789:                        return;
1.14      andrew    790:                }
                    791:        } else {
1.25      andrew    792:                $self->last_error("Invalid option '$opt'");
1.29      andrew    793:                return;
1.14      andrew    794:        }
                    795:
                    796:        my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
                    797:
                    798:        return $self->cmd( String => $string, expect => $success );
                    799: }
                    800:
                    801: =pod
                    802:
1.26      andrew    803: =item B<enable_tftpd>
                    804:
                    805: - enable the TFTP server
1.14      andrew    806:
                    807: runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
                    808:
                    809: =cut
                    810:
                    811: sub enable_tftpd
                    812: {
                    813:   my $self = shift;
                    814:
                    815:   my $vals = $self->tftpd( args => 'on' );
                    816:
                    817:   if ($vals->{'Tftpd'} eq 'listen') {
                    818:     return $vals;
                    819:   } else {
1.29      andrew    820:     return;
1.14      andrew    821:   }
                    822: }
                    823:
                    824: =pod
                    825:
1.26      andrew    826: =item B<disable_tftpd>
                    827:
                    828: - disable the TFTP server
1.14      andrew    829:
                    830: runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
                    831:
                    832: =cut
                    833:
                    834: sub disable_tftpd
                    835: {
                    836:   my $self = shift;
                    837:
                    838:   my $vals = $self->tftpd( args => 'off' );
                    839:
                    840:   if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
                    841:     return $vals;
                    842:   } else {
1.29      andrew    843:     return;
1.14      andrew    844:   }
                    845: }
                    846:
                    847: =pod
                    848:
1.26      andrew    849: =item B<cmd>
                    850:
                    851: - runs a command on the AP.
1.14      andrew    852:
1.20      andrew    853: This does most of the work.  At the heart, it calls Net::Telnet::cmd()
                    854: but it also does some special stuff for Trango.
1.14      andrew    855:
                    856: Normally returns the last lines from from the command
                    857:
1.26      andrew    858: If you are using this, rather than one of the "easy" methods above,
                    859: you probably want to read through the source of this module to see how
                    860: some of the other commands are called.
                    861:
                    862: In addition to the Net::Telnet::cmd() options, it also accepts these:
1.14      andrew    863:
                    864: I<decode>
1.26      andrew    865:
1.20      andrew    866: - if this is true, then it will send the output lines to _decode_lines()
                    867: and then returns the decoded output
1.14      andrew    868:
1.26      andrew    869: I<no_prompt>
                    870:
                    871: - if this is true, it does not wait for a prompt, so you are not stuck
                    872: waiting for something that will never happen.
                    873:
1.14      andrew    874: I<cmd_disconnects>
1.26      andrew    875:
1.20      andrew    876: - if this is true, it then sets logged_in() to false, then it will
1.26      andrew    877: close() the connection and set is_connected() to false
1.14      andrew    878:
                    879: I<expect>
1.26      andrew    880:
1.20      andrew    881: - if this is set (usually to 'Success.') it will check for that in the
                    882: last line of output and if it does not, will return undef because the
                    883: command probably failed
1.14      andrew    884:
                    885: I<args>
1.26      andrew    886:
1.20      andrew    887: - a string containing the command line options that are passed to the
                    888: command
1.14      andrew    889:
1.26      andrew    890:        $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );
                    891:
1.14      andrew    892: =cut
                    893:
                    894: sub cmd
                    895: {
                    896:   my $self = shift;
                    897:
                    898:   my @valid_net_telnet_opts = qw(
                    899:     String
                    900:     Output
                    901:     Cmd_remove_mode
                    902:     Errmode
                    903:     Input_record_separator
                    904:     Ors
                    905:     Output_record_separator
                    906:     Prompt
                    907:     Rs
                    908:     Timeout
                    909:   );
                    910:
                    911:   my %cfg;
                    912:   if (@_ == 1) {
                    913:     $cfg{'String'} = shift;
                    914:   } elsif (@_ > 1) {
                    915:     %cfg = @_;
                    916:   }
                    917:
                    918:   $cfg{'Timeout'} ||= $self->Timeout;
                    919:
                    920:   unless ($cfg{'String'}) {
1.25      andrew    921:     $self->last_error("No command passed");
1.29      andrew    922:     return;
1.14      andrew    923:   }
                    924:
                    925:   unless ($self->is_connected) {
1.25      andrew    926:     $self->last_error("Not connected");
1.29      andrew    927:     return;
1.14      andrew    928:   }
                    929:
                    930:   unless ($self->logged_in) {
1.25      andrew    931:     $self->last_error("Not logged in");
1.29      andrew    932:     return;
1.14      andrew    933:   }
                    934:
                    935:
                    936:   my %cmd;
                    937:   foreach (@valid_net_telnet_opts) {
                    938:     if (exists $cfg{$_}) {
                    939:       $cmd{$_} = $cfg{$_};
                    940:     }
                    941:   }
                    942:   if ($cfg{'args'}) {
                    943:     $cmd{'String'} .= ' ' . $cfg{'args'};
                    944:   }
1.30    ! andrew    945:
1.14      andrew    946:   my @lines;
1.30    ! andrew    947:   if ($cfg{'no_prompt'}) {
1.14      andrew    948:     $self->print($cmd{'String'});
                    949:     @lines = $self->lastline;
1.30    ! andrew    950:   } else {
        !           951:     @lines = $self->SUPER::cmd(%cmd);
1.14      andrew    952:   }
                    953:
                    954:   $self->last_lines(\@lines);
                    955:
                    956:   my $vals = 1;
                    957:   if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
                    958:     if ($cfg{'decode'} eq 'each') {
                    959:       $vals = _decode_each_line(@lines);
                    960:     } elsif ($cfg{'decode'} eq 'sulog') {
                    961:       $vals = _decode_sulog(@lines);
                    962:     } elsif ($cfg{'decode'} eq 'maclist') {
                    963:       $vals = _decode_maclist(@lines);
                    964:     } else {
                    965:       $vals = _decode_lines(@lines);
                    966:     }
                    967:   }
                    968:
                    969:   $self->last_vals($vals);
                    970:
                    971:
                    972:   my $last = $self->lastline;
                    973:
                    974:   if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
                    975:     if ($cfg{'cmd_disconnects'}) {
                    976:       $self->logged_in(0);
                    977:       $self->close;
                    978:       $self->is_connected(0);
                    979:     }
                    980:
                    981:     if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
                    982:       return $vals;
                    983:     } else {
1.27      mike      984:       return \@lines;
1.14      andrew    985:     }
                    986:   } else {
1.25      andrew    987:     $self->last_error("Error with command ($cfg{'String'}): $last");
1.29      andrew    988:     return;
1.14      andrew    989:   }
                    990: }
                    991:
                    992: #=item _decode_lines
                    993:
                    994: sub _decode_lines
                    995: {
                    996:   my @lines = @_;
                    997:
                    998:   my %conf;
                    999:
                   1000:   my $key = '';
1.17      andrew   1001:   my $val = undef;
1.27      mike     1002:   my @vals;
1.14      andrew   1003:   my $in_key = 0;
1.17      andrew   1004:   my $in_val = 1;
1.14      andrew   1005:
                   1006:   foreach my $line (@lines) {
                   1007:     next if $line =~ /$success$/;
                   1008:
                   1009:     my @chars = split //, $line;
                   1010:
                   1011:     my $last_key = '';
                   1012:     foreach my $c (@chars) {
                   1013:
                   1014:       if ($c eq '[' || $c eq "\r" || $c eq "\n") {
                   1015:         if ($c eq '[') {
                   1016:           $in_key = 1;
                   1017:           $in_val = 0;
                   1018:         } else {
                   1019:           $in_key = 0;
1.17      andrew   1020:           $in_val = 1;
1.14      andrew   1021:         }
                   1022:
                   1023:         if ($key) {
                   1024:           $key =~ s/^\s+//;
                   1025:           $key =~ s/\s+$//;
                   1026:
1.27      mike     1027:           if ($val) {
1.17      andrew   1028:             $val =~ s/^\s+//;
                   1029:             $val =~ s/\s+$//;
                   1030:           }
1.14      andrew   1031:
                   1032:           if ($key eq 'Checksum' && $last_key) {
                   1033:             # Special case for these bastids.
                   1034:             my $new = $last_key;
                   1035:             $new =~ s/\s+\S+$//;
                   1036:             $key = $new . " " . $key;
                   1037:           }
                   1038:
1.27      mike     1039:           $conf{$key} = $val;
1.14      andrew   1040:           $last_key = $key;
                   1041:           $key = '';
1.27      mike     1042:         } elsif ($val) {
                   1043:                        push @vals, $val;
                   1044:                }
                   1045:         $val = '';
1.14      andrew   1046:
                   1047:       } elsif ($c eq ']') {
                   1048:         $in_val = 1;
                   1049:         $in_key = 0;
                   1050:         $c = shift @chars;
                   1051:
                   1052:       } elsif ($in_key) {
                   1053:         $key .= $c;
                   1054:
                   1055:       } elsif ($in_val) {
                   1056:         $val .= $c;
                   1057:       }
                   1058:     }
                   1059:   }
                   1060:
1.27      mike     1061:   unless ($key) {
                   1062:     push @vals, $val;
                   1063:   }
                   1064:
                   1065:   if (@vals == 1) {
                   1066:     $val = $vals[0];
                   1067:   } elsif (@vals) {
                   1068:     $val= \@vals;
                   1069:   } else {
                   1070:     $val = undef;
                   1071:   }
                   1072:
1.14      andrew   1073:   if (%conf) {
1.27      mike     1074:     $conf{_pre} = $val if $val;
1.14      andrew   1075:     return \%conf;
                   1076:   } else {
1.17      andrew   1077:     return $val;
1.14      andrew   1078:   }
                   1079: }
                   1080:
                   1081: #=item _decode_each_line
                   1082:
                   1083: sub _decode_each_line
                   1084: {
                   1085:   my @lines = @_;
                   1086:   my @decoded;
                   1087:   foreach my $line (@lines) {
                   1088:     my $decoded = _decode_lines($line);
                   1089:     push @decoded, $decoded if defined $decoded;
                   1090:   }
                   1091:   return \@decoded;
                   1092: }
                   1093:
                   1094: #=item _decode_sulog
                   1095:
                   1096: sub _decode_sulog
                   1097: {
                   1098:   my @lines = @_;
                   1099:   my @decoded;
                   1100:   my $last_tm;
                   1101:   foreach my $line (@lines) {
                   1102:     my $decoded = _decode_lines($line);
                   1103:
                   1104:     if (defined $decoded) {
                   1105:       if ($decoded->{'tm'}) {
                   1106:         $last_tm = $decoded->{'tm'};
                   1107:         next;
                   1108:       } else {
                   1109:         $decoded->{'tm'} = $last_tm;
                   1110:       }
                   1111:       next unless $last_tm;
                   1112:
                   1113:       push @decoded, $decoded if defined $decoded;
                   1114:     }
                   1115:   }
                   1116:   return \@decoded;
                   1117: }
                   1118:
                   1119: #=item _decode_maclist
                   1120:
                   1121: sub _decode_maclist
                   1122: {
                   1123:        my @lines = @_;
                   1124:        my @decoded;
                   1125:        my $total_entries = 0;
                   1126:        my $current_tm = 0;
                   1127:        foreach my $line (@lines) {
                   1128:                $line =~ s/\r?\n$//;
                   1129:                my ($mac, $loc, $tm) = $line =~ /
                   1130:                        ([0-9a-fA-F ]{17})\s+
                   1131:                        (.*)\s+
                   1132:                        tm\s+
                   1133:                        (\d+)
                   1134:                /x;
                   1135:
                   1136:                if ($mac) {
                   1137:                        $mac =~ s/\s+//g;
                   1138:                        $loc =~ s/^\s+//;
                   1139:                        $loc =~ s/\s+$//;
                   1140:
                   1141:                        my $suid = undef;
                   1142:                        if ($loc =~ /suid\s+=\s+(\d+)/) {
                   1143:                                $suid = $1;
                   1144:                                $loc = undef;
                   1145:                        }
                   1146:
                   1147:                        push @decoded, {
                   1148:                                mac  => $mac,
                   1149:                                loc  => $loc,
                   1150:                                tm   => $tm,
                   1151:                                suid => $suid,
                   1152:                        };
                   1153:                } elsif ($line =~ /(\d+)\s+entries/) {
                   1154:                        $total_entries = $1;
                   1155:                } elsif ($line =~ /current tm = (\d+)\s+sec/) {
                   1156:                        $current_tm = $1
                   1157:                }
                   1158:        }
1.15      andrew   1159:
                   1160:        map { $_->{'cur_tm'} = $current_tm } @decoded;
                   1161:
1.14      andrew   1162:        if (scalar @decoded == $total_entries) {
                   1163:                return \@decoded;
                   1164:        } else {
                   1165:                # XXX we should have a way to set last error, not sure why we don't
1.29      andrew   1166:                return;
1.14      andrew   1167:        }
                   1168: }
                   1169:
                   1170: 1;
                   1171: __END__
                   1172:
                   1173: =back
                   1174:
                   1175: =head1 SEE ALSO
                   1176:
1.26      andrew   1177: Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
1.14      andrew   1178:
                   1179: L<Net::Telnet>
                   1180:
                   1181: =head1 TODO
                   1182:
1.20      andrew   1183: There are still a lot of commands that are not accessed directly.  If
                   1184: you call them (as cmd("command + args") or whatever) and it works,
                   1185: please send me examples that work and I will try to get it incorporated
                   1186: into the next version of the script.
                   1187:
                   1188: I also want to be able to parse the different types of output from
                   1189: commands like su, sudb all and anything else that would be better
                   1190: available as a perl datastructure.
1.14      andrew   1191:
                   1192: =head1 AUTHOR
                   1193:
                   1194: Andrew Fresh E<lt>andrew@rraz.netE<gt>
                   1195:
                   1196: =head1 COPYRIGHT AND LICENSE
                   1197:
1.26      andrew   1198: Copyright (C) 2005,2006,2007 by Andrew Fresh
1.14      andrew   1199:
                   1200: This library is free software; you can redistribute it and/or modify
                   1201: it under the same terms as Perl itself, either Perl version 5.8.7 or,
                   1202: at your option, any later version of Perl 5 you may have available.
                   1203:
                   1204: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>