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="ppp0";
  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=4*60;
  22 my $INPUT_IDLE=10*60;
  23
  24 $RX_THRESHOLD=$RX_THRESHOLD*$SECS/8;
  25 $TX_THRESHOLD=$TX_THRESHOLD*$SECS/8;
  26 $STABILIZE_OFF/=$SECS;
  27 $STABILIZE_ON /=$SECS;
  28 $|=1;
  29 my $ua=LWP::UserAgent->new();
  30 #$ua->timeout(60);
  31 #$ua->env_proxy();      # conflicts with 'https'
  32 push @{$ua->requests_redirectable()},"POST";    # probably not needed
  33 my $jar=HTTP::Cookies->new();
  34 $ua->cookie_jar($jar);  # important
  35
  36 sub simple($;$)
  37 {
  38 my($url,$content)=@_;
  39
  40         my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
  41         do { $request->content($_) if $_; } for $content;
  42         my $response=$ua->simple_request($request);
  43         die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
  44         return $response;
  45 }
  46
  47 sub _priv_postget($)
  48 {
  49 my($base)=@_;
  50
  51         my $full=$ENV{"HOME"}."/priv/postget.".$base;
  52         local *F;
  53         open F,$full or die "$full: $!";
  54         my $r=do { local $/; <F>; } or die "read \"$full\": $!";
  55         close F or die "close \"$full\": $!";
  56         chomp $r;
  57         return $r;
  58 }
  59
  60 sub login()
  61 {
  62         my $login=simple("https://uzivatel.gtsnovera.cz/cgi-bin/login.pl",
  63                         'login='.URI::Escape::uri_escape($USER).'&password='.URI::Escape::uri_escape($PASSWORD),
  64                         )->decoded_content() or die "login";
  65         $login=~m{<span class="textTitle1">\Q$USERNAME\E,</span>} or die $login."\nNo name found";
  66 }
  67
  68 my $on=-1;
  69 my($ignore_read,$ignore_write);
  70 sub change($)
  71 {
  72 my($new)=@_;
  73
  74         $new=($new ? 1 : 0);
  75         return if $on==$new;
  76         return if $ignore_read;
  77         my $try=0;
  78         my $change;
  79         do {
  80                 print "!" if $try;
  81                 die "Looping to login" if $try++>0x10;
  82                 login() if $try;
  83                 $change=simple("https://uzivatel.gtsnovera.cz/cgi-bin/fup.pl",
  84                                 'action.'.($new ? 'setManual' : 'unsetManual').'=1',
  85                                 )->decoded_content() or die "change: ".$new;
  86                 } while $change=~m{No authentication cookie was sent.};
  87         my $is_on =($change=~m{\bFUP active\b});
  88         my $is_off=($change=~m{\bFUP not active\b});
  89         $is_on==!$is_off or die $change."\nInvalid change state";
  90         $new==$is_on or die $change."\nChange not changed, wanted: ".$new;
  91         print "<$new>";
  92         $ignore_write=1;
  93         $on=$new;
  94 }
  95
  96 if (defined(my $change=$ARGV[0])) {
  97         print "OK: ";
  98         change($change);
  99         print "\n";
 100         exit 0;
 101         }
 102
 103 my($rx_last,$tx_last);
 104 change(0);
 105
 106 my @history;
 107 sub history($$)
 108 {
 109 my($what,$length)=@_;
 110
 111         return if $what==$on;
 112         my $idx=@history;
 113         while ($length-->0) {
 114                 return if --$idx<0;
 115                 return if $what!=$history[$idx];
 116                 }
 117         change($what);
 118 }
 119
 120 #           CPU0              CPU1
 121 #  1:     107040     111123        Phys-irq  i8042
 122 #  6:          3          0        Phys-irq  floppy
 123 sub input()
 124 {
 125         my $fname="/proc/interrupts";
 126         local *F;
 127         open F,$fname or die "open \"$fname\": $!";
 128         <F> or die "header \"$fname\"";;
 129         my $r=0;
 130         while (<F>) {
 131                 chomp;
 132                 my @f=split;
 133                 last if $f[0]=~/^[A-Z]{3}:$/;   # NMI/LOC/ERR/MIS
 134                 $f[0]=~/^\s*\d+:$/ or die $f[0];
 135                 next if $f[$#f] ne "i8042";
 136                 for (1..$#f-2) {
 137                         $_=$f[$_];
 138                         /^\d+$/ or die $_;
 139                         $r+=$_;
 140                         }
 141                 }
 142         close F or die "open \"$fname\": $!";
 143         return $r;
 144 }
 145
 146 my $input=input();
 147 my $input_last=time()+0;
 148 sub input_idle()
 149 {
 150         my $input_now=input();
 151         my $diff=$input_now-$input;
 152         die $diff if $diff<0;
 153         my $time_now=time()+0;
 154         if ($diff) {
 155                 $input=$input_now;
 156                 $input_last=$time_now;
 157                 }
 158         my $time_diff=$time_now-$input_last;
 159         return $time_diff>$INPUT_IDLE;
 160 }
 161
 162 sub mplayer_running()
 163 {
 164         local *F;
 165         open F,"/proc/net/unix" or die;
 166         my %unix;
 167         <F>;
 168         while (<F>) {
 169                 /^(?:\S+\s+){6}(\d+)\s/ or die;
 170                 $unix{$1}=1;
 171                 }
 172         close F or die;
 173
 174         local $_;
 175         while (</proc/*/exe>) {
 176                 (my $fdname=$_)=~s{/exe$}{/fd};
 177                 $_=readlink or next;
 178                 m{/mplayer$} or next;
 179                 while (<$fdname/*>) {
 180                         $_=readlink or next;
 181                         my $inode=/^\Qsocket:[\E(\d+)\Q]\E$/ or next;
 182                         return 1 if $unix{$1};
 183                         }
 184                 }
 185         return;
 186 }
 187
 188 for (;;) {
 189         local *F;
 190         open F,"/proc/net/dev" or die;
 191         my $dev=do { local $/; <F> or die; };
 192         close F or die;
 193         my($rx,$tx)=($dev=~/^\s*$IFDEV:\s*(\d+)(?:\s+\d+){7}\s+(\d+)\s/m) or die;
 194         my $on_now=1;
 195         if (defined $rx_last) {
 196 ###             print(($rx-$rx_last)."\t".($tx-$tx_last)."\n");
 197                 $on_now=0 if ($rx-$rx_last) > $RX_THRESHOLD;
 198                 $on_now=0 if ($tx-$tx_last) > $TX_THRESHOLD;
 199                 }
 200         my $input_idle=input_idle();
 201         my $mplayer_running=mplayer_running() if $input_idle;
 202         $on_now=1 if $input_idle && !$mplayer_running;
 203         $rx_last=$rx;
 204         $tx_last=$tx;
 205         push @history,$on_now;
 206         my $print=$on_now;
 207         $print=($on_now ? "." : "v") if $input_idle;
 208         $print="M" if $mplayer_running;
 209         $print="*" if $ignore_read;
 210         print($print);
 211         history(1,($input_idle && !$mplayer_running ? 0 : $STABILIZE_ON));
 212         history(0,$STABILIZE_OFF);
 213         $ignore_read=$ignore_write;
 214         $ignore_write=0;
 215         sleep $SECS;
 216         }