lib/H1/ZTEMSAN.pm

   1 package H1::ZTEMSAN;
   2 use warnings;
   3 use strict;
   4
   5 use Net::Telnet;
   6 use Data::Dump qw(dump);
   7
   8 sub hash {
   9         my ( $self,$ip,$port ) = @_;
  10
  11         warn "# hash $ip $port";
  12
  13 my $t = Net::Telnet->new( Timeout => 20, Port => 1123, Prompt => '/#/' );
  14
  15 $t->dump_log('/tmp/log') if $ENV{DEBUG};
  16
  17 warn "open";
  18 $t->open( $ip );
  19
  20 $t->waitfor('/Login:/');
  21 $t->print('root');
  22 $t->waitfor('/Password:/');
  23 $t->print('root');
  24 #$t->waitfor('/>/');
  25 #$t->print('en');
  26 #$t->waitfor('/Please input password:/');
  27 #$t->print('admin');
  28 $t->waitfor('/#/');
  29
  30 warn "login OK";
  31
  32 sub command {
  33         my $command = shift;
  34
  35         warn "# command $command\n";
  36         $t->print($command);
  37
  38         my $out;
  39         while (1) {
  40                 warn "waitfor";
  41                 my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
  42                 $out .= $prematch;
  43                 last if $match eq '#';
  44 #               $t->put(" ");
  45                 $t->print('');
  46         }
  47
  48         warn "## out = [$out]";
  49
  50         my $hash;
  51         my $section = '';
  52         my $last_line;
  53         foreach my $line ( split(/[\n\r]+/, $out) ) {
  54                 warn "# $line\n";
  55                 if ( $line =~ m/^(\S+.*?)\s+:+\s+(\S+.*?)\s*$/ ) {
  56                         my ($n,$v) = ($1,$2);
  57                         $n =~ s/\(.+\)//;
  58                         if ( $v =~ s/\s+(\S+)\s*:\s+(\S+.+)// ) {
  59                                 # strip second column
  60                                 my ($n2,$v2) = ($1,$2);
  61                                 $n2 =~ s/\(.+\)//;
  62                                 $hash->{ $section . $n2 } = $2;
  63                         }
  64                         $hash->{ $section . $n } = $v;
  65                         warn "## $n = $v\n";
  66                 } elsif ( $line =~ m/^-+$/ ) {
  67                         $section = $last_line . '.'
  68                 }
  69                 $last_line = $line;
  70         }
  71
  72         warn "## hash = ",dump $hash;
  73
  74         if ( $ENV{DEBUG} ) {
  75                 my $path = $command;
  76                 $path =~ s{\W+}{_}g;
  77                 $path = "/tmp/dump.$path";
  78                 open( my $fh, '>', $path ) || die "$path: $!";
  79                 print $fh $out;
  80                 close $fh;
  81                 warn "DEBUG ",$path, " ", -s $path, " bytes\n";
  82         }
  83
  84         return $hash;
  85 }
  86
  87 our ( $row, $hash );
  88
  89 sub copy {
  90         my @what = @_ ? @_ : keys %$hash;
  91         foreach my $name (@what) {
  92                 warn "# copy $name ", dump( $hash->{$name} ),$/;
  93                 $row->{$name} = $hash->{$name};
  94         }
  95 }
  96
  97 $hash = command "show adsl port $port";
  98 copy;
  99
 100 $hash = command "show adsl port $port line-config";
 101 copy;
 102
 103 # FIXME very slow to query
 104 #$hash = command "show adsl port $port physical-table";
 105 #copy;
 106
 107 warn "# row = ",dump $row;
 108
 109 warn "logout";
 110 $t->print('logout');
 111
 112 return $row;
 113
 114 } # sub
 115 1;
 116