8 require LWP::UserAgent;
13 my $USER="adsl_303141";
14 my $USERNAME="Jan Kratochvil";
15 my $PASSWORD=&_priv_postget("uzivatel.gtsnovera.cz.pwd");
18 my $RX_THRESHOLD=210000; # 226085
19 my $TX_THRESHOLD=210000; # 291251
21 my $STABILIZE_ON=4*60;
24 $RX_THRESHOLD=$RX_THRESHOLD*$SECS/8;
25 $TX_THRESHOLD=$TX_THRESHOLD*$SECS/8;
26 $STABILIZE_OFF/=$SECS;
27 $STABILIZE_ON /=$SECS;
29 my $ua=LWP::UserAgent->new();
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
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());
51 my $full=$ENV{"HOME"}."/priv/postget.".$base;
53 open F,$full or die "$full: $!";
54 my $r=do { local $/; <F>; } or die "read \"$full\": $!";
55 close F or die "close \"$full\": $!";
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";
69 my($ignore_read,$ignore_write);
76 return if $ignore_read;
81 die "Looping to login" if $try++>0x10;
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;
96 if (defined(my $change=$ARGV[0])) {
103 my($rx_last,$tx_last);
109 my($what,$length)=@_;
111 return if $what==$on;
113 while ($length-->0) {
115 return if $what!=$history[$idx];
122 # Users respected for the 'idle' state (see $IdleMax):
123 my @ValidUsers=qw(root lace jkratoch);
127 my %valid_users=map(($_=>1),@ValidUsers);
128 my($idlebest,$linebest);
129 for my $utmp (User::Utmp::getut()) {
131 next if defined($_=$utmp->{"ut_type"}) && $_!=&User::Utmp::USER_PROCESS();
132 next if defined($_=$utmp->{"ut_user"}) && !$valid_users{$_};
133 my $line="/dev/".$utmp->{"ut_line"};
134 my $atime=(stat $line)[8];
135 my $what="user \"".($utmp->{"ut_user"} || "<local>")."\", line \"$line\"";
136 warn "Unable to stat $what" and next if !$atime;
137 my $idle=time()-$atime;
138 warn "atime in future for $what" and next if $idle<0;
139 next if defined $idlebest && $idlebest<=$idle;
143 return !wantarray() ? $idlebest : ($idlebest,$linebest);
148 return useridle() > $INPUT_IDLE;
151 sub mplayer_running()
154 open F,"/proc/net/unix" or die;
159 /^(?:\S+\s+){6}(\d+)\s/ or die;
165 while (</proc/*/exe>) {
166 (my $fdname=$_)=~s{/exe$}{/fd};
168 m{/mplayer$} or next;
169 while (<$fdname/*>) {
171 my $inode=/^\Qsocket:[\E(\d+)\Q]\E$/ or next;
172 return 1 if $unix{$1};
180 open F,"/proc/net/dev" or die;
181 my $dev=do { local $/; <F> or die; };
183 my($rx,$tx)=($dev=~/^\s*$IFDEV:\s*(\d+)(?:\s+\d+){7}\s+(\d+)\s/m) or die;
185 if (defined $rx_last) {
186 ### print(($rx-$rx_last)."\t".($tx-$tx_last)."\n");
187 $on_now=0 if ($rx-$rx_last) > $RX_THRESHOLD;
188 $on_now=0 if ($tx-$tx_last) > $TX_THRESHOLD;
191 my $input_idle=input_idle();
192 my $mplayer_running=mplayer_running() if $input_idle;
193 $on_now=1 if $input_idle && !$mplayer_running;
196 push @history,$on_now;
197 $print=($print ? "." : "v") if $input_idle;
198 $print="M" if $mplayer_running;
199 $print="*" if $ignore_read;
201 history(1,(($input_idle && !$mplayer_running) ? 0 : $STABILIZE_ON));
202 history(0,$STABILIZE_OFF);
203 $ignore_read=$ignore_write;