[people/pmueller/ipfire-2.x.git] / html / cgi-bin / index.cgi

#!/usr/bin/perl\r
#\r
# SmoothWall CGIs\r
#\r
# This code is distributed under the terms of the GPL\r
#\r
# (c) The SmoothWall Team\r
#\r
# $Id: index.cgi,v 1.15.2.18 2005/09/17 13:51:47 gespinasse Exp $\r
#\r
\r
use strict;\r
\r
# enable only the following on debugging purpose\r
#use warnings;\r
#use CGI::Carp 'fatalsToBrowser';\r
\r
require 'CONFIG_ROOT/general-functions.pl';\r
require "${General::swroot}/lang.pl";\r
require "${General::swroot}/header.pl";\r
\r
my %cgiparams=();\r
my %pppsettings=();\r
my %modemsettings=();\r
my %netsettings=();\r
my %ddnssettings=();\r
my $warnmessage = '';\r
my $refresh = '';\r
\r
&Header::showhttpheaders();\r
\r
$cgiparams{'ACTION'} = '';\r
&Header::getcgihash(\%cgiparams);\r
$pppsettings{'VALID'} = '';\r
$pppsettings{'PROFILENAME'} = 'None';\r
&General::readhash("${General::swroot}/ppp/settings", \%pppsettings);\r
&General::readhash("${General::swroot}/modem/settings", \%modemsettings);\r
&General::readhash("${General::swroot}/ethernet/settings", \%netsettings);\r
&General::readhash("${General::swroot}/ddns/settings", \%ddnssettings);\r
\r
my $connstate = &Header::connectionstatus();\r
if ($connstate =~ /$Lang::tr{'dod waiting'}/ || -e "${General::swroot}/main/refreshindex") {\r
	$refresh = "<meta http-equiv='refresh' content='30;'>";\r
} elsif ($connstate =~ /$Lang::tr{'connecting'}/) {\r
	$refresh = "<meta http-equiv='refresh' content='5;'>";\r
}\r
\r
&Header::openpage($Lang::tr{'main page'}, 1, $refresh);\r
&Header::openbigbox('', 'center');\r
&Header::openbox('100%', 'center', &Header::cleanhtml(`/bin/uname -n`,"y"));\r
\r
# hide buttons only when pppsettings mandatory used and not valid\r
if ( ( $pppsettings{'VALID'} eq 'yes' ) ||\r
		( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {\r
	print <<END\r
	<table border='0'>\r
	<tr>\r
		<td align='center'><form method='post' action='/cgi-bin/dial.cgi'>\r
			<input type='submit' name='ACTION' value='$Lang::tr{'dial'}' />\r
		</form></td>\r
		<td>&nbsp;&nbsp;</td>\r
		<td align='center'><form method='post' action='/cgi-bin/dial.cgi'>\r
			<input type='submit' name='ACTION' value='$Lang::tr{'hangup'}' />\r
		</form></td>\r
		<td>&nbsp;&nbsp;</td>\r
		<td align='center'><form method='post' action="$ENV{'SCRIPT_NAME'}">\r
			<input type='submit' name='ACTION' value='$Lang::tr{'refresh'}' />\r
		</form></td>\r
	</tr></table>\r
END\r
	;\r
}\r
\r
print "<font face='Helvetica' size='4'><b>";\r
if ( !( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {\r
	print "<u>$Lang::tr{'current profile'} $pppsettings{'PROFILENAME'}</u><br />\n";\r
}\r
	\r
if ( ( $pppsettings{'VALID'} eq 'yes'&& $modemsettings{'VALID'} eq 'yes' ) ||\r
		( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ )) {\r
	print $connstate;\r
	print "</b></font>\n";\r
	if ($connstate =~ /$Lang::tr{'connected'}/) {\r
	    my $fetch_ip='nothing';\r
	    if ($ddnssettings{'BEHINDROUTER'} eq 'FETCH_IP') {\r
	        if (open(IPADDR,"${General::swroot}/ddns/ipcache")) {\r
	   	    $fetch_ip = <IPADDR>;\r
	    	    close IPADDR;\r
	    	    chomp ($fetch_ip);\r
	    	    my $host_name = (gethostbyaddr(pack("C4", split(/\./, $fetch_ip)), 2))[0];\r
	    	    print "<br />$Lang::tr{'ip address'} (internet): $fetch_ip <br /> $Lang::tr{'ipcops hostname'} (internet): $host_name <br />";\r
		}\r
	    }\r
	    if (open(IPADDR,"${General::swroot}/red/local-ipaddress")) {\r
	   	my $ipaddr = <IPADDR>;\r
	    	close IPADDR;\r
	    	chomp ($ipaddr);\r
		if ($ipaddr ne $fetch_ip){	#do not show info twice\r
	    	    my $host_name = (gethostbyaddr(pack("C4", split(/\./, $ipaddr)), 2))[0];\r
	    	    print "<br />$Lang::tr{'ip address'}: $ipaddr <br /> $Lang::tr{'ipcops hostname'}: $host_name <br />";\r
		}\r
	    }\r
        }\r
\r
} elsif ($modemsettings{'VALID'} eq 'no') {\r
	print "$Lang::tr{'modem settings have errors'}\n </b></font>\n";\r
} else {\r
	print "$Lang::tr{'profile has errors'}\n </b></font>\n";\r
}\r
\r
\r
# Memory usage warning\r
my @free = `/usr/bin/free`;\r
$free[1] =~ m/(\d+)/;\r
my $mem = $1;\r
$free[2] =~ m/(\d+)/;\r
my $used = $1;\r
my $pct = int 100 * ($mem - $used) / $mem;\r
if ($used / $mem > 90) {\r
	$warnmessage .= "<li> $Lang::tr{'high memory usage'}: $pct% !</li>\n";\r
}\r
\r
# Diskspace usage warning\r
my @temp=();\r
my $temp2=();\r
my @df = `/bin/df -B M -x rootfs`;\r
foreach my $line (@df) {\r
	next if $line =~ m/^Filesystem/;\r
	if ($line =~ m/root/ ) {\r
		$line =~ m/^.* (\d+)M.*$/;\r
		@temp = split(/ +/,$line);\r
		if ($1<5) {\r
			# available:plain value in MB, and not %used as 10% is too much to waste on small disk\r
			# and root size should not vary during time\r
			$warnmessage .= "<li> $Lang::tr{'filesystem full'}: $temp[0] <b>$Lang::tr{'free'}=$1M</b> !</li>\n";\r
		}\r
		\r
	} else {\r
		# $line =~ m/^.* (\d+)m.*$/;\r
		$line =~ m/^.* (\d+)\%.*$/;\r
		if ($1>90) {\r
			@temp = split(/ /,$line);\r
			$temp2=int(100-$1);\r
			$warnmessage .= "<li> $Lang::tr{'filesystem full'}: $temp[0] <b>$Lang::tr{'free'}=$temp2%</b> !</li>\n";\r
		}\r
	}\r
}\r
\r
# Patches warning\r
open(AV, "<${General::swroot}/patches/available") or die "Could not open available patches database ($!)";\r
my @av = <AV>;\r
close(AV);\r
open(PF, "<${General::swroot}/patches/installed") or die "Could not open installed patches file. ($!)<br />";\r
while(<PF>)\r
{\r
        next if $_ =~ m/^#/;\r
        @temp = split(/\|/,$_);\r
        @av = grep(!/^$temp[0]/, @av);\r
}\r
close(PF);\r
\r
if ($#av != -1) \r
{\r
	$warnmessage .= "<li> $Lang::tr{'there are updates'}</li>";\r
}\r
my $age = &General::age("/${General::swroot}/patches/available");\r
if ($age =~ m/(\d{1,3})d/) {\r
	if ($1 >= 7) {\r
		$warnmessage .= "<li>$Lang::tr{'updates is old1'} $age $Lang::tr{'updates is old2'}</li>\n";\r
	}\r
}\r
\r
if ($warnmessage) {\r
	print "<ol>$warnmessage</ol>";\r
}\r
\r
print "<p>";\r
system('/usr/bin/uptime');\r
print "</p>\n";\r
\r
&Header::closebox();\r
\r
# Test browser, and direct User where to turn off Javascript if necessary\r
# only display message if Javascript is currently enabled\r
if (${Header::javascript}) {\r
print <<END\r
<script type='text/javascript'>\n\r
if(navigator.platform.indexOf("MacPPC")>(-1)){\r
  document.write(\r
    "<center><p>"\r
    + "$Lang::tr{'javascript menu error1'}"\r
    + " <a href='/cgi-bin/gui.cgi'>$Lang::tr{'gui settings'}</a> "\r
    + "$Lang::tr{'javascript menu error2'}"\r
    + "</p></center>"\r
  )\r
}\r
</script>\r
END\r
;\r
}\r
\r
&Header::closebigbox();\r
\r
&Header::closepage();\r
Commit	Line	Data
	1	#!/usr/bin/perl\r
	2	#\r
	3	# SmoothWall CGIs\r
	4	#\r
	5	# This code is distributed under the terms of the GPL\r
	6	#\r
	7	# (c) The SmoothWall Team\r
	8	#\r
	9	# $Id: index.cgi,v 1.15.2.18 2005/09/17 13:51:47 gespinasse Exp $\r
	10	#\r
	11	\r
	12	use strict;\r
	13	\r
	14	# enable only the following on debugging purpose\r
	15	#use warnings;\r
	16	#use CGI::Carp 'fatalsToBrowser';\r
	17	\r
	18	require 'CONFIG_ROOT/general-functions.pl';\r
	19	require "${General::swroot}/lang.pl";\r
	20	require "${General::swroot}/header.pl";\r
	21	\r
	22	my %cgiparams=();\r
	23	my %pppsettings=();\r
	24	my %modemsettings=();\r
	25	my %netsettings=();\r
	26	my %ddnssettings=();\r
	27	my $warnmessage = '';\r
	28	my $refresh = '';\r
	29	\r
	30	&Header::showhttpheaders();\r
	31	\r
	32	$cgiparams{'ACTION'} = '';\r
	33	&Header::getcgihash(\%cgiparams);\r
	34	$pppsettings{'VALID'} = '';\r
	35	$pppsettings{'PROFILENAME'} = 'None';\r
	36	&General::readhash("${General::swroot}/ppp/settings", \%pppsettings);\r
	37	&General::readhash("${General::swroot}/modem/settings", \%modemsettings);\r
	38	&General::readhash("${General::swroot}/ethernet/settings", \%netsettings);\r
	39	&General::readhash("${General::swroot}/ddns/settings", \%ddnssettings);\r
	40	\r
	41	my $connstate = &Header::connectionstatus();\r
	42	if ($connstate =~ /$Lang::tr{'dod waiting'}/ \|\| -e "${General::swroot}/main/refreshindex") {\r
	43	$refresh = "<meta http-equiv='refresh' content='30;'>";\r
	44	} elsif ($connstate =~ /$Lang::tr{'connecting'}/) {\r
	45	$refresh = "<meta http-equiv='refresh' content='5;'>";\r
	46	}\r
	47	\r
	48	&Header::openpage($Lang::tr{'main page'}, 1, $refresh);\r
	49	&Header::openbigbox('', 'center');\r
	50	&Header::openbox('100%', 'center', &Header::cleanhtml(`/bin/uname -n`,"y"));\r
	51	\r
	52	# hide buttons only when pppsettings mandatory used and not valid\r
	53	if ( ( $pppsettings{'VALID'} eq 'yes' ) \|\|\r
	54	( $netsettings{'CONFIG_TYPE'} =~ /^(2\|3\|6\|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP\|STATIC)$/ ) ) {\r
	55	print <<END\r
	56	<table border='0'>\r
	57	<tr>\r
	58	<td align='center'><form method='post' action='/cgi-bin/dial.cgi'>\r
	59	<input type='submit' name='ACTION' value='$Lang::tr{'dial'}' />\r
	60	</form></td>\r
	61	<td>  </td>\r
	62	<td align='center'><form method='post' action='/cgi-bin/dial.cgi'>\r
	63	<input type='submit' name='ACTION' value='$Lang::tr{'hangup'}' />\r
	64	</form></td>\r
	65	<td>  </td>\r
	66	<td align='center'><form method='post' action="$ENV{'SCRIPT_NAME'}">\r
	67	<input type='submit' name='ACTION' value='$Lang::tr{'refresh'}' />\r
	68	</form></td>\r
	69	</tr></table>\r
	70	END\r
	71	;\r
	72	}\r
	73	\r
	74	print "<font face='Helvetica' size='4'><b>";\r
	75	if ( !( $netsettings{'CONFIG_TYPE'} =~ /^(2\|3\|6\|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP\|STATIC)$/ ) ) {\r
	76	print "<u>$Lang::tr{'current profile'} $pppsettings{'PROFILENAME'}</u><br />\n";\r
	77	}\r
	78	\r
	79	if ( ( $pppsettings{'VALID'} eq 'yes'&& $modemsettings{'VALID'} eq 'yes' ) \|\|\r
	80	( $netsettings{'CONFIG_TYPE'} =~ /^(2\|3\|6\|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP\|STATIC)$/ )) {\r
	81	print $connstate;\r
	82	print "</b></font>\n";\r
	83	if ($connstate =~ /$Lang::tr{'connected'}/) {\r
	84	my $fetch_ip='nothing';\r
	85	if ($ddnssettings{'BEHINDROUTER'} eq 'FETCH_IP') {\r
	86	if (open(IPADDR,"${General::swroot}/ddns/ipcache")) {\r
	87	$fetch_ip = <IPADDR>;\r
	88	close IPADDR;\r
	89	chomp ($fetch_ip);\r
	90	my $host_name = (gethostbyaddr(pack("C4", split(/\./, $fetch_ip)), 2))[0];\r
	91	print "<br />$Lang::tr{'ip address'} (internet): $fetch_ip <br /> $Lang::tr{'ipcops hostname'} (internet): $host_name <br />";\r
	92	}\r
	93	}\r
	94	if (open(IPADDR,"${General::swroot}/red/local-ipaddress")) {\r
	95	my $ipaddr = <IPADDR>;\r
	96	close IPADDR;\r
	97	chomp ($ipaddr);\r
	98	if ($ipaddr ne $fetch_ip){ #do not show info twice\r
	99	my $host_name = (gethostbyaddr(pack("C4", split(/\./, $ipaddr)), 2))[0];\r
	100	print "<br />$Lang::tr{'ip address'}: $ipaddr <br /> $Lang::tr{'ipcops hostname'}: $host_name <br />";\r
	101	}\r
	102	}\r
	103	}\r
	104	\r
	105	} elsif ($modemsettings{'VALID'} eq 'no') {\r
	106	print "$Lang::tr{'modem settings have errors'}\n </b></font>\n";\r
	107	} else {\r
	108	print "$Lang::tr{'profile has errors'}\n </b></font>\n";\r
	109	}\r
	110	\r
	111	\r
	112	# Memory usage warning\r
	113	my @free = `/usr/bin/free`;\r
	114	$free[1] =~ m/(\d+)/;\r
	115	my $mem = $1;\r
	116	$free[2] =~ m/(\d+)/;\r
	117	my $used = $1;\r
	118	my $pct = int 100 * ($mem - $used) / $mem;\r
	119	if ($used / $mem > 90) {\r
	120	$warnmessage .= "<li> $Lang::tr{'high memory usage'}: $pct% !</li>\n";\r
	121	}\r
	122	\r
	123	# Diskspace usage warning\r
	124	my @temp=();\r
	125	my $temp2=();\r
	126	my @df = `/bin/df -B M -x rootfs`;\r
	127	foreach my $line (@df) {\r
	128	next if $line =~ m/^Filesystem/;\r
	129	if ($line =~ m/root/ ) {\r
	130	$line =~ m/^.* (\d+)M.*$/;\r
	131	@temp = split(/ +/,$line);\r
	132	if ($1<5) {\r
	133	# available:plain value in MB, and not %used as 10% is too much to waste on small disk\r
	134	# and root size should not vary during time\r
	135	$warnmessage .= "<li> $Lang::tr{'filesystem full'}: $temp[0] <b>$Lang::tr{'free'}=$1M</b> !</li>\n";\r
	136	}\r
	137	\r
	138	} else {\r
	139	# $line =~ m/^.* (\d+)m.*$/;\r
	140	$line =~ m/^.* (\d+)\%.*$/;\r
	141	if ($1>90) {\r
	142	@temp = split(/ /,$line);\r
	143	$temp2=int(100-$1);\r
	144	$warnmessage .= "<li> $Lang::tr{'filesystem full'}: $temp[0] <b>$Lang::tr{'free'}=$temp2%</b> !</li>\n";\r
	145	}\r
	146	}\r
	147	}\r
	148	\r
	149	# Patches warning\r
	150	open(AV, "<${General::swroot}/patches/available") or die "Could not open available patches database ($!)";\r
	151	my @av = <AV>;\r
	152	close(AV);\r
	153	open(PF, "<${General::swroot}/patches/installed") or die "Could not open installed patches file. ($!)<br />";\r
	154	while(<PF>)\r
	155	{\r
	156	next if $_ =~ m/^#/;\r
	157	@temp = split(/\\|/,$_);\r
	158	@av = grep(!/^$temp[0]/, @av);\r
	159	}\r
	160	close(PF);\r
	161	\r
	162	if ($#av != -1) \r
	163	{\r
	164	$warnmessage .= "<li> $Lang::tr{'there are updates'}</li>";\r
	165	}\r
	166	my $age = &General::age("/${General::swroot}/patches/available");\r
	167	if ($age =~ m/(\d{1,3})d/) {\r
	168	if ($1 >= 7) {\r
	169	$warnmessage .= "<li>$Lang::tr{'updates is old1'} $age $Lang::tr{'updates is old2'}</li>\n";\r
	170	}\r
	171	}\r
	172	\r
	173	if ($warnmessage) {\r
	174	print "<ol>$warnmessage</ol>";\r
	175	}\r
	176	\r
	177	print "<p>";\r
	178	system('/usr/bin/uptime');\r
	179	print "</p>\n";\r
	180	\r
	181	&Header::closebox();\r
	182	\r
	183	# Test browser, and direct User where to turn off Javascript if necessary\r
	184	# only display message if Javascript is currently enabled\r
	185	if (${Header::javascript}) {\r
	186	print <<END\r
	187	<script type='text/javascript'>\n\r
	188	if(navigator.platform.indexOf("MacPPC")>(-1)){\r
	189	document.write(\r
	190	"<center><p>"\r
	191	+ "$Lang::tr{'javascript menu error1'}"\r
	192	+ " <a href='/cgi-bin/gui.cgi'>$Lang::tr{'gui settings'}</a> "\r
	193	+ "$Lang::tr{'javascript menu error2'}"\r
	194	+ "</p></center>"\r
	195	)\r
	196	}\r
	197	</script>\r
	198	END\r
	199	;\r
	200	}\r
	201	\r
	202	&Header::closebigbox();\r
	203	\r
	204	&Header::closepage();\r