]> git.ipfire.org Git - ipfire-2.x.git/blame - config/cfgroot/header.pl
projects / ipfire-2.x.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Quellenupdate
[ipfire-2.x.git] / config / cfgroot / header.pl
CommitLineData
db085d8a
MT		 1# SmoothWall CGIs\r
2#\r
3# This code is distributed under the terms of the GPL\r
4#\r
5# (c) The SmoothWall Team\r
6# Copyright (C) 2002 Alex Hudson - getcgihash() rewrite\r
7# Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()\r
8# Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions\r
9# Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()\r
10# Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()\r
11#\r
12# $Id: header.pl,v 1.34.2.39 2004/11/26 15:51:27 alanh Exp $\r
13#\r
14package Header;\r
15\r
16use CGI();\r
17use Socket;\r
18use Time::Local;\r
19\r
20$|=1; # line buffering\r
21\r
22sub get_version() {\r
23 my $read_ver = `cat /etc/ipfire-release`;\r
24 if ($read_ver =~ /^$/) {\r
25 return "IPFire (unknown version)";\r
26 }\r
27 return $read_ver;\r
28}\r
29\r
30$Header::version = get_version();\r
31$Header::revision = 'final';\r
32$Header::swroot = '/var/ipfire';\r
33$Header::pagecolour = '#ffffff';\r
34#$Header::tablecolour = '#a0a0a0';\r
35$Header::tablecolour = '#FFFFFF';\r
36$Header::bigboxcolour = '#F6F4F4';\r
37$Header::boxcolour = '#EAE9EE';\r
38$Header::bordercolour = '#000000';\r
39$Header::table1colour = '#E0E0E0';\r
40$Header::table2colour = '#F0F0F0';\r
41$Header::colourred = '#993333';\r
42$Header::colourorange = '#FF9933';\r
43$Header::colouryellow = '#FFFF00';\r
44$Header::colourgreen = '#339933';\r
45$Header::colourblue = '#333399';\r
46$Header::colourfw = '#000000';\r
47$Header::colourvpn = '#990099';\r
48$Header::colourerr = '#FF0000';\r
49$Header::viewsize = 150;\r
50$Header::errormessage = '';\r
51my %menuhash = ();\r
52my $menu = \%menuhash;\r
53%settings = ();\r
54%ethsettings = ();\r
55@URI = ();\r
56$Header::supported=0;\r
57\r
58### Make sure this is an SSL request\r
59if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {\r
60 print "Status: 302 Moved\r\n";\r
61 print "Location: https://$ENV{'SERVER_ADDR'}:10443/$ENV{'PATH_INFO'}\r\n\r\n";\r
62 exit 0;\r
63}\r
64\r
65### Initialize environment\r
66&readhash("${swroot}/main/settings", \%settings);\r
67&readhash("${swroot}/ethernet/settings", \%ethsettings);\r
68$language = $settings{'LANGUAGE'};\r
69$hostname = $settings{'HOSTNAME'};\r
70$hostnameintitle = 0;\r
71\r
72### Initialize language\r
73if ($language =~ /^(\w+)$/) {$language = $1;}\r
74\r
75### Read English Files\r
76if ( -d "/var/ipfire/langs/en/" ) {\r
77 opendir(DIR, "/var/ipfire/langs/en/");\r
78 @names = readdir(DIR) or die "Cannot Read Directory: $!\n";\r
79 foreach $name(@names) {\r
80 next if ($name eq ".");\r
81 next if ($name eq "..");\r
82 next if (!($name =~ /\.pl$/));\r
83 require "${swroot}/langs/en/${name}";\r
84 };\r
85};\r
86\r
87\r
88### Enable Language Files\r
89if ( -d "/var/ipfire/langs/${language}/" ) {\r
90 opendir(DIR, "/var/ipfire/langs/${language}/");\r
91 @names = readdir(DIR) or die "Cannot Read Directory: $!\n";\r
92 foreach $name(@names) {\r
93 next if ($name eq ".");\r
94 next if ($name eq "..");\r
95 next if (!($name =~ /\.pl$/));\r
96 require "${swroot}/langs/${language}/${name}";\r
97 };\r
98};\r
99\r
100\r
101require "${swroot}/langs/en.pl";\r
102require "${swroot}/langs/${language}.pl";\r
103\r
104sub orange_used () {\r
105 if ($ethsettings{'CONFIG_TYPE'} =~ /^[1357]$/) {\r
106 return 1;\r
107 }\r
108 return 0;\r
109}\r
110\r
111sub blue_used () {\r
112 if ($ethsettings{'CONFIG_TYPE'} =~ /^[4567]$/) {\r
113 return 1;\r
114 }\r
115 return 0;\r
116}\r
117\r
118sub is_modem {\r
119 if ($ethsettings{'CONFIG_TYPE'} =~ /^[0145]$/) {\r
120 return 1;\r
121 }\r
122 return 0;\r
123}\r
124\r
125### Initialize menu\r
126sub genmenu {\r
127 my %subsystemhash = ();\r
128 my $subsystem = \%subsystemhash;\r
129\r
130 $subsystem->{'01.home'} = {\r
131 'caption' => $tr{'alt home'},\r
132 'uri' => '/cgi-bin/index.cgi',\r
133 'title' => "$tr{'alt home'}",\r
134 'enabled' => 1,\r
135 };\r
136 $subsystem->{'02.netwizard'} = {\r
137 'caption' => $tr{'network configuration'},\r
138 'uri' => '/cgi-bin/netwizard.cgi',\r
139 'title' => "$tr{'network configuration'}",\r
140 'enabled' => 1,\r
141 };\r
142 $subsystem->{'03.updates'} = {\r
143 'caption' => $tr{'updates'},\r
144 'uri' => '/cgi-bin/updates.cgi',\r
145 'title' => "$tr{'updates'}",\r
146 'enabled' => 0,\r
147 };\r
148 $subsystem->{'04.passwords'} = {\r
149 'caption' => $tr{'sspasswords'},\r
150 'uri' => '/cgi-bin/changepw.cgi',\r
151 'title' => "$tr{'sspasswords'}",\r
152 'enabled' => 1,\r
153 };\r
154 $subsystem->{'05.ssh'} = {\r
155 'caption' => $tr{'ssh access'},\r
156 'uri' => '/cgi-bin/remote.cgi',\r
157 'title' => "$tr{'ssh access'}",\r
158 'enabled' => 1,\r
159 };\r
160 $subsystem->{'06.gui'} = {\r
161 'caption' => $tr{'gui settings'},\r
162 'uri' => '/cgi-bin/gui.cgi',\r
163 'title' => "$tr{'gui settings'}",\r
164 'enabled' => 1,\r
165 };\r
166 $subsystem->{'07.backup'} = {\r
167 'caption' => $tr{'backup'},\r
168 'uri' => '/cgi-bin/backup.cgi',\r
169 'title' => "$tr{'backup'} / $tr{'restore'}",\r
170 'enabled' => 1,\r
171 };\r
172 $subsystem->{'08.shutdown'} = {\r
173 'caption' => $tr{'shutdown'},\r
174 'uri' => '/cgi-bin/shutdown.cgi',\r
175 'title' => "$tr{'shutdown'} / $tr{'reboot'}",\r
176 'enabled' => 1,\r
177 };\r
178 $subsystem->{'09.credits'} = {\r
179 'caption' => $tr{'credits'},\r
180 'uri' => '/cgi-bin/credits.cgi',\r
181 'title' => "$tr{'credits'}",\r
182 'enabled' => 1,\r
183 };\r
184\r
185 my %substatushash = ();\r
186 my $substatus = \%substatushash;\r
187 $substatus->{'01.systemstatus'} = {\r
188 'caption' => $tr{'sssystem status'},\r
189 'uri' => '/cgi-bin/status.cgi',\r
190 'title' => "$tr{'system status information'}",\r
191 'enabled' => 1,\r
192 };\r
193 $substatus->{'02.networkstatus'} = {\r
194 'caption' => $tr{'ssnetwork status'},\r
195 'uri' => '/cgi-bin/netstatus.cgi',\r
196 'title' => "$tr{'network status information'}",\r
197 'enabled' => 1,\r
198 };\r
199 $substatus->{'03.systemgraphs'} = {\r
200 'caption' => $tr{'system graphs'},\r
201 'uri' => '/cgi-bin/graphs.cgi',\r
202 'novars' => 1,\r
203 'title' => "$tr{'system graphs'}",\r
204 'enabled' => 1,\r
205 };\r
206 $substatus->{'04.trafficgraphs'} = {\r
207 'caption' => $tr{'sstraffic graphs'},\r
208 'uri' => '/cgi-bin/graphs.cgi',\r
209 'vars' => 'graph=network',\r
210 'title' => "$tr{'network traffic graphs'}",\r
211 'enabled' => 1,\r
212 };\r
213 $substatus->{'05.proxygraphs'} = {\r
214 'caption' => $tr{'ssproxy graphs'},\r
215 'uri' => '/cgi-bin/proxygraphs.cgi',\r
216 'title' => "$tr{'proxy access graphs'}",\r
217 'enabled' => 1,\r
218 };\r
219 $substatus->{'06.connections'} = {\r
220 'caption' => $tr{'connections'},\r
221 'uri' => '/cgi-bin/connections.cgi',\r
222 'title' => "$tr{'connections'}",\r
223 'enabled' => 1,\r
224 };\r
225 $substatus->{'99.iptfilters'} = {\r
226 'caption' => $tr{'iptfilters iptable rules'},\r
227 'uri' => '/cgi-bin/iptfilters.cgi',\r
228 'title' => "$tr{'iptfilters iptable rules'}",\r
229 'enabled' => 1,\r
230 };\r
231\r
232 my %subnetworkhash = ();\r
233 my $subnetwork = \%subnetworkhash;\r
234\r
235 $subnetwork->{'01.dialup'} = {\r
236 'caption' => $tr{'alt dialup'},\r
237 'uri' => '/cgi-bin/pppsetup.cgi',\r
238 'title' => "$tr{'dialup settings'}",\r
239 'enabled' => 0,\r
240 };\r
241 $subnetwork->{'02.hosts'} = {\r
242 'caption' => $tr{'edit hosts'},\r
243 'uri' => '/cgi-bin/hosts.cgi',\r
244 'title' => "$tr{'host configuration'}",\r
245 'enabled' => 1,\r
246 };\r
247 $subnetwork->{'03.upload'} = {\r
248 'caption' => $tr{'upload'},\r
249 'uri' => '/cgi-bin/upload.cgi',\r
250 'title' => "$tr{'firmware upload'}",\r
251 'enabled' => 0,\r
252 };\r
253 $subnetwork->{'04.aliases'} = {\r
254 'caption' => $tr{'aliases'},\r
255 'uri' => '/cgi-bin/aliases.cgi',\r
256 'title' => "$tr{'external aliases configuration'}",\r
257 'enabled' => 1,\r
258 };\r
259\r
260\r
261 my %subserviceshash = ();\r
262 my $subservices = \%subserviceshash;\r
263\r
264 $subservices->{'01.dhcp'} = {\r
265 'caption' => $tr{'dhcp server'},\r
266 'uri' => '/cgi-bin/dhcp.cgi',\r
267 'title' => "$tr{'dhcp configuration'}",\r
268 'enabled' => 1,\r
269 };\r
270 $subservices->{'02.dyndns'} = {\r
271 'caption' => $tr{'dynamic dns'},\r
272 'uri' => '/cgi-bin/ddns.cgi',\r
273 'title' => "$tr{'dynamic dns client'}",\r
274 'enabled' => 1,\r
275 };\r
276 $subservices->{'03.time'} = {\r
277 'caption' => $tr{'time server'},\r
278 'uri' => '/cgi-bin/time.cgi',\r
279 'title' => "$tr{'time server'}",\r
280 'enabled' => 1,\r
281 };\r
282 $subservices->{'04.shaping'} = {\r
283 'caption' => $tr{'traffic shaping'},\r
284 'uri' => '/cgi-bin/shaping.cgi',\r
285 'title' => "$tr{'traffic shaping settings'}",\r
286 'enabled' => 1,\r
287 };\r
288 $subservices->{'05.ids'} = {'caption' => $tr{'intrusion detection'},\r
289 'enabled' => 1,\r
290 'uri' => '/cgi-bin/ids.cgi',\r
291 'title' => "$tr{'intrusion detection system'} (Snort)",\r
292 };\r
293\r
294\r
295 my %subfirewallhash = ();\r
296 my $subfirewall = \%subfirewallhash;\r
297\r
298 \r
299 $subfirewall->{'01.dnat'} = {\r
300 'caption' => $tr{'ssport forwarding'},\r
301 'uri' => '/cgi-bin/portfw.cgi',\r
302 'title' => "$tr{'port forwarding configuration'}",\r
303 'enabled' => 1,\r
304 };\r
305 $subfirewall->{'02.xtaccess'} = {\r
306 'caption' => $tr{'external access'},\r
307 'uri' => '/cgi-bin/xtaccess.cgi',\r
308 'title' => "$tr{'external access configuration'}",\r
309 'enabled' => 1,\r
310 };\r
311 $subfirewall->{'03.dmz'} = {\r
312 'caption' => $tr{'ssdmz pinholes'},\r
313 'uri' => '/cgi-bin/dmzholes.cgi',\r
314 'title' => "$tr{'dmz pinhole configuration'}",\r
315 'enabled' => 1,\r
316 };\r
317 $subfirewall->{'04.outgoing'} = {\r
318 'caption' => $tr{'outgoing firewall'},\r
319 'uri' => '/cgi-bin/outgoingfw.cgi',\r
320 'title' => "$tr{'outgoing firewall'}",\r
321 'enabled' => 1,\r
322 };\r
323 \r
324\r
325\r
326 my %subhttphash = ();\r
327 my $subhttp = \%subhttphash;\r
328 $subhttp->{'01.proxy'} = {\r
329 'caption' => $tr{'proxy'},\r
330 'uri' => '/cgi-bin/advproxy.cgi',\r
331 'title' => "HTTP: $tr{'web proxy configuration'}",\r
332 'enabled' => 1,\r
333 };\r
334 $subhttp->{'02.contentfilter'} = {\r
335 'caption' => $tr{'content filter'},\r
336 'uri' => '/cgi-bin/dansguardian.cgi',\r
337 'title' => "HTTP: $tr{'content filter'}",\r
338 'enabled' => 1,\r
339 };\r
340 $subhttp->{'03.antivirus'} = {\r
341 'caption' => $tr{'antivirus'},\r
342 'uri' => '/cgi-bin/httpantivirus.cgi',\r
343 'title' => "HTTP: $tr{'antivirus'}",\r
344 'enabled' => 1,\r
345 };\r
346 $subhttp->{'04.proxymanagment'} = {\r
347 'caption' => $tr{'DS Managment'},\r
348 'uri' => '/cgi-bin/proxygm.cgi',\r
349 'title' => "HTTP: $tr{'DS Managment'}",\r
350 'enabled' => 1,\r
351 };\r
352 $subhttp->{'05.activatedgroups'} = {\r
353 'caption' => $tr{'activated Groups'},\r
354 'uri' => '/cgi-bin/proxyag.cgi',\r
355 'title' => "HTTP: $tr{'activated Groups'}",\r
356 'enabled' => 1,\r
357 };\r
358 $subhttp->{'06.advancedproxy'} = {\r
359 'caption' => $tr{'Proxy Advanced'},\r
360 'uri' => '/cgi-bin/proxyad.cgi',\r
361 'title' => "HTTP: $tr{'Proxy Advanced'}",\r
362 'enabled' => 1,\r
363 };\r
364\r
365\r
366 my %subproxyhash = ();\r
367 my $subproxy = \%subproxyhash;\r
368\r
369 $subproxy->{'01.http'} = {'caption' => $tr{'HTTP'},\r
370 'enabled' => 1,\r
371 'subMenu' => $subhttp\r
372 };\r
373 $subproxy->{'02.ftp'} = {'caption' => 'FTP',\r
374 'enabled' => 1,\r
375 'subMenu' => $subftp\r
376 };\r
377\r
378\r
379\r
380 my %subopenvpnhash = ();\r
381 my $subopenvpn = \%subopenvpnhash;\r
382 $subopenvpn->{'01.server'} = {'caption' => $tr{'openvpn'},\r
383 'uri' => '/cgi-bin/openvpn.cgi',\r
384 'title' => "$tr{'virtual private networking'}",\r
385 'enabled' => 1,\r
386 };\r
387 $subopenvpn->{'02.client'} = {'caption' => $tr{'openvpnclient'},\r
388 'uri' => '/cgi-bin/openvpnclient.cgi',\r
389 'title' => "$tr{'virtual private networking'}",\r
390 'enabled' => 1,\r
391 };\r
392\r
393 my %subvpnhash = ();\r
394 my $subvpn = \%subvpnhash;\r
395\r
396 $subvpn->{'01.openvpn'} = {'caption' => $tr{'openvpn'},\r
397 'subMenu' => $subopenvpn,\r
398 'enabled' => 1,\r
399 };\r
400 $subvpn->{'02.ipsec'} = {'caption' => $tr{'ipsec'},\r
401 'uri' => '/cgi-bin/vpnmain.cgi',\r
402 'title' => "$tr{'virtual private networking'}",\r
403 'enabled' => 1,\r
404 };\r
405\r
406 my %sublogshash = ();\r
407 my $sublogs = \%sublogshash;\r
408\r
409 $sublogs->{'01.summary'} = {'caption' => $tr{'log summary'},\r
410 'uri' => '/cgi-bin/logs.cgi/summary.dat',\r
411 'title' => "$tr{'log summary'}",\r
412 'enabled' => 1\r
413 };\r
414 $sublogs->{'02.settings'} = {'caption' => $tr{'log settings'},\r
415 'uri' => '/cgi-bin/logs.cgi/config.dat',\r
416 'title' => "$tr{'log settings'}",\r
417 'enabled' => 1\r
418 };\r
419 $sublogs->{'03.proxy'} = {'caption' => $tr{'proxy logs'},\r
420 'uri' => '/cgi-bin/logs.cgi/proxylog.dat',\r
421 'title' => "$tr{'proxy log viewer'}",\r
422 'enabled' => 1\r
423 };\r
424 $sublogs->{'04.firewall'} = {'caption' => $tr{'firewall logs'},\r
425 'uri' => '/cgi-bin/logs.cgi/firewalllog.dat',\r
426 'title' => "$tr{'firewall log viewer'}",\r
427 'enabled' => 1\r
428 };\r
429 $sublogs->{'05.ids'} = {'caption' => $tr{'ids logs'},\r
430 'uri' => '/cgi-bin/logs.cgi/ids.dat',\r
431 'title' => "$tr{'intrusion detection system log viewer'}",\r
432 'enabled' => 1\r
433 };\r
434 $sublogs->{'06.contentfilter'} = {'caption' => $tr{'content filter logs'},\r
435 'uri' => '/cgi-bin/logs.cgi/dansguardian.dat',\r
436 'title' => "$tr{'content filter log viewer'}",\r
437 'enabled' => 1\r
438 };\r
439 $sublogs->{'07.urlfilter'} = {\r
440 'caption' => $tr{'urlfilter log'},\r
441 'uri' => '/cgi-bin/logs.cgi/urlfilter.dat',\r
442 'title' => "$tr{'urlfilter log'}",\r
443 'enabled' => 1,\r
444 };\r
445 $sublogs->{'08.openvpn'} = {'caption' => $tr{'openvpn log'},\r
446 'uri' => '/cgi-bin/logs.cgi/openvpn.dat',\r
447 'title' => "$tr{'openvpn log'}",\r
448 'enabled' => 1\r
449 };\r
450 $sublogs->{'09.system'} = {'caption' => $tr{'system logs'},\r
451 'uri' => '/cgi-bin/logs.cgi/log.dat',\r
452 'title' => "$tr{'system log viewer'}",\r
453 'enabled' => 1\r
454 };\r
455 $sublogs->{'10.userlog'} = {'caption' => $tr{'user proxy logs'},\r
456 'uri' => '/cgi-bin/logs.cgi/userlog.dat',\r
457 'title' => "$tr{'user log viewer'}",\r
458 'enabled' => 1\r
459 };\r
460\r
461\r
462 $menu->{'01.system'} = {'caption' => $tr{'alt system'},\r
463 'enabled' => 1,\r
464 'subMenu' => $subsystem\r
465 };\r
466 $menu->{'02.status'} = {'caption' => $tr{'status'},\r
467 'enabled' => 1,\r
468 'subMenu' => $substatus\r
469 };\r
470 $menu->{'03.network'} = {'caption' => $tr{'network'},\r
471 'enabled' => 1,\r
472 'subMenu' => $subnetwork\r
473 };\r
474 $menu->{'04.services'} = {'caption' => $tr{'alt services'},\r
475 'enabled' => 1,\r
476 'subMenu' => $subservices\r
477 };\r
478 $menu->{'05.firewall'} = {'caption' => $tr{'firewall'},\r
479 'enabled' => 1,\r
480 'subMenu' => $subfirewall\r
481 };\r
482 $menu->{'06.proxy'} = {'caption' => $tr{'alt proxy'},\r
483 'enabled' => 1,\r
484 'subMenu' => $subproxy\r
485 };\r
486 $menu->{'07.vpn'} = {'caption' => 'VPN',\r
487 'enabled' => 1,\r
488 'subMenu' => $subvpn\r
489 };\r
490 $menu->{'08.logs'} = {'caption' => $tr{'alt logs'},\r
491 'enabled' => 1,\r
492 'subMenu' => $sublogs\r
493 };\r
494\r
495\r
496\r
497 if (! blue_used() && ! orange_used()) {\r
498 $menu->{'05.firewall'}{'subMenu'}->{'03.dmz'}{'enabled'} = 0;\r
499 }\r
500 if (-e '/etc/FLASH') {\r
501 $menu{'06.proxy'}{'subMenu'}->{'01.http'}{'subMenu'}->{'01.proxy'}{'enabled'} = 0; #disable squid\r
502 $menu{'04.services'}{'subMenu'}->{'05.ids'}{'enabled'} = 0; #disable ids\r
503 $menu{'08.logs'}{'subMenu'}->{'05.ids'}{'enabled'} = 0; #disable ids\r
504 }\r
505}\r
506\r
507sub showhttpheaders\r
508{\r
509 print "Pragma: no-cache\n";\r
510 print "Cache-control: no-cache\n";\r
511 print "Connection: close\n";\r
512 print "Content-type: text/html\n\n";\r
513}\r
514\r
515sub is_menu_visible($) {\r
516 my $link = shift;\r
517 $link =~ s#\?.*$##;\r
518 return (-e $ENV{'DOCUMENT_ROOT'}."/../$link");\r
519}\r
520\r
521\r
522sub getlink($) {\r
523 my $root = shift;\r
524 if (! $root->{'enabled'}) {\r
525 return '';\r
526 }\r
527 if ($root->{'uri'} !~ /^$/) {\r
528 my $vars = '';\r
529 if ($root->{'vars'} !~ /^$/) {\r
530 $vars = '?'. $root->{'vars'};\r
531 }\r
532 if (! is_menu_visible($root->{'uri'})) {\r
533 return '';\r
534 }\r
535 return $root->{'uri'}.$vars;\r
536 }\r
537 my $submenus = $root->{'subMenu'};\r
538 if (! $submenus) {\r
539 return '';\r
540 }\r
541 foreach my $item (sort keys %$submenus) {\r
542 my $link = getlink($submenus->{$item});\r
543 if ($link ne '') {\r
544 return $link;\r
545 }\r
546 }\r
547 return '';\r
548}\r
549\r
550\r
551sub compare_url($) {\r
552 my $conf = shift;\r
553\r
554 my $uri = $conf->{'uri'};\r
555 my $vars = $conf->{'vars'};\r
556 my $novars = $conf->{'novars'};\r
557\r
558 if ($uri eq '') {\r
559 return 0;\r
560 }\r
561 if ($uri ne $URI[0]) {\r
562 return 0;\r
563 }\r
564 if ($novars) {\r
565 if ($URI[1] !~ /^$/) {\r
566 return 0;\r
567 }\r
568 }\r
569 if (! $vars) {\r
570 return 1;\r
571 }\r
572 return ($URI[1] eq $vars);\r
573}\r
574\r
575\r
576sub gettitle($) {\r
577 my $root = shift;\r
578\r
579 if (! $root) {\r
580 return '';\r
581 }\r
582 foreach my $item (sort keys %$root) {\r
583 my $val = $root->{$item};\r
584 if (compare_url($val)) {\r
585 $val->{'selected'} = 1;\r
586 if ($val->{'title'} !~ /^$/) {\r
587 return $val->{'title'};\r
588 }\r
589 return 'EMPTY TITLE';\r
590 }\r
591\r
592 my $title = gettitle($val->{'subMenu'});\r
593 if ($title ne '') {\r
594 $val->{'selected'} = 1;\r
595 return $title;\r
596 }\r
597 }\r
598 return '';\r
599}\r
600\r
601\r
602sub showmenu() {\r
603 print <<EOF\r
604 <div id="menu-top">\r
605 <ul>\r
606EOF\r
607;\r
608 foreach my $k1 ( sort keys %$menu ) {\r
609 if (! $menu->{$k1}{'enabled'}) {\r
610 next;\r
611 }\r
612\r
613 my $link = getlink($menu->{$k1});\r
614 if ($link eq '') {\r
615 next;\r
616 }\r
617 if (! is_menu_visible($link)) {\r
618 next;\r
619 }\r
620 if ($menu->{$k1}->{'selected'}) {\r
621 print '<li class="selected">';\r
622 } else {\r
623 print '<li>';\r
624 }\r
625\r
626 print <<EOF\r
627 <div class="rcorner">\r
628 <a href="$link">$menu->{$k1}{'caption'}</a>\r
629 </div>\r
630 </li>\r
631EOF\r
632;\r
633 }\r
634\r
635 print <<EOF\r
636 </ul>\r
637 </div>\r
638EOF\r
639; \r
640}\r
641\r
642sub getselected($) {\r
643 my $root = shift;\r
644 if (!$root) {\r
645 return 0;\r
646 }\r
647\r
648 foreach my $item (%$root) {\r
649 if ($root->{$item}{'selected'}) {\r
650 return $root->{$item};\r
651 }\r
652 }\r
653}\r
654\r
655sub showsubsection($$) {\r
656 my $root = shift;\r
657 my $id = shift;\r
658 if ($id eq '') {\r
659 $id = 'menu-left';\r
660 }\r
661\r
662 if (! $root) {\r
663 return;\r
664 }\r
665 my $selected = getselected($root);\r
666 if (! $selected) {\r
667 return;\r
668 }\r
669 my $submenus = $selected->{'subMenu'};\r
670 if (! $submenus) {\r
671 return;\r
672 }\r
673\r
674 print <<EOF\r
675 <div id="$id">\r
676 <ul>\r
677EOF\r
678;\r
679 foreach my $item (sort keys %$submenus) {\r
680 my $hash = $submenus->{$item};\r
681 if (! $hash->{'enabled'}) {\r
682 next;\r
683 }\r
684\r
685 my $link = getlink($hash);\r
686 if ($link eq '') {\r
687 next;\r
688 }\r
689 if (! is_menu_visible($link)) {\r
690 next;\r
691 }\r
692 if ($hash->{'selected'}) {\r
693 print '<li class="selected">';\r
694 } else {\r
695 print '<li>';\r
696 }\r
697\r
698 print <<EOF\r
699 <a href="$link">$hash->{'caption'}</a>\r
700 </li>\r
701EOF\r
702;\r
703 }\r
704\r
705 print <<EOF\r
706 </ul>\r
707 </div>\r
708EOF\r
709; \r
710\r
711}\r
712\r
713\r
714sub showsubsubsection($) {\r
715 my $root = shift;\r
716 if (!$root) {\r
717 return;\r
718 }\r
719 my $selected = getselected($root);\r
720 if (! $selected) {\r
721 return\r
722 }\r
723 if (! $selected->{'subMenu'}) {\r
724 return\r
725 }\r
726\r
727 showsubsection($selected->{'subMenu'}, 'menu-subtop');\r
728}\r
729\r
730\r
731sub get_helpuri() {\r
732 my $helpfile = '';\r
733 if ($URI[0] =~ /.*\/([^\/]+)\.cgi/) {\r
734 $helpfile = $1;\r
735 } else {\r
736 return '';\r
737 }\r
738 $helpfile .= '.help.html';\r
739\r
740 my $helpuri = '/doc/'.$language.'/'.$helpfile;\r
741 if (! -e $ENV{'DOCUMENT_ROOT'}.$helpuri) {\r
742 return '';\r
743 }\r
744 return $helpuri;\r
745}\r
746\r
747\r
748sub openpage {\r
749 my $title = shift;\r
750 my $boh = shift;\r
751 my $extrahead = shift;\r
752\r
753 @URI=split ('\?', $ENV{'REQUEST_URI'} );\r
754 &readhash("${swroot}/main/settings", \%settings);\r
755 &genmenu();\r
756\r
757 my $h2 = gettitle($menu);\r
758 my $helpuri = get_helpuri();\r
759\r
760 $title = "IPFire - $title";\r
761 if ($settings{'WINDOWWITHHOSTNAME'} eq 'on') {\r
762 $title = "$settings{'HOSTNAME'}.$settings{'DOMAINNAME'} - $title"; \r
763 }\r
764\r
765 print <<END\r
766<!DOCTYPE html \r
767 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\r
768 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\r
769\r
770<html>\r
771 <head>\r
772 <title>$title</title>\r
773\r
774 $extrahead\r
775 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>\r
776 <link rel="shortcut icon" href="/favicon.ico" />\r
777 <style type="text/css">\@import url(/include/style.css);</style>\r
778 <style type="text/css">\@import url(/include/menu.css);</style>\r
779 <style type="text/css">\@import url(/include/content.css);</style>\r
780\r
781 <script language="javascript" type="text/javascript">\r
782 \r
783 function swapVisibility(id) {\r
784 el = document.getElementById(id);\r
785 if(el.style.display != 'block') {\r
786 el.style.display = 'block'\r
787 }\r
788 else {\r
789 el.style.display = 'none'\r
790 }\r
791 }\r
792 </script>\r
793\r
794 </head>\r
795 <body>\r
796<!-- IPFIRE HEADER -->\r
797\r
798<div id="main">\r
799\r
800<div id="header">\r
801 <img id="logo-product" src="/images/logo_ipfire.gif">\r
802 <img id="logo-ipfire" src="/images/logo_ipfire2.gif"> \r
803 <div id="header-icons">\r
804END\r
805;\r
806\r
807 if ($helpuri ne '') {\r
808 print <<END\r
809 <a href="$helpuri" target="_blank"><img border="0" src="/images/help.gif"></a>\r
810END\r
811;\r
812 } else {\r
813 print '<img src="/images/help.gif">';\r
814 }\r
815\r
816print <<END\r
817 </div>\r
818</div>\r
819\r
820END\r
821;\r
822\r
823 &showmenu();\r
824\r
825print <<END\r
826<div id="content">\r
827 <table width="90%">\r
828 <tr>\r
829 <td valign="top">\r
830END\r
831;\r
832 \r
833 &showsubsection($menu);\r
834\r
835 print <<END\r
836\r
837 </td>\r
838 <td width="100%" valign="top">\r
839 <div id="page-content">\r
840 <h2>$h2</h2>\r
841END\r
842 ;\r
843 \r
844 &showsubsubsection($menu);\r
845\r
846 eval {\r
847 require 'ipfire-network.pl';\r
848 $supported = check_support();\r
849 warn_unsupported($supported);\r
850 };\r
851}\r
852\r
853sub closepage () {\r
854 my $status = &connectionstatus();\r
855 $uptime = `/usr/bin/uptime`;\r
856 \r
857 print <<END\r
858 <div align="center">\r
859 <p>\r
860 <div style="font-size: 9px"><b>Status:</b> $status <b>Uptime:</b>$uptime</div>\r
861 </p>\r
862 <p><a href="http://www.ipfire.org">IPFire</a> $version (c)</p>\r
863 </div>\r
864 </body>\r
865 <meta http-equiv="Page-Enter" content="blendTrans(Duration=1.0,Transition=12)">\r
866 <meta http-equiv="Page-Exit" content="blendTrans(Duration=1.0,Transition=12)">\r
867</html>\r
868END\r
869;\r
870}\r
871\r
872sub openbigbox\r
873{\r
874 my $width = $_[0];\r
875 my $align = $_[1];\r
876 my $sideimg = $_[2];\r
877\r
878 if ($errormessage) {\r
879 $bgcolor = "style='background-color: $colourerr;'";\r
880 } else {\r
881 $bgcolor = '';\r
882 }\r
883}\r
884\r
885sub closebigbox\r
886{\r
887# print "</td></tr></table></td></tr></table>\n" \r
888}\r
889\r
890sub openbox\r
891{\r
892 $width = $_[0];\r
893 $align = $_[1];\r
894 $caption = $_[2];\r
895\r
896 if ($caption) { print "<h3>$caption</h3>\n"; } else { print "&nbsp;"; }\r
897 \r
898 print "<table class=\"list\"><tr><td align=\"$align\">\n";\r
899}\r
900\r
901sub closebox\r
902{\r
903 print "</td></tr></table><br><br>";\r
904}\r
905\r
906sub writehash\r
907{\r
908 my $filename = $_[0];\r
909 my $hash = $_[1];\r
910 \r
911 # write cgi vars to the file.\r
912 open(FILE, ">${filename}") or die "Unable to write file $filename";\r
913 flock FILE, 2;\r
914 foreach $var (keys %$hash) \r
915 {\r
916 $val = $hash->{$var};\r
917 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y\r
918 # location of the mouse are submitted as well, this was being written to the settings file causing\r
919 # some serious grief! This skips the variable.x and variable.y\r
920 if (!($var =~ /(.x|.y)$/)) {\r
921 if ($val =~ / /) {\r
922 $val = "\'$val\'"; }\r
923 if (!($var =~ /^ACTION/)) {\r
924 print FILE "${var}=${val}\n"; }\r
925 }\r
926 }\r
927 close FILE;\r
928}\r
929\r
930sub readhash\r
931{\r
932 my $filename = $_[0];\r
933 my $hash = $_[1];\r
934 my ($var, $val);\r
935\r
936 open(FILE, $filename) or die "Unable to read file $filename";\r
937 \r
938 while (<FILE>)\r
939 {\r
940 chop;\r
941 ($var, $val) = split /=/, $_, 2;\r
942 if ($var)\r
943 {\r
944 $val =~ s/^\'//g;\r
945 $val =~ s/\'$//g;\r
946\r
947 # Untaint variables read from hash\r
948 $var =~ /([A-Za-z0-9_-]*)/; $var = $1;\r
949 $val =~ /([\w\W]*)/; $val = $1;\r
950 $hash->{$var} = $val;\r
951 }\r
952 }\r
953 close FILE;\r
954}\r
955\r
956sub getcgihash {\r
957 my ($hash, $params) = @_;\r
958 my $cgi = CGI->new ();\r
959 $hash->{'__CGI__'} = $cgi;\r
960 return if ($ENV{'REQUEST_METHOD'} ne 'POST');\r
961 if (!$params->{'wantfile'}) {\r
962 $CGI::DISABLE_UPLOADS = 1;\r
963 $CGI::POST_MAX = 512 * 1024;\r
964 } else {\r
965 $CGI::POST_MAX = 10 * 1024 * 1024;\r
966 }\r
967\r
968 $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;\r
969 my $referer = $1;\r
970 $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;\r
971 my $servername = $1;\r
972 return if ($referer ne $servername);\r
973\r
974 ### Modified for getting multi-vars, split by |\r
975 %temp = $cgi->Vars();\r
976 foreach my $key (keys %temp) {\r
977 $hash->{$key} = $temp{$key};\r
978 $hash->{$key} =~ s/\0/|/g;\r
979 $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;\r
980 }\r
981\r
982 if (($params->{'wantfile'})&&($params->{'filevar'})) {\r
983 $hash->{$params->{'filevar'}} = $cgi->upload\r
984 ($params->{'filevar'});\r
985 }\r
986 return;\r
987}\r
988\r
989sub log\r
990{\r
991 my $logmessage = $_[0];\r
992 $logmessage =~ /([\w\W]*)/;\r
993 $logmessage = $1;\r
994 system('/usr/bin/logger', '-t', 'ipfire', $logmessage);\r
995}\r
996\r
997sub age\r
998{\r
999 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,\r
1000 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];\r
1001 my $now = time;\r
1002\r
1003 my $totalsecs = $now - $mtime;\r
1004 my $days = int($totalsecs / 86400);\r
1005 my $totalhours = int($totalsecs / 3600);\r
1006 my $hours = $totalhours % 24;\r
1007 my $totalmins = int($totalsecs / 60);\r
1008 my $mins = $totalmins % 60;\r
1009 my $secs = $totalsecs % 60;\r
1010\r
1011 return "${days}d ${hours}h ${mins}m ${secs}s";\r
1012}\r
1013\r
1014sub validip\r
1015{\r
1016 my $ip = $_[0];\r
1017\r
1018 if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {\r
1019 return 0; }\r
1020 else \r
1021 {\r
1022 @octets = ($1, $2, $3, $4);\r
1023 foreach $_ (@octets)\r
1024 {\r
1025 if (/^0./) {\r
1026 return 0; }\r
1027 if ($_ < 0 || $_ > 255) {\r
1028 return 0; }\r
1029 }\r
1030 return 1;\r
1031 }\r
1032}\r
1033\r
1034sub validmask\r
1035{\r
1036 my $mask = $_[0];\r
1037\r
1038 # secord part an ip?\r
1039 if (&validip($mask)) {\r
1040 return 1; }\r
1041 # second part a number?\r
1042 if (/^0/) {\r
1043 return 0; }\r
1044 if (!($mask =~ /^\d+$/)) {\r
1045 return 0; }\r
1046 if ($mask >= 0 && $mask <= 32) {\r
1047 return 1; }\r
1048 return 0;\r
1049}\r
1050\r
1051sub validipormask\r
1052{\r
1053 my $ipormask = $_[0];\r
1054\r
1055 # see if it is a IP only.\r
1056 if (&validip($ipormask)) {\r
1057 return 1; }\r
1058 # split it into number and mask.\r
1059 if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {\r
1060 return 0; }\r
1061 $ip = $1;\r
1062 $mask = $2;\r
1063 # first part not a ip?\r
1064 if (!(&validip($ip))) {\r
1065 return 0; }\r
1066 return &validmask($mask);\r
1067}\r
1068\r
1069sub validipandmask\r
1070{\r
1071 my $ipandmask = $_[0];\r
1072\r
1073 # split it into number and mask.\r
1074 if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {\r
1075 return 0; }\r
1076 $ip = $1;\r
1077 $mask = $2;\r
1078 # first part not a ip?\r
1079 if (!(&validip($ip))) {\r
1080 return 0; }\r
1081 return &validmask($mask);\r
1082}\r
1083\r
1084sub validport\r
1085{\r
1086 $_ = $_[0];\r
1087\r
1088 if (!/^\d+$/) {\r
1089 return 0; }\r
1090 if (/^0./) {\r
1091 return 0; }\r
1092 if ($_ >= 1 && $_ <= 65535) {\r
1093 return 1; }\r
1094 return 0;\r
1095}\r
1096\r
1097sub validmac\r
1098{\r
1099 my $checkmac = $_[0];\r
1100 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)\r
1101 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)\r
1102 {\r
1103 return 0;\r
1104 }\r
1105 return 1;\r
1106}\r
1107\r
1108sub validhostname\r
1109{\r
1110 # Checks a hostname against RFC1035\r
1111 my $hostname = $_[0];\r
1112\r
1113 # Each part should be at least two characters in length\r
1114 # but no more than 63 characters\r
1115 if (length ($hostname) < 2 || length ($hostname) > 63) {\r
1116 return 0;}\r
1117 # Only valid characters are a-z, A-Z, 0-9 and -\r
1118 if ($hostname !~ /^[a-zA-Z0-9-]*$/) {\r
1119 return 0;}\r
1120 # First character can only be a letter or a digit\r
1121 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1122 return 0;}\r
1123 # Last character can only be a letter or a digit\r
1124 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1125 return 0;}\r
1126 return 1;\r
1127}\r
1128\r
1129sub validdomainname\r
1130{\r
1131 # Checks a domain name against RFC1035\r
1132 my $domainname = $_[0];\r
1133 my @parts = split (/\./, $domainname); # Split hostname at the '.'\r
1134\r
1135 foreach $part (@parts) {\r
1136 # Each part should be at least two characters in length\r
1137 # but no more than 63 characters\r
1138 if (length ($part) < 2 || length ($part) > 63) {\r
1139 return 0;}\r
1140 # Only valid characters are a-z, A-Z, 0-9 and -\r
1141 if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
1142 return 0;}\r
1143 # First character can only be a letter or a digit\r
1144 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1145 return 0;}\r
1146 # Last character can only be a letter or a digit\r
1147 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1148 return 0;}\r
1149 }\r
1150 return 1;\r
1151}\r
1152\r
1153sub validfqdn\r
1154{\r
1155 # Checks a fully qualified domain name against RFC1035\r
1156 my $fqdn = $_[0];\r
1157 my @parts = split (/\./, $fqdn); # Split hostname at the '.'\r
1158 if (scalar(@parts) < 2) { # At least two parts should\r
1159 return 0;} # exist in a FQDN\r
1160 # (i.e. hostname.domain)\r
1161 foreach $part (@parts) {\r
1162 # Each part should be at least two characters in length\r
1163 # but no more than 63 characters\r
1164 if (length ($part) < 2 || length ($part) > 63) {\r
1165 return 0;}\r
1166 # Only valid characters are a-z, A-Z, 0-9 and -\r
1167 if ($part !~ /^[a-zA-Z0-9-]*$/) {\r
1168 return 0;}\r
1169 # First character can only be a letter or a digit\r
1170 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1171 return 0;}\r
1172 # Last character can only be a letter or a digit\r
1173 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {\r
1174 return 0;}\r
1175 }\r
1176 return 1;\r
1177}\r
1178\r
1179sub validportrange # used to check a port range \r
1180{\r
1181 my $port = $_[0]; # port values\r
1182 $port =~ tr/-/:/; # replace all - with colons just in case someone used -\r
1183 my $srcdst = $_[1]; # is it a source or destination port\r
1184\r
1185 if (!($port =~ /^(\d+)\:(\d+)$/)) {\r
1186 \r
1187 if (!(&validport($port))) { \r
1188 if ($srcdst eq 'src'){\r
1189 return $tr{'source port numbers'};\r
1190 } else {\r
1191 return $tr{'destination port numbers'};\r
1192 } \r
1193 }\r
1194 }\r
1195 else \r
1196 {\r
1197 @ports = ($1, $2);\r
1198 if ($1 >= $2){\r
1199 if ($srcdst eq 'src'){\r
1200 return $tr{'bad source range'};\r
1201 } else {\r
1202 return $tr{'bad destination range'};\r
1203 } \r
1204 }\r
1205 foreach $_ (@ports)\r
1206 {\r
1207 if (!(&validport($_))) {\r
1208 if ($srcdst eq 'src'){\r
1209 return $tr{'source port numbers'}; \r
1210 } else {\r
1211 return $tr{'destination port numbers'};\r
1212 } \r
1213 }\r
1214 }\r
1215 return;\r
1216 }\r
1217}\r
1218\r
1219# Test if IP is within a subnet\r
1220# Call: IpInSubnet (Addr, Subnet, Subnet Mask)\r
1221# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1\r
1222# Everything in dottted notation\r
1223# Return: TRUE/FALSE\r
1224sub IpInSubnet\r
1225{\r
1226 $ip = unpack('N', inet_aton(shift));\r
1227 $start = unpack('N', inet_aton(shift));\r
1228 $mask = unpack('N', inet_aton(shift));\r
1229 $start &= $mask; # base of subnet...\r
1230 $end = $start + ~$mask;\r
1231 return (($ip >= $start) && ($ip <= $end));\r
1232}\r
1233\r
1234sub validemail {\r
1235 my $mail = shift;\r
1236 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );\r
1237 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);\r
1238 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );\r
1239 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );\r
1240 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );\r
1241 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );\r
1242 return 0 if ( $mail !~ /\.([a-zA-Z]{2,3})$/ );\r
1243 return 1;\r
1244}\r
1245\r
1246sub readhasharray {\r
1247 my ($filename, $hash) = @_;\r
1248\r
1249 open(FILE, $filename) or die "Unable to read file $filename";\r
1250\r
1251 while (<FILE>) {\r
1252 my ($key, $rest, @temp);\r
1253 chomp;\r
1254 ($key, $rest) = split (/,/, $_, 2);\r
1255 if ($key =~ /^[0-9]+$/ && $rest) {\r
1256 @temp = split (/,/, $rest);\r
1257 $hash->{$key} = \@temp;\r
1258 }\r
1259 }\r
1260 close FILE;\r
1261 return;\r
1262}\r
1263\r
1264sub writehasharray {\r
1265 my ($filename, $hash) = @_;\r
1266 my ($key, @temp);\r
1267\r
1268 open(FILE, ">$filename") or die "Unable to write to file $filename";\r
1269\r
1270 foreach $key (keys %$hash) {\r
1271 if ( $hash->{$key} ) {\r
1272 print FILE "$key";\r
1273 foreach $i (0 .. $#{$hash->{$key}}) {\r
1274 print FILE ",$hash->{$key}[$i]";\r
1275 }\r
1276 }\r
1277 print FILE "\n";\r
1278 }\r
1279 close FILE;\r
1280 return;\r
1281}\r
1282\r
1283sub findhasharraykey {\r
1284 foreach my $i (1 .. 1000000) {\r
1285 if ( ! exists $_[0]{$i}) {\r
1286 return $i;\r
1287 }\r
1288 }\r
1289}\r
1290\r
1291sub cleanhtml\r
1292{\r
1293 my $outstring =$_[0];\r
1294 $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';\r
1295 $outstring =~ s/&/&amp;/g;\r
1296 $outstring =~ s/\'/&#039;/g;\r
1297 $outstring =~ s/\"/&quot;/g;\r
1298 $outstring =~ s/</&lt;/g;\r
1299 $outstring =~ s/>/&gt;/g;\r
1300 return $outstring;\r
1301}\r
1302sub connectionstatus\r
1303{\r
1304 my $status;\r
1305 opendir UPLINKS, "/var/ipfire/uplinks" or die "Cannot read uplinks: $!";\r
1306 foreach my $uplink (sort grep !/^\./, readdir UPLINKS) {\r
1307 if ( -f "${swroot}/uplinks/${uplink}/active") {\r
1308 if ( ! $status ) {\r
1309 $timestr = &age("${swroot}/uplinks/${uplink}/active");\r
1310 $status = "$tr{'connected'}: $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";\r
1311 } else {\r
1312 $timestr = &age("${swroot}/uplinks/${uplink}/active");\r
1313 $status = "$status , $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";\r
1314 }\r
1315 } elsif ( -f "${swroot}/uplinks/${uplink}/connecting") {\r
1316 if ( ! $status ) {\r
1317 $status = "$tr{'connecting'} $uplink";\r
1318 } else {\r
1319 $status = "$status , $tr{'connecting'} $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";\r
1320 }\r
1321 }\r
1322 $lines++;\r
1323 }\r
1324 closedir(UPLINKS);\r
1325 if ( ! $status ) {\r
1326 $status = "$tr{'idle'}";\r
1327 }\r
1328 $connstate = "<span class='ipcop_StatusBig'>$status</span>";\r
1329 return $connstate;\r
1330}\r
1331\r
1332sub srtarray \r
1333# Darren Critchley - darrenc@telus.net - (c) 2003\r
1334# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)\r
1335# This subroutine will take the following parameters:\r
1336# ColumnNumber = the column which you want to sort on, starts at 1\r
1337# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic\r
1338# SortDirection = asc or dsc (lowercase) Ascending or Descending sort\r
1339# ArrayToBeSorted = the array that wants sorting\r
1340#\r
1341# Returns an array that is sorted to your specs\r
1342#\r
1343# If SortOrder is greater than the elements in array, then it defaults to the first element\r
1344# \r
1345{\r
1346 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;\r
1347 my @tmparray;\r
1348 my @srtedarray;\r
1349 my $line;\r
1350 my $newline;\r
1351 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array\r
1352 if ($ttlitems < 1){ # if no items, don't waste our time lets leave\r
1353 return (@tobesorted);\r
1354 }\r
1355 my @tmp = split(/\,/,$tobesorted[0]);\r
1356 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array\r
1357\r
1358 # Darren Critchley - validate parameters\r
1359 if ($colno > $ttlitems){$colno = '1';}\r
1360 $colno--; # remove one from colno to deal with arrays starting at 0\r
1361 if($colno < 0){$colno = '0';}\r
1362 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }\r
1363 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }\r
1364\r
1365 foreach $line (@tobesorted)\r
1366 {\r
1367 chomp($line);\r
1368 if ($line ne '') {\r
1369 my @temp = split(/\,/,$line);\r
1370 # Darren Critchley - juggle the fields so that the one we want to sort on is first\r
1371 my $tmpholder = $temp[0];\r
1372 $temp[0] = $temp[$colno];\r
1373 $temp[$colno] = $tmpholder;\r
1374 $newline = "";\r
1375 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {\r
1376 $newline=$newline . $temp[$ctr] . ",";\r
1377 }\r
1378 chop($newline);\r
1379 push(@tmparray,$newline);\r
1380 }\r
1381 }\r
1382 if ($alpnum eq 'n') {\r
1383 @tmparray = sort {$a <=> $b} @tmparray;\r
1384 } else {\r
1385 @tmparray = (sort @tmparray);\r
1386 }\r
1387 foreach $line (@tmparray)\r
1388 {\r
1389 chomp($line);\r
1390 if ($line ne '') {\r
1391 my @temp = split(/\,/,$line);\r
1392 my $tmpholder = $temp[0];\r
1393 $temp[0] = $temp[$colno];\r
1394 $temp[$colno] = $tmpholder;\r
1395 $newline = "";\r
1396 for ($ctr=0; $ctr < $ttlitems ; $ctr++){\r
1397 $newline=$newline . $temp[$ctr] . ",";\r
1398 }\r
1399 chop($newline);\r
1400 push(@srtedarray,$newline);\r
1401 }\r
1402 }\r
1403\r
1404 if ($srtdir eq 'dsc') {\r
1405 @tmparray = reverse(@srtedarray);\r
1406 return (@tmparray);\r
1407 } else {\r
1408 return (@srtedarray);\r
1409 }\r
1410}\r
1411\r
1412sub speedtouchversion\r
1413{\r
1414 if (-f "/proc/bus/usb/devices")\r
1415 {\r
1416 $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;\r
1417 if ($speedtouch eq '') {\r
1418 $speedtouch= $tr{'connect the modem'};\r
1419 }\r
1420 } else {\r
1421 $speedtouch='USB '.$tr{'not running'};\r
1422 }\r
1423 return $speedtouch\r
1424}\r
1425\r
1426sub CheckSortOrder {\r
1427#Sorting of allocated leases\r
1428 if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {\r
1429 my $newsort=$ENV{'QUERY_STRING'};\r
1430 &readhash("${swroot}/dhcp/settings", \%dhcpsettings);\r
1431 $act=$dhcpsettings{'SORT_LEASELIST'};\r
1432 #Reverse actual ?\r
1433 if ($act =~ $newsort) {\r
1434 if ($act !~ 'Rev') {$Rev='Rev'};\r
1435 $newsort.=$Rev\r
1436 };\r
1437\r
1438 $dhcpsettings{'SORT_LEASELIST'}=$newsort;\r
1439 &writehash("${swroot}/dhcp/settings", \%dhcpsettings);\r
1440 $dhcpsettings{'ACTION'} = 'SORT'; # avoid the next test "First lauch"\r
1441 }\r
1442\r
1443}\r
1444\r
1445sub PrintActualLeases\r
1446{\r
1447 &openbox('100%', 'left', $tr{'current dynamic leases'});\r
1448 print <<END\r
1449<table width='100%'>\r
1450<tr>\r
1451<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$tr{'ip address'}</b></a></td>\r
1452<td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$tr{'mac address'}</b></a></td>\r
1453<td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$tr{'hostname'}</b></a></td>\r
1454<td width='30%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$tr{'lease expires'} (local time d/m/y)</b></a></td>\r
1455</tr>\r
1456END\r
1457 ;\r
1458\r
1459 open(LEASES,"/var/lib/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";\r
1460 while ($line = <LEASES>) {\r
1461 next if( $line =~ /^\s*#/ );\r
1462 chomp($line);\r
1463 @temp = split (' ', $line);\r
1464\r
1465 if ($line =~ /^\s*lease/) {\r
1466 $ip = $temp[1];\r
1467 #All field are not necessarily read. Clear everything\r
1468 $endtime = 0;\r
1469 $ether = "";\r
1470 $hostname = "";\r
1471 }\r
1472\r
1473 if ($line =~ /^\s*ends/) {\r
1474 $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;\r
1475 $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);\r
1476 }\r
1477\r
1478 if ($line =~ /^\s*hardware ethernet/) {\r
1479 $ether = $temp[2];\r
1480 $ether =~ s/;//g;\r
1481 }\r
1482\r
1483 if ($line =~ /^\s*client-hostname/) {\r
1484 $hostname = "$temp[1] $temp[2] $temp[3]";\r
1485 $hostname =~ s/;//g;\r
1486 $hostname =~ s/\"//g;\r
1487 }\r
1488\r
1489 if ($line eq "}") {\r
1490 @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);\r
1491 $record = {}; # create a reference to empty hash\r
1492 %{$record} = @record; # populate that hash with @record\r
1493 $entries{$record->{'IPADDR'}} = $record; # add this to a hash of hashes\r
1494 }\r
1495 }\r
1496 close(LEASES);\r
1497\r
1498 my $id = 0;\r
1499 foreach my $key (sort leasesort keys %entries) {\r
1500\r
1501 my $hostname = &cleanhtml($entries{$key}->{HOSTNAME},"y");\r
1502\r
1503 if ($id % 2) {\r
1504 print "<tr bgcolor='$table1colour'>"; \r
1505 }\r
1506 else {\r
1507 print "<tr bgcolor='$table2colour'>"; \r
1508 }\r
1509\r
1510 print <<END\r
1511<td align='center'>$entries{$key}->{IPADDR}</td>\r
1512<td align='center'>$entries{$key}->{ETHER}</td>\r
1513<td align='center'>&nbsp;$hostname </td>\r
1514<td align='center'>\r
1515END\r
1516 ;\r
1517\r
1518 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});\r
1519 $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);\r
1520\r
1521 if ($entries{$key}->{ENDTIME} < time() ){\r
1522 print "<strike>$enddate</strike>";\r
1523 } else {\r
1524 print "$enddate";\r
1525 }\r
1526 print "</td></tr>";\r
1527 $id++;\r
1528 }\r
1529\r
1530 print "</table>";\r
1531 &closebox();\r
1532}\r
1533\r
1534\r
1535# This sub is used during display of actives leases\r
1536sub leasesort {\r
1537 if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)\r
1538 {\r
1539 $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);\r
1540 if ($qs eq 'IPADDR') {\r
1541 @a = split(/\./,$entries{$a}->{$qs});\r
1542 @b = split(/\./,$entries{$b}->{$qs});\r
1543 ($b[0]<=>$a[0]) ||\r
1544 ($b[1]<=>$a[1]) ||\r
1545 ($b[2]<=>$a[2]) ||\r
1546 ($b[3]<=>$a[3]);\r
1547 }else {\r
1548 $entries{$b}->{$qs} cmp $entries{$a}->{$qs};\r
1549 }\r
1550 }\r
1551 else #not reverse\r
1552 {\r
1553 $qs=$dhcpsettings{'SORT_LEASELIST'};\r
1554 if ($qs eq 'IPADDR') {\r
1555 @a = split(/\./,$entries{$a}->{$qs});\r
1556 @b = split(/\./,$entries{$b}->{$qs});\r
1557 ($a[0]<=>$b[0]) ||\r
1558 ($a[1]<=>$b[1]) ||\r
1559 ($a[2]<=>$b[2]) ||\r
1560 ($a[3]<=>$b[3]);\r
1561 }else {\r
1562 $entries{$a}->{$qs} cmp $entries{$b}->{$qs};\r
1563 }\r
1564 }\r
1565}\r
1566\r
1567sub get_uplinks() {\r
1568 my @uplinks = ();\r
1569 opendir(DIR, "${swroot}/uplinks/") || return \@uplinks;\r
1570 foreach my $dir (readdir(DIR)) {\r
1571 next if ($dir =~ /^\./);\r
1572 next if (-f "${swroot}/uplinks/$dir");\r
1573 push(@uplinks, $dir);\r
1574 }\r
1575 closedir(DIR);\r
1576 return \@uplinks;\r
1577}\r
1578\r
1579sub get_iface($) {\r
1580 my $filename = shift;\r
1581 chomp($filename);\r
1582 open (F, $filename) || return "";\r
1583 my $iface = <F>;\r
1584 close(F);\r
1585 chomp($iface);\r
1586 return $iface;\r
1587}\r
1588\r
1589sub get_red_ifaces_by_type($) {\r
1590 my $type=shift;\r
1591 my @gottypeiface = ();\r
1592 my @gottypeuplink = ();\r
1593 my @gottype = ();\r
1594\r
1595 my $ref=get_uplinks();\r
1596 my @uplinks=@$ref;\r
1597 my %set = ();\r
1598 foreach my $link (@uplinks) {\r
1599 eval {\r
1600 &readhash("${swroot}/uplinks/$link/settings", \%set);\r
1601 };\r
1602 push(@gottype, $link);\r
1603\r
1604 my $iface = $set{'RED_DEV'};\r
1605 if (!$iface) {\r
1606 $iface = get_iface("${swroot}/uplinks/$link/interface");\r
1607 }\r
1608 next if (!$iface);\r
1609\r
1610 if ($set{'RED_TYPE'} eq $type) {\r
1611 push(@gottypeiface, $iface);\r
1612 push(@gottypeuplink, $link);\r
1613 }\r
1614 }\r
1615 return (\@gottypeiface, \@gottypeuplink, \@gottype);\r
1616}\r
1617\r
1618sub get_red_ifaces() {\r
1619 return `cat ${swroot}/uplinks/*/interface 2>/dev/null`;\r
1620}\r
1621\r
1622sub get_zone_devices($) {\r
1623 my $bridge = shift;\r
1624 my @ifaces = ();\r
1625 open (FILE, "${swroot}/ethernet/$bridge") || return "";\r
1626 foreach my $line (<FILE>) {\r
1627 chomp($line);\r
1628 next if (!$line);\r
1629 push(@ifaces, $line);\r
1630 }\r
1631 close(FILE);\r
1632 return \@ifaces;\r
1633}\r
IPFire 2.x development tree