#! /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);
	my $try=0;
	my $change;
	do {
		print "!" if $try;
		die "Looping to login" if $try++>0x10;
		login() if $try;
		$change=simple("https://uzivatel.gtsnovera.cz/cgi-bin/fup.pl",
				'action.'.($on ? 'setManual' : 'unsetManual').'=1',
				)->decoded_content() or die "change: ".$on;
		} while $change=~m{No authentication cookie was sent.};
	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;
	$on=change(1) if $on==0 && history(1,$STABILIZE_ON);
	$on=change(0) if $on==1 && history(0,$STABILIZE_OFF);
	sleep $SECS;
	}