[people/teissler/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
cd1a2927 MT	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