Powered by ViewCVS 1.0-dev
I'll leave them alone now...
#!/usr/bin/perl -w
use HTML::Entities;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use vars qw($hostname %operations $linkmode $linkname $linkstate);
$hostname = 'toy'; # as found in syslog
# %operations : key=operation-name, value="string with [anchor] text:href"
if (-p '/var/run/diald.fifo') {
$linkmode = 'diald';
%operations = (block => '[Block] link:diald-control.pl?block',
unblock => '[Unblock] link:diald-control.pl?unblock',
up => '[Activate] link:diald-control.pl?up',
down => '[Deactivate] link:diald-control.pl?down',
);
# @todo read link name, device & state from diald
$linkname = "Diald link";
$linkstate = islinkup("ppp0");
} elsif ($linkmode eq 'pon') {
$linkmode = 'pon';
%operations = (up => '[Activate] link:ponpoff-control.pl?up',
down => '[Deactivate] link:ponpoff-control.pl?down',
);
$linkname = "Modem"; # @todo: read link named from diald, if available
$linkstate = islinkup("ppp0");
}
sub islinkup{
my $dev = shift;
my $ifconfig = `/sbin/ifconfig $dev | grep UP 2>/dev/null`;
return ($ifconfig ? 1 : 0);
}
my ($state, $col);
if ($linkstate){
$state = "UP";
$col = "009944";
}else{
$state = "DOWN";
$col = "990044";
}
$| = 1; # autoflush is your friend
my $now = scalar localtime;
my $qry = $ENV{'QUERY_STRING'} ? "?$ENV{'QUERY_STRING'}" : "";
my $self = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
my $rtime = ($linkstate ? 10 : 60);
my $refresh = ($rtime ?
('<META HTTP-EQUIV="refresh" CONTENT="'.
"$rtime;URL=$self$qry\">") : ""
);
my $refr_descr = $rtime ? "will refresh in $rtime seconds" : "not refreshing";
# hide pointless operations
delete @operations{$linkstate ? qw(up unblock) : qw(down) };
my $ops = dump_operations(1);
print <<EOT;
content-type: text/html
pragma: no-cache
<HTML>
<HEAD>
$refresh
<TITLE>[$state] $linkname is $state</TITLE>
</HEAD>
<BODY BGCOLOR="#ffffff" FGCOLOR="#000000">
<table width="100%" cellspacing="0" cellpadding="2" bgcolor="black" border="0">
<tr><td>
<table border="0" cellpadding="8" cellspacing="0" width="100%" bgcolor="#$col">
<tr>
<td align=left> <h1>$linkname</h1> </td>
<td align=center valign="top"> $ops </td>
<td align=right> <h1>STATE: $state</h1> </td>
</tr>
</table>
<table border="0" cellpadding="0" cellspacing="0" width="100%" bgcolor="#009999">
<tr>
<td align="center">Status at $now</td>
<td align="center"><small>$refr_descr</small></td>
</tr>
</table>
</td></tr>
</table>
<p>
EOT
print dump_operations(0);
dump_connections() if $linkstate;
if ($ENV{'QUERY_STRING'} =~ /detail/) {
my $logtail = `(tail -100 /var/log/messages | grep -E '$hostname (chat|pppd)\\[') 2>&1`;
$logtail = '[nothing found]' unless $logtail =~ /\S/;
HTML::Entities::encode($logtail);
print "<p>Recent modem status information:
<small><a href=\"$self\">no detail</a></small>
<pre>$logtail</pre>"
if $logtail =~ /\S/;
} else {
# print join "<li>", "", map { "$_ => $ENV{$_}" } sort keys %ENV;
print "<p>Gory details about the modem connection are <a href=\"$self?detail\">available here</a> if you need them\n";
}
print <<EOT;
</body>
</html>
EOT
sub dump_operations { # arg = small-flag
my $small = shift;
my $out = '';
foreach my $k (sort keys %operations) {
my ($txt, $href) = $operations{$k} =~ /^(.*?):(.*)/;
die "Broken operation definition for $k" unless defined $href;
if ($small) {
$txt =~ s:.*\[:<a href="$href">:;
$txt =~ s:\].*:</a>:;
$out .= " | " if $out;
$out .= $txt;
} else {
$txt =~ s:\[:<a href="$href">:;
$txt =~ s:\]:</a>:;
$out .= "$txt<br>\n";
}
}
return $out;
}
sub dump_connections {
my $connections = `/bin/netstat -n`;
die "Can't get current connection list: $!" if $?;
my @tcp = ();
foreach (split "\n", $connections) {
if ( /^tcp.*\s+(\d+\.\d+\.\d+\.\d+):(\S+).*\s+(\d+\.\d+\.\d+\.\d+):(\S+)\s+ESTABLISHED/) {
my ($from, $fromP, $to, $toP) = ($1, $2, $3, $4);
foreach ($fromP, $toP) {
next if $_ > 1024;
my $serv = getservbyport($_, "tcp");
next if !defined $serv || $serv eq $_;
$_ = '<font color="black">'.uc($serv).'</font>';
my $map = { pop3 => 'Incoming mail check',
smtp => 'Outgoing mail',
www => 'Web page or download' };
$_ .= " <small>$$map{$serv}</small>" if $map->{$serv};
}
my $local = 0;
foreach ($from, $to) { $local++ if /^10\.0\./ or /^127\.0\.0\./ }
push @tcp, "$from:$fromP to $to:$toP" unless $local == 2;
}
}
if (@tcp) {
print "<p><font color=red><strong>Current active connections:</strong>
<p><li>\n".(join "\n<li>", @tcp)."\n</ul></font>\n";
}
}
|
Repository owner Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |