routerscript/ZXHN-H108L

   1 #!/usr/bin/env perl
   2
   3 use Switch;
   4 use Data::Dumper;
   5 use Getopt::Long qw/:config no_ignore_case bundling no_getopt_compat require_order/;
   6 use Pod::Usage;
   7 use IPC::Run qw/run/;
   8 use JSON;
   9
  10 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  11
  12
  13 $host = "gateway.localdomain";
  14 $user = '';
  15 $pass = '';
  16
  17 =pod
  18
  19 =head1 SYNOPSIS
  20
  21 ZXHN-H108L [-h I<HOST>] [-u I<USER>] [-P I<PASS>] I<COMMAND>
  22
  23 =head1 COMMANDS
  24
  25 =over 4
  26
  27 =item reboot
  28
  29 =item info [ip|gw|dns1|dns2|downlink|uplink]
  30
  31 =item log
  32
  33 =item pfwd
  34
  35 =item pfwd I<app_name> I<start_port>[-I<end_port>] I<dest_ip> [TCP|UDP|ALL]
  36
  37 =item pfwd --remove [--id I<num> | --name I<app_name> | --match-name I<pattern> | --port I<start_port>]
  38
  39 =back
  40
  41 =cut
  42
  43 GetOptions(
  44         'h|host=s' => \$host,
  45         'u|user=s' => \$user,
  46         'P|pass=s' => \$pass,
  47 ) or pod2usage(-exitval=>2, -verbose=>99);
  48
  49 if(not @ARGV)
  50 {
  51         pod2usage(-exitval=>2, -verbose=>99);
  52 }
  53
  54 sub dispatch;
  55
  56 sub dispatch
  57 {
  58         my $path = shift;
  59         my $param = shift;
  60         my @curl_args = map {('-d', $_.'='.$param->{$_})} keys %$param;
  61         my $resp;
  62         run ['curl', '-sS', '-u', "$user:$pass", "http://$host$path", '--connect-timeout', '4', '--max-time', '5', @curl_args, @_], \undef, \$resp;
  63         return $resp;
  64 }
  65
  66 sub fetch_pfwd
  67 {
  68         my $html = dispatch "/advanced/adv_nat_virsvr.htm";
  69         my $resp;
  70         run ['pup', 'table table td.tabdata:not([width]) json{}'], \$html, \$resp;
  71         return $resp;
  72 }
  73
  74 @pfwd_fields = qw/id label proto start_port end_port dest/;
  75
  76 sub pfwd_table
  77 {
  78         my $pfwd_table_json = fetch_pfwd();
  79         my $html_elements = decode_json $pfwd_table_json;
  80         my @pfwd_lines = map { $_->{'text'} } @$html_elements;
  81         my @pfwd = ();
  82         for my $line_num (0 .. $#pfwd_lines)
  83         {
  84                 my $line = $pfwd_lines[$line_num];
  85                 $line =~ s/^\s*//;
  86                 $line =~ s/\s*$//;
  87                 my $pfwd_row_num = int($line_num / 6);
  88                 my $pfwd_col_num = $line_num % 6;
  89                 $pfwd[$pfwd_row_num][$pfwd_col_num] = $line;
  90         }
  91         return @pfwd;
  92 }
  93
  94 sub pfwd_hashlist
  95 {
  96         my @pfwd = pfwd_table();
  97         my @pfwd = map { my $tr = $_; my $hr = {}; $hr->{$pfwd_fields[$_]} = $tr->[$_] for 0 .. $#pfwd_fields; $hr } @pfwd;
  98         return @pfwd;
  99 }
 100
 101 switch(shift @ARGV)
 102 {
 103         case "reboot"
 104         {
 105                 $resp = dispatch "/Forms/tools_system_1", {restoreFlag=>0}, "-L";
 106                 $resp =~ /The system is restarting. Please wait./;
 107                 print "$&\n";
 108         }
 109         case "log"
 110         {
 111                 $resp = dispatch "/status/syslog.log";
 112                 print $resp;
 113         }
 114         case "pfwd"
 115         {
 116                 my ($remove, $remove_id, $remove_name, $remove_name_pattern, $remove_start_port);
 117
 118                 GetOptions(
 119                         'remove' => \$remove,
 120                         'id=i' => \$remove_id,
 121                         'name=s' => \$remove_name,
 122                         'match-name=s' => \$remove_name_pattern,
 123                         'port=i' => \$remove_start_port,
 124                 )
 125                 or pod2usage(-exitval=>2, -verbose=>99);
 126
 127                 if($remove)
 128                 {
 129                         if(not defined $remove_id)
 130                         {
 131                                 my @pfwd = pfwd_hashlist();
 132                                 if(defined $remove_name)                        { ($remove_id) = map {$_->{'id'}} grep {$_->{'label'} eq $remove_name} @pfwd }
 133                                 elsif(defined $remove_name_pattern)     { ($remove_id) = map {$_->{'id'}} grep {$_->{'label'} =~ $remove_name_pattern} @pfwd }
 134                                 elsif(defined $remove_start_port)       { ($remove_id) = map {$_->{'id'}} grep {$_->{'start_port'} eq $remove_start_port} @pfwd }
 135                         }
 136
 137                         if(defined $remove_id)
 138                         {
 139                                 warn "Removing pfwd #$remove_id ...\n";
 140                                 dispatch "/Forms/adv_nat_virsvr_1", {VIRTUALSVR_index=>$remove_id, VIRTUALSVR_IndexFlag=>2};
 141                         }
 142                         else
 143                         {
 144                                 die "not found\n";
 145                         }
 146                 }
 147                 elsif(@ARGV)
 148                 {
 149                         my ($label, $portrange, $dest_ip, $proto) = @ARGV;
 150                         my ($start_port, $end_port);
 151                         if($portrange =~ /^(\d+)-(\d+)$/)
 152                         {
 153                                 $start_port = $1;
 154                                 $end_port = $2;
 155                         }
 156                         else
 157                         {
 158                                 pod2usage(-exitval=>2, -verbose=>99) unless $portrange =~ /^\d+$/;
 159                                 $start_port = $end_port = $portrange;
 160                         }
 161                         $proto = 'ALL' unless $proto;
 162                         $proto = uc $proto;
 163                         pod2usage(-exitval=>2, -verbose=>99) unless $proto ~~ ['TCP', 'UDP', 'ALL'];
 164
 165                         my @pfwd = pfwd_hashlist();
 166
 167                         my ($next_id) = map {$_->{'id'}} grep {$_->{'start_port'} eq 0} @pfwd;
 168                         die "no more slot\n" unless $next_id;
 169
 170                         warn "Adding pfwd #$next_id ...\n";
 171                         my $httpresp = dispatch "/Forms/adv_nat_virsvr_1", {
 172                                 VIRTUALSVR_index=>$next_id,
 173                                 VIRTUALSVR_IndexFlag=>0,
 174                                 VIRTUALSVR_Application=>$label,
 175                                 VIRTUALSVR_App_idx=>'-',
 176                                 VSProtocolIndex=>$proto,
 177                                 VIRTUALSVR_startPort=>$start_port,
 178                                 VIRTUALSVR_endPort=>$end_port,
 179                                 VIRTUALSVR_localIP=>$dest_ip,
 180                         }, '-i';
 181
 182                         if($httpresp =~ /^Location:.*error/m)
 183                         {
 184                                 warn "$&\n";
 185                                 exit 1;
 186                         }
 187                 }
 188                 else
 189                 {
 190                         my @pfwd = pfwd_table();
 191                         print join("\t", @pfwd_fields)."\n";
 192                         for my $row (@pfwd)
 193                         {
 194                                 print join("\t", @$row)."\n";
 195                         }
 196                 }
 197         }
 198         case "info"
 199         {
 200                 my $requested_info = shift @ARGV;
 201                 my %info;
 202                 my $html = dispatch "/status/status_deviceinfo.htm";
 203
 204                 if($html =~ /WAN.*?IP Address.*?\n\s*(?'ip'[^<\s]+).*Default Gateway.*?\n\s*(?'gw'[^<\s]+).*Primary DNS.*?\n\s*(?'dns1'[^<\s]+).*Secondary DNS.*?\n\s*(?'dns2'[^<\s]+).*Data Rate.*?\n\s*(?'downlink'[^<]+).*?\n\s*(?'uplink'[^<]+)/s)
 205                 {
 206                         $info{$_} = $+{$_} for keys %+;
 207                 }
 208
 209                 $info{'downlink'} = int $info{'downlink'};
 210                 $info{'uplink'} = int $info{'uplink'};
 211
 212                 if(defined $requested_info)
 213                 {
 214                         print $info{$requested_info}."\n";
 215                 }
 216                 else
 217                 {
 218                         my %unit = (qw{downlink kbit/s uplink kbit/s});
 219                         for my $k (qw/ip gw dns1 dns2 downlink uplink/)
 220                         {
 221                                 print "$k\t$info{$k}\t$unit{$k}\n";
 222                         }
 223                 }
 224         }
 225         else
 226         {
 227                 pod2usage(-exitval=>2, -verbose=>99);
 228         }
 229 }