bin/fup

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4
   5
   6 use strict;
   7 use warnings;
   8 require LWP::UserAgent;
   9 require HTTP::Cookies;
  10 require URI::Escape;
  11 use Data::Dumper;
  12
  13 my $USER="adsl_303141";
  14 my $USERNAME="Jan Kratochvil";
  15 my $PASSWORD=&_priv_postget("uzivatel.gtsnovera.cz.pwd");
  16 my $IFDEV="eth0";
  17 my $SECS=4;
  18 my $RX_THRESHOLD=200000;        # 226085
  19 my $TX_THRESHOLD=200000;        # 291251
  20 my $STABILIZE_OFF=1;
  21 my $STABILIZE_ON=5*60;
  22
  23 $RX_THRESHOLD=$RX_THRESHOLD*$SECS/8;
  24 $TX_THRESHOLD=$TX_THRESHOLD*$SECS/8;
  25 $STABILIZE_OFF/=$SECS;
  26 $STABILIZE_ON /=$SECS;
  27 $|=1;
  28 my $ua=LWP::UserAgent->new();
  29 #$ua->timeout(60);
  30 #$ua->env_proxy();      # conflicts with 'https'
  31 push @{$ua->requests_redirectable()},"POST";    # probably not needed
  32 my $jar=HTTP::Cookies->new();
  33 $ua->cookie_jar($jar);  # important
  34
  35 sub simple($;$)
  36 {
  37 my($url,$content)=@_;
  38
  39         my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
  40         do { $request->content($_) if $_; } for $content;
  41         my $response=$ua->simple_request($request);
  42         die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
  43         return $response;
  44 }
  45
  46 sub _priv_postget($)
  47 {
  48 my($base)=@_;
  49
  50         my $full=$ENV{"HOME"}."/priv/postget.".$base;
  51         local *F;
  52         open F,$full or die "$full: $!";
  53         my $r=do { local $/; <F>; } or die "read \"$full\": $!";
  54         close F or die "close \"$full\": $!";
  55         chomp $r;
  56         return $r;
  57 }
  58
  59 sub login()
  60 {
  61         my $login=simple("https://uzivatel.gtsnovera.cz/cgi-bin/login.pl",
  62                         'login='.URI::Escape::uri_escape($USER).'&password='.URI::Escape::uri_escape($PASSWORD),
  63                         )->decoded_content() or die "login";
  64         $login=~m{<span class="textTitle1">\Q$USERNAME\E,</span>} or die $login."\nNo name found";
  65 }
  66
  67 my $on=-1;
  68 my($ignore_read,$ignore_write);
  69 sub change($)
  70 {
  71 my($new)=@_;
  72
  73         $new=($new ? 1 : 0);
  74         return if $on==$new;
  75         return if $ignore_read;
  76         my $try=0;
  77         my $change;
  78         do {
  79                 print "!" if $try;
  80                 die "Looping to login" if $try++>0x10;
  81                 login() if $try;
  82                 $change=simple("https://uzivatel.gtsnovera.cz/cgi-bin/fup.pl",
  83                                 'action.'.($new ? 'setManual' : 'unsetManual').'=1',
  84                                 )->decoded_content() or die "change: ".$new;
  85                 } while $change=~m{No authentication cookie was sent.};
  86         my $is_on =($change=~m{\bFUP active\b});
  87         my $is_off=($change=~m{\bFUP not active\b});
  88         $is_on==!$is_off or die $change."\nInvalid change state";
  89         $new==$is_on or die $change."\nChange not changed, wanted: ".$new;
  90         print "<$new>";
  91         $ignore_write=1;
  92         $on=$new;
  93 }
  94
  95 if (defined(my $change=$ARGV[0])) {
  96         print "OK: ";
  97         change($change);
  98         print "\n";
  99         exit 0;
 100         }
 101
 102 my($rx_last,$tx_last);
 103 change(0);
 104
 105 my @history;
 106 sub history($$)
 107 {
 108 my($what,$length)=@_;
 109
 110         return if $what==$on;
 111         my $idx=@history;
 112         while ($length-->0) {
 113                 return if --$idx<0;
 114                 return if $what!=$history[$idx];
 115                 }
 116         change($what);
 117 }
 118
 119 for (;;) {
 120         local *F;
 121         open F,"/proc/net/dev" or die;
 122         my $dev=do { local $/; <F> or die; };
 123         close F or die;
 124         my($rx,$tx)=($dev=~/^\s*$IFDEV:\s*(\d+)(?:\s+\d+){7}\s+(\d+)\s/m) or die;
 125         my $on_now=1;
 126         if (defined $rx_last) {
 127 ###             print(($rx-$rx_last)."\t".($tx-$tx_last)."\n");
 128                 $on_now=0 if ($rx-$rx_last) > $RX_THRESHOLD;
 129                 $on_now=0 if ($tx-$tx_last) > $TX_THRESHOLD;
 130                 }
 131         $rx_last=$rx;
 132         $tx_last=$tx;
 133         push @history,$on_now;
 134         print(($ignore_read ? "_" : $on_now));
 135         history(1,$STABILIZE_ON);
 136         history(0,$STABILIZE_OFF);
 137         $ignore_read=$ignore_write;
 138         $ignore_write=0;
 139         sleep $SECS;
 140         }