immernoch das alte Problem...
[people/pmueller/ipfire-2.x.git] / html / cgi-bin / index.cgi
CommitLineData
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
12use 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
18require 'CONFIG_ROOT/general-functions.pl';\r
19require "${General::swroot}/lang.pl";\r
20require "${General::swroot}/header.pl";\r
21\r
22my %cgiparams=();\r
23my %pppsettings=();\r
24my %modemsettings=();\r
25my %netsettings=();\r
26my %ddnssettings=();\r
27my $warnmessage = '';\r
28my $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
41my $connstate = &Header::connectionstatus();\r
42if ($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
53if ( ( $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>&nbsp;&nbsp;</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>&nbsp;&nbsp;</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
70END\r
71 ;\r
72}\r
73\r
74print "<font face='Helvetica' size='4'><b>";\r
75if ( !( $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
79if ( ( $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
113my @free = `/usr/bin/free`;\r
114$free[1] =~ m/(\d+)/;\r
115my $mem = $1;\r
116$free[2] =~ m/(\d+)/;\r
117my $used = $1;\r
118my $pct = int 100 * ($mem - $used) / $mem;\r
119if ($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
124my @temp=();\r
125my $temp2=();\r
126my @df = `/bin/df -B M -x rootfs`;\r
127foreach 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
150open(AV, "<${General::swroot}/patches/available") or die "Could not open available patches database ($!)";\r
151my @av = <AV>;\r
152close(AV);\r
153open(PF, "<${General::swroot}/patches/installed") or die "Could not open installed patches file. ($!)<br />";\r
154while(<PF>)\r
155{\r
156 next if $_ =~ m/^#/;\r
157 @temp = split(/\|/,$_);\r
158 @av = grep(!/^$temp[0]/, @av);\r
159}\r
160close(PF);\r
161\r
162if ($#av != -1) \r
163{\r
164 $warnmessage .= "<li> $Lang::tr{'there are updates'}</li>";\r
165}\r
166my $age = &General::age("/${General::swroot}/patches/available");\r
167if ($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
173if ($warnmessage) {\r
174 print "<ol>$warnmessage</ol>";\r
175}\r
176\r
177print "<p>";\r
178system('/usr/bin/uptime');\r
179print "</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
185if (${Header::javascript}) {\r
186print <<END\r
187<script type='text/javascript'>\n\r
188if(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
198END\r
199;\r
200}\r
201\r
202&Header::closebigbox();\r
203\r
204&Header::closepage();\r