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