#! /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=210000;	# 226085
my $TX_THRESHOLD=210000;	# 291251
my $STABILIZE_OFF=1;
my $STABILIZE_ON=4*60;
my $INPUT_IDLE=10*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);
}

use User::Utmp;

# Users respected for the 'idle' state (see $IdleMax):
my @ValidUsers=qw(root lace jkratoch);

sub useridle()
{
	my %valid_users=map(($_=>1),@ValidUsers);
	my($idlebest,$linebest);
	for my $utmp (User::Utmp::getut()) {
		local $_;
		next if defined($_=$utmp->{"ut_type"}) && $_!=&User::Utmp::USER_PROCESS();
		next if defined($_=$utmp->{"ut_user"}) && !$valid_users{$_};
		my $line="/dev/".$utmp->{"ut_line"};
		my $atime=(stat $line)[8];
		my $what="user \"".($utmp->{"ut_user"} || "<local>")."\", line \"$line\"";
		warn "Unable to stat $what" and next if !$atime;
		my $idle=time()-$atime;
		warn "atime in future for $what" and next if $idle<0;
		next if defined $idlebest && $idlebest<=$idle;
		$idlebest=$idle;
		$linebest=$line;
		}
	return !wantarray() ? $idlebest : ($idlebest,$linebest);
}

sub input_idle()
{
	return useridle() > $INPUT_IDLE;
}

sub mplayer_running()
{
	local *F;
	open F,"/proc/net/unix" or die;
	my %unix;
	<F>;
	local $_;
	while (<F>) {
		/^(?:\S+\s+){6}(\d+)\s/ or die;
		$unix{$1}=1;
		}
	close F or die;

	local $_;
	while (</proc/*/exe>) {
		(my $fdname=$_)=~s{/exe$}{/fd};
		$_=readlink or next;
		m{/mplayer$} or next;
		while (<$fdname/*>) {
			$_=readlink or next;
			my $inode=/^\Qsocket:[\E(\d+)\Q]\E$/ or next;
			return 1 if $unix{$1};
			}
		}
	return;
}

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;
		}
	my $print=$on_now;
	my $input_idle=input_idle();
	my $mplayer_running=mplayer_running() if $input_idle;
	$on_now=1 if $input_idle && !$mplayer_running;
	$rx_last=$rx;
	$tx_last=$tx;
	push @history,$on_now;
	$print=($print ? "." : "v") if $input_idle;
	$print="M" if $mplayer_running;
	$print="*" if $ignore_read;
	print($print);
	history(1,(($input_idle && !$mplayer_running) ? 0 : $STABILIZE_ON));
	history(0,$STABILIZE_OFF);
	$ignore_read=$ignore_write;
	$ignore_write=0;
	sleep $SECS;
	}