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=200000; # 226085
19 my $TX_THRESHOLD=200000; # 291251
24 my $ua=LWP::UserAgent->new();
26 #$ua->env_proxy(); # conflicts with 'https'
27 push @{$ua->requests_redirectable()},"POST"; # probably not needed
28 my $jar=HTTP::Cookies->new();
29 $ua->cookie_jar($jar); # important
35 my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
36 do { $request->content($_) if $_; } for $content;
37 my $response=$ua->simple_request($request);
38 die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
46 my $full=$ENV{"HOME"}."/priv/postget.".$base;
48 open F,$full or die "$full: $!";
49 my $r=do { local $/; <F>; } or die "read \"$full\": $!";
50 close F or die "close \"$full\": $!";
57 my $login=simple("https://uzivatel.gtsnovera.cz/cgi-bin/login.pl",
58 'login='.URI::Escape::uri_escape($USER).'&password='.URI::Escape::uri_escape($PASSWORD),
59 )->decoded_content() or die "login";
60 $login=~m{<span class="textTitle1">\Q$USERNAME\E,</span>} or die $login."\nNo name found";
72 die "Looping to login" if $try++>0x10;
74 $change=simple("https://uzivatel.gtsnovera.cz/cgi-bin/fup.pl",
75 'action.'.($on ? 'setManual' : 'unsetManual').'=1',
76 )->decoded_content() or die "change: ".$on;
77 } while $change=~m{No authentication cookie was sent.};
78 my $is_on =($change=~m{\bFUP active\b});
79 my $is_off=($change=~m{\bFUP not active\b});
80 $is_on==!$is_off or die $change."\nInvalid change state";
81 $on==$is_on or die $change."\nChange not changed, wanted: ".$on;
86 if (defined(my $change=$ARGV[0])) {
93 my($rx_last,$tx_last);
100 my($what,$length)=@_;
103 while ($length-->0) {
105 return if $what!=$history[$idx];
112 open F,"/proc/net/dev" or die;
113 my $dev=do { local $/; <F> or die; };
115 my($rx,$tx)=($dev=~/^\s*$IFDEV:\s*(\d+)(?:\s+\d+){7}\s+(\d+)\s/m) or die;
117 if (defined $rx_last) {
118 ### print(($rx-$rx_last)."\t".($tx-$tx_last)."\n");
119 $on_now=0 if ($rx-$rx_last) > $RX_THRESHOLD;
120 $on_now=0 if ($tx-$tx_last) > $TX_THRESHOLD;
124 push @history,$on_now;
126 $on=change(1) if $on==0 && history(1,$STABILIZE_ON);
127 $on=change(0) if $on==1 && history(0,$STABILIZE_OFF);