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