#! /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=4;
my $RX_THRESHOLD=200000;	# 226085
my $TX_THRESHOLD=200000;	# 291251
my $STABILIZE_OFF=1;
my $STABILIZE_ON=5*60;

$RX_THRESHOLD=$RX_THRESHOLD*$SECS/8;
$TX_THRESHOLD=$TX_THRESHOLD*$SECS/8;
$STABILIZE_OFF/=$SECS;
$STABILIZE_ON /=$SECS;
$|=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";
}

my $on=-1;
my($ignore_read,$ignore_write);
sub change($)
{
my($new)=@_;

	$new=($new ? 1 : 0);
	return if $on==$new;
	return if $ignore_read;
	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.'.($new ? 'setManual' : 'unsetManual').'=1',
				)->decoded_content() or die "change: ".$new;
		} 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";
	$new==$is_on or die $change."\nChange not changed, wanted: ".$new;
	print "<$new>";
	$ignore_write=1;
	$on=$new;
}

if (defined(my $change=$ARGV[0])) {
	print "OK: ";
	change($change);
	print "\n";
	exit 0;
	}

my($rx_last,$tx_last);
change(0);

my @history;
sub history($$)
{
my($what,$length)=@_;

	return if $what==$on;
	my $idx=@history;
	while ($length-->0) {
		return if --$idx<0;
		return if $what!=$history[$idx];
		}
	change($what);
}

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(($ignore_read ? "_" : $on_now));
	history(1,$STABILIZE_ON);
	history(0,$STABILIZE_OFF);
	$ignore_read=$ignore_write;
	$ignore_write=0;
	sleep $SECS;
	}