GTS AutoFUP.

diff --git a/bin/fup b/bin/fup
new file mode 100755 (executable)
index 0000000..fbd129c
--- /dev/null
+++ b/bin/fup
@@ -0,0 +1,124 @@
+#! /usr/bin/perl
+#
+# $Id$
+
+
+use strict;
+use warnings;
+require LWP::UserAgent;
+require HTTP::Cookies;
+require URI::Escape;
+use Data::Dumper;
+
+my $USER="adsl_303141";
+my $USERNAME="Jan Kratochvil";
+my $PASSWORD=&_priv_postget("uzivatel.gtsnovera.cz.pwd");
+my $IFDEV="eth0";
+my $SECS=8;
+my $RX_THRESHOLD=200000;       # 226085
+my $TX_THRESHOLD=200000;       # 291251
+my $STABILIZE_OFF=2;
+my $STABILIZE_ON=10;
+
+$|=1;
+my $ua=LWP::UserAgent->new();
+#$ua->timeout(60);
+#$ua->env_proxy();     # conflicts with 'https'
+push @{$ua->requests_redirectable()},"POST";   # probably not needed
+my $jar=HTTP::Cookies->new();
+$ua->cookie_jar($jar); # important
+
+sub simple($;$)
+{
+my($url,$content)=@_;
+
+       my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
+       do { $request->content($_) if $_; } for $content;
+       my $response=$ua->simple_request($request);
+       die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
+       return $response;
+}
+
+sub _priv_postget($)
+{
+my($base)=@_;
+
+       my $full=$ENV{"HOME"}."/priv/postget.".$base;
+       local *F;
+       open F,$full or die "$full: $!";
+       my $r=do { local $/; <F>; } or die "read \"$full\": $!";
+       close F or die "close \"$full\": $!";
+       chomp $r;
+       return $r;
+}
+
+sub login()
+{
+       my $login=simple("https://uzivatel.gtsnovera.cz/cgi-bin/login.pl",
+                       'login='.URI::Escape::uri_escape($USER).'&password='.URI::Escape::uri_escape($PASSWORD),
+                       )->decoded_content() or die "login";
+       $login=~m{<span class="textTitle1">\Q$USERNAME\E,</span>} or die $login."\nNo name found";
+}
+
+sub change($)
+{
+my($on)=@_;
+
+       $on=($on ? 1 : 0);
+       login();
+       my $change=simple("https://uzivatel.gtsnovera.cz/cgi-bin/fup.pl",
+                       'action.'.($on ? 'setManual' : 'unsetManual').'=1',
+                       )->decoded_content() or die "change: ".$on;
+       my $is_on =($change=~m{\bFUP active\b});
+       my $is_off=($change=~m{\bFUP not active\b});
+       $is_on==!$is_off or die $change."\nInvalid change state";
+       $on==$is_on or die $change."\nChange not changed, wanted: ".$on;
+       print "<$on>";
+       return $on;
+}
+
+if (defined(my $change=$ARGV[0])) {
+       print "OK: ";
+       change($change);
+       print "\n";
+       exit 0;
+       }
+
+my($rx_last,$tx_last);
+my $on=0;
+change($on);
+
+my @history;
+sub history($$)
+{
+my($what,$length)=@_;
+
+       my $idx=@history;
+       while ($length-->0) {
+               return if --$idx<0;
+               return if $what!=$history[$idx];
+               }
+       return 1;
+}
+
+for (;;) {
+       local *F;
+       open F,"/proc/net/dev" or die;
+       my $dev=do { local $/; <F> or die; };
+       close F or die;
+       my($rx,$tx)=($dev=~/^\s*$IFDEV:\s*(\d+)(?:\s+\d+){7}\s+(\d+)\s/m) or die;
+       my $on_now=1;
+       if (defined $rx_last) {
+###            print(($rx-$rx_last)."\t".($tx-$tx_last)."\n");
+               $on_now=0 if ($rx-$rx_last) > $RX_THRESHOLD;
+               $on_now=0 if ($tx-$tx_last) > $TX_THRESHOLD;
+               }
+       $rx_last=$rx;
+       $tx_last=$tx;
+       push @history,$on_now;
+       print $on_now;
+       my $stable;
+       $on=change(1) if $on==0 && history(1,$STABILIZE_ON);
+       $on=change(0) if $on==1 && history(0,$STABILIZE_OFF);
+       sleep $SECS;
+       }