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