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     my %subipfirehash = ();
 462     my $subipfire = \%subipfirehash;
 463     $subipfire->{'01.pakfire'} = {'caption' => $tr{'pakfire'},
 464                                   'uri' => '/cgi-bin/pakfire.cgi',
 465                                   'title' => "$tr{'paketmanager'}",
 466                                   'enabled' => 1,
 467                                   };
 468     $subipfire->{'02.samba'} = {'caption' => $tr{'samba'},
 469                                   'uri' => '/cgi-bin/samba.cgi',
 470                                   'title' => "$tr{'samba'}",
 471                                   'enabled' => 1,
 472                                   };
 473
 474
 475
 476     $menu->{'01.system'} = {'caption' => $tr{'alt system'},
 477                             'enabled' => 1,
 478                             'subMenu' => $subsystem
 479                             };
 480     $menu->{'02.status'} = {'caption' => $tr{'status'},
 481                             'enabled' => 1,
 482                             'subMenu' => $substatus
 483                             };
 484     $menu->{'03.network'} = {'caption' => $tr{'network'},
 485                              'enabled' => 1,
 486                              'subMenu' => $subnetwork
 487                              };
 488     $menu->{'04.services'} = {'caption' => $tr{'alt services'},
 489                               'enabled' => 1,
 490                               'subMenu' => $subservices
 491                               };
 492     $menu->{'05.firewall'} = {'caption' => $tr{'firewall'},
 493                               'enabled' => 1,
 494                               'subMenu' => $subfirewall
 495                               };
 496     $menu->{'06.proxy'} = {'caption' => $tr{'alt proxy'},
 497                            'enabled' => 1,
 498                            'subMenu' => $subproxy
 499                            };
 500     $menu->{'07.vpn'} = {'caption' => 'VPN',
 501                          'enabled' => 1,
 502                          'subMenu' => $subvpn
 503                          };
 504     $menu->{'08.logs'} = {'caption' => $tr{'alt logs'},
 505                           'enabled' => 1,
 506                           'subMenu' => $sublogs
 507                           };
 508     $menu->{'09.ipfire'} = {'caption' => 'IPFire'},
 509                           'enabled' => 1,
 510                           'subMenu' => $subipfire
 511                           };
 512
 513
 514
 515     if (! blue_used() && ! orange_used()) {
 516         $menu->{'05.firewall'}{'subMenu'}->{'03.dmz'}{'enabled'} = 0;
 517     }
 518     if (-e '/etc/FLASH') {
 519         $menu{'06.proxy'}{'subMenu'}->{'01.http'}{'subMenu'}->{'01.proxy'}{'enabled'} = 0;  #disable squid
 520         $menu{'04.services'}{'subMenu'}->{'05.ids'}{'enabled'} = 0;  #disable ids
 521         $menu{'08.logs'}{'subMenu'}->{'05.ids'}{'enabled'} = 0;  #disable ids
 522     }
 523 }
 524
 525 sub showhttpheaders
 526 {
 527         print "Pragma: no-cache\n";
 528         print "Cache-control: no-cache\n";
 529         print "Connection: close\n";
 530         print "Content-type: text/html\n\n";
 531 }
 532
 533 sub is_menu_visible($) {
 534     my $link = shift;
 535     $link =~ s#\?.*$##;
 536     return (-e $ENV{'DOCUMENT_ROOT'}."/../$link");
 537 }
 538
 539
 540 sub getlink($) {
 541     my $root = shift;
 542     if (! $root->{'enabled'}) {
 543         return '';
 544     }
 545     if ($root->{'uri'} !~ /^$/) {
 546         my $vars = '';
 547         if ($root->{'vars'} !~ /^$/) {
 548             $vars = '?'. $root->{'vars'};
 549         }
 550         if (! is_menu_visible($root->{'uri'})) {
 551             return '';
 552         }
 553         return $root->{'uri'}.$vars;
 554     }
 555     my $submenus = $root->{'subMenu'};
 556     if (! $submenus) {
 557         return '';
 558     }
 559     foreach my $item (sort keys %$submenus) {
 560         my $link = getlink($submenus->{$item});
 561         if ($link ne '') {
 562             return $link;
 563         }
 564     }
 565     return '';
 566 }
 567
 568
 569 sub compare_url($) {
 570     my $conf = shift;
 571
 572     my $uri = $conf->{'uri'};
 573     my $vars = $conf->{'vars'};
 574     my $novars = $conf->{'novars'};
 575
 576     if ($uri eq '') {
 577         return 0;
 578     }
 579     if ($uri ne $URI[0]) {
 580         return 0;
 581     }
 582     if ($novars) {
 583         if ($URI[1] !~ /^$/) {
 584             return 0;
 585         }
 586     }
 587     if (! $vars) {
 588         return 1;
 589     }
 590     return ($URI[1] eq $vars);
 591 }
 592
 593
 594 sub gettitle($) {
 595     my $root = shift;
 596
 597     if (! $root) {
 598         return '';
 599     }
 600     foreach my $item (sort keys %$root) {
 601         my $val = $root->{$item};
 602         if (compare_url($val)) {
 603             $val->{'selected'} = 1;
 604             if ($val->{'title'} !~ /^$/) {
 605                 return $val->{'title'};
 606             }
 607             return 'EMPTY TITLE';
 608         }
 609
 610         my $title = gettitle($val->{'subMenu'});
 611         if ($title ne '') {
 612             $val->{'selected'} = 1;
 613             return $title;
 614         }
 615     }
 616     return '';
 617 }
 618
 619
 620 sub showmenu() {
 621     print <<EOF
 622   <div id="menu-top">
 623     <ul>
 624 EOF
 625 ;
 626     foreach my $k1 ( sort keys %$menu ) {
 627         if (! $menu->{$k1}{'enabled'}) {
 628             next;
 629         }
 630
 631         my $link = getlink($menu->{$k1});
 632         if ($link eq '') {
 633             next;
 634         }
 635         if (! is_menu_visible($link)) {
 636             next;
 637         }
 638         if ($menu->{$k1}->{'selected'}) {
 639             print '<li class="selected">';
 640         } else {
 641             print '<li>';
 642         }
 643
 644         print <<EOF
 645     <div class="rcorner">
 646       <a href="$link">$menu->{$k1}{'caption'}</a>
 647     </div>
 648   </li>
 649 EOF
 650 ;
 651     }
 652
 653     print <<EOF
 654     </ul>
 655   </div>
 656 EOF
 657 ;
 658 }
 659
 660 sub getselected($) {
 661     my $root = shift;
 662     if (!$root) {
 663         return 0;
 664     }
 665
 666     foreach my $item (%$root) {
 667         if ($root->{$item}{'selected'}) {
 668             return $root->{$item};
 669         }
 670     }
 671 }
 672
 673 sub showsubsection($$) {
 674     my $root = shift;
 675     my $id = shift;
 676     if ($id eq '') {
 677         $id = 'menu-left';
 678     }
 679
 680     if (! $root) {
 681         return;
 682     }
 683     my $selected = getselected($root);
 684     if (! $selected) {
 685         return;
 686     }
 687     my $submenus = $selected->{'subMenu'};
 688     if (! $submenus) {
 689         return;
 690     }
 691
 692     print <<EOF
 693   <div id="$id">
 694     <ul>
 695 EOF
 696 ;
 697     foreach my $item (sort keys %$submenus) {
 698         my $hash = $submenus->{$item};
 699         if (! $hash->{'enabled'}) {
 700             next;
 701         }
 702
 703         my $link = getlink($hash);
 704         if ($link eq '') {
 705             next;
 706         }
 707         if (! is_menu_visible($link)) {
 708             next;
 709         }
 710         if ($hash->{'selected'}) {
 711             print '<li class="selected">';
 712         } else {
 713             print '<li>';
 714         }
 715
 716         print <<EOF
 717       <a href="$link">$hash->{'caption'}</a>
 718   </li>
 719 EOF
 720 ;
 721     }
 722
 723     print <<EOF
 724     </ul>
 725   </div>
 726 EOF
 727 ;
 728
 729 }
 730
 731
 732 sub showsubsubsection($) {
 733     my $root = shift;
 734     if (!$root) {
 735         return;
 736     }
 737     my $selected = getselected($root);
 738     if (! $selected) {
 739         return
 740     }
 741     if (! $selected->{'subMenu'}) {
 742         return
 743     }
 744
 745     showsubsection($selected->{'subMenu'}, 'menu-subtop');
 746 }
 747
 748
 749 sub get_helpuri() {
 750     my $helpfile = '';
 751     if ($URI[0] =~ /.*\/([^\/]+)\.cgi/) {
 752         $helpfile = $1;
 753     } else {
 754         return '';
 755     }
 756     $helpfile .= '.help.html';
 757
 758     my $helpuri = '/doc/'.$language.'/'.$helpfile;
 759     if (! -e $ENV{'DOCUMENT_ROOT'}.$helpuri) {
 760         return '';
 761     }
 762     return $helpuri;
 763 }
 764
 765
 766 sub openpage {
 767     my $title = shift;
 768     my $boh = shift;
 769     my $extrahead = shift;
 770
 771     @URI=split ('\?',  $ENV{'REQUEST_URI'} );
 772     &readhash("${swroot}/main/settings", \%settings);
 773     &genmenu();
 774
 775     my $h2 = gettitle($menu);
 776     my $helpuri = get_helpuri();
 777
 778     $title = "IPFire - $title";
 779     if ($settings{'WINDOWWITHHOSTNAME'} eq 'on') {
 780         $title =  "$settings{'HOSTNAME'}.$settings{'DOMAINNAME'} - $title";
 781     }
 782
 783     print <<END
 784 <!DOCTYPE html
 785      PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 786      "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 787
 788 <html>
 789   <head>
 790   <title>$title</title>
 791
 792     $extrahead
 793     <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
 794     <link rel="shortcut icon" href="/favicon.ico" />
 795     <style type="text/css">\@import url(/include/style.css);</style>
 796     <style type="text/css">\@import url(/include/menu.css);</style>
 797     <style type="text/css">\@import url(/include/content.css);</style>
 798
 799     <script language="javascript" type="text/javascript">
 800
 801         function swapVisibility(id) {
 802             el = document.getElementById(id);
 803             if(el.style.display != 'block') {
 804                 el.style.display = 'block'
 805             }
 806             else {
 807                 el.style.display = 'none'
 808             }
 809         }
 810     </script>
 811
 812   </head>
 813   <body>
 814 <!-- IPFIRE HEADER -->
 815
 816 <div id="main">
 817
 818 <div id="header">
 819         <img id="logo-product" src="/images/logo_ipfire.gif">
 820    <div id="header-icons">
 821 END
 822 ;
 823
 824     if ($helpuri ne '') {
 825         print <<END
 826             <a href="$helpuri" target="_blank"><img border="0" src="/images/help.gif"></a>
 827 END
 828 ;
 829     } else {
 830         print '<img src="/images/help.gif">';
 831     }
 832
 833 print <<END
 834    </div>
 835 </div>
 836
 837 END
 838 ;
 839
 840     &showmenu();
 841
 842 print <<END
 843 <div id="content">
 844   <table width="90%">
 845     <tr>
 846       <td valign="top">
 847 END
 848 ;
 849
 850     &showsubsection($menu);
 851
 852     print <<END
 853
 854       </td>
 855         <td width="100%" valign="top">
 856         <div id="page-content">
 857             <h2>$h2</h2>
 858 END
 859     ;
 860
 861     &showsubsubsection($menu);
 862
 863     eval {
 864         require 'ipfire-network.pl';
 865         $supported = check_support();
 866         warn_unsupported($supported);
 867     };
 868 }
 869
 870 sub closepage () {
 871     my $status = &connectionstatus();
 872     $uptime = `/usr/bin/uptime`;
 873
 874     print <<END
 875           <div align="center">
 876             <p>
 877               <div style="font-size: 9px"><b>Status:</b> $status <b>Uptime:</b>$uptime</div>
 878             </p>
 879             <p><a href="http://www.ipfire.org">IPFire</a> $version (c)</p>
 880           </div>
 881         </body>
 882         <meta http-equiv="Page-Enter" content="blendTrans(Duration=1.0,Transition=12)">
 883         <meta http-equiv="Page-Exit" content="blendTrans(Duration=1.0,Transition=12)">
 884 </html>
 885 END
 886 ;
 887 }
 888
 889 sub openbigbox
 890 {
 891     my $width = $_[0];
 892     my $align = $_[1];
 893     my $sideimg = $_[2];
 894
 895     if ($errormessage) {
 896         $bgcolor = "style='background-color: $colourerr;'";
 897     } else {
 898         $bgcolor = '';
 899     }
 900 }
 901
 902 sub closebigbox
 903 {
 904 #       print "</td></tr></table></td></tr></table>\n"
 905 }
 906
 907 sub openbox
 908 {
 909         $width = $_[0];
 910         $align = $_[1];
 911         $caption = $_[2];
 912
 913         if ($caption) { print "<h3>$caption</h3>\n"; } else { print "&nbsp;"; }
 914
 915         print "<table class=\"list\"><tr><td align=\"$align\">\n";
 916 }
 917
 918 sub closebox
 919 {
 920         print "</td></tr></table><br><br>";
 921 }
 922
 923 sub writehash
 924 {
 925         my $filename = $_[0];
 926         my $hash = $_[1];
 927
 928         # write cgi vars to the file.
 929         open(FILE, ">${filename}") or die "Unable to write file $filename";
 930         flock FILE, 2;
 931         foreach $var (keys %$hash)
 932         {
 933                 $val = $hash->{$var};
 934                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 935                 # location of the mouse are submitted as well, this was being written to the settings file causing
 936                 # some serious grief! This skips the variable.x and variable.y
 937                 if (!($var =~ /(.x|.y)$/)) {
 938                         if ($val =~ / /) {
 939                                 $val = "\'$val\'"; }
 940                         if (!($var =~ /^ACTION/)) {
 941                                 print FILE "${var}=${val}\n"; }
 942                 }
 943         }
 944         close FILE;
 945 }
 946
 947 sub readhash
 948 {
 949         my $filename = $_[0];
 950         my $hash = $_[1];
 951         my ($var, $val);
 952
 953         open(FILE, $filename) or die "Unable to read file $filename";
 954
 955         while (<FILE>)
 956         {
 957                 chop;
 958                 ($var, $val) = split /=/, $_, 2;
 959                 if ($var)
 960                 {
 961                         $val =~ s/^\'//g;
 962                         $val =~ s/\'$//g;
 963
 964                         # Untaint variables read from hash
 965                         $var =~ /([A-Za-z0-9_-]*)/;        $var = $1;
 966                         $val =~ /([\w\W]*)/; $val = $1;
 967                         $hash->{$var} = $val;
 968                 }
 969         }
 970         close FILE;
 971 }
 972
 973 sub getcgihash {
 974         my ($hash, $params) = @_;
 975         my $cgi = CGI->new ();
 976         $hash->{'__CGI__'} = $cgi;
 977         return if ($ENV{'REQUEST_METHOD'} ne 'POST');
 978         if (!$params->{'wantfile'}) {
 979                 $CGI::DISABLE_UPLOADS = 1;
 980                 $CGI::POST_MAX        = 512 * 1024;
 981         } else {
 982                 $CGI::POST_MAX = 10 * 1024 * 1024;
 983         }
 984
 985         $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;
 986         my $referer = $1;
 987         $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;
 988         my $servername = $1;
 989         return if ($referer ne $servername);
 990
 991         ### Modified for getting multi-vars, split by |
 992         %temp = $cgi->Vars();
 993         foreach my $key (keys %temp) {
 994                 $hash->{$key} = $temp{$key};
 995                 $hash->{$key} =~ s/\0/|/g;
 996                 $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;
 997         }
 998
 999         if (($params->{'wantfile'})&&($params->{'filevar'})) {
1000                 $hash->{$params->{'filevar'}} = $cgi->upload
1001                                                 ($params->{'filevar'});
1002         }
1003         return;
1004 }
1005
1006 sub log
1007 {
1008         my $logmessage = $_[0];
1009         $logmessage =~ /([\w\W]*)/;
1010         $logmessage = $1;
1011         system('/usr/bin/logger', '-t', 'ipfire', $logmessage);
1012 }
1013
1014 sub age
1015 {
1016         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
1017                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
1018         my $now = time;
1019
1020         my $totalsecs = $now - $mtime;
1021         my $days = int($totalsecs / 86400);
1022         my $totalhours = int($totalsecs / 3600);
1023         my $hours = $totalhours % 24;
1024         my $totalmins = int($totalsecs / 60);
1025         my $mins = $totalmins % 60;
1026         my $secs = $totalsecs % 60;
1027
1028         return "${days}d ${hours}h ${mins}m ${secs}s";
1029 }
1030
1031 sub validip
1032 {
1033         my $ip = $_[0];
1034
1035         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
1036                 return 0; }
1037         else
1038         {
1039                 @octets = ($1, $2, $3, $4);
1040                 foreach $_ (@octets)
1041                 {
1042                         if (/^0./) {
1043                                 return 0; }
1044                         if ($_ < 0 || $_ > 255) {
1045                                 return 0; }
1046                 }
1047                 return 1;
1048         }
1049 }
1050
1051 sub validmask
1052 {
1053         my $mask = $_[0];
1054
1055         # secord part an ip?
1056         if (&validip($mask)) {
1057                 return 1; }
1058         # second part a number?
1059         if (/^0/) {
1060                 return 0; }
1061         if (!($mask =~ /^\d+$/)) {
1062                 return 0; }
1063         if ($mask >= 0 && $mask <= 32) {
1064                 return 1; }
1065         return 0;
1066 }
1067
1068 sub validipormask
1069 {
1070         my $ipormask = $_[0];
1071
1072         # see if it is a IP only.
1073         if (&validip($ipormask)) {
1074                 return 1; }
1075         # split it into number and mask.
1076         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
1077                 return 0; }
1078         $ip = $1;
1079         $mask = $2;
1080         # first part not a ip?
1081         if (!(&validip($ip))) {
1082                 return 0; }
1083         return &validmask($mask);
1084 }
1085
1086 sub validipandmask
1087 {
1088         my $ipandmask = $_[0];
1089
1090         # split it into number and mask.
1091         if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
1092                 return 0; }
1093         $ip = $1;
1094         $mask = $2;
1095         # first part not a ip?
1096         if (!(&validip($ip))) {
1097                 return 0; }
1098         return &validmask($mask);
1099 }
1100
1101 sub validport
1102 {
1103         $_ = $_[0];
1104
1105         if (!/^\d+$/) {
1106                 return 0; }
1107         if (/^0./) {
1108                 return 0; }
1109         if ($_ >= 1 && $_ <= 65535) {
1110                 return 1; }
1111         return 0;
1112 }
1113
1114 sub validmac
1115 {
1116         my $checkmac = $_[0];
1117         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
1118         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
1119         {
1120                 return 0;
1121         }
1122         return 1;
1123 }
1124
1125 sub validhostname
1126 {
1127         # Checks a hostname against RFC1035
1128         my $hostname = $_[0];
1129
1130         # Each part should be at least two characters in length
1131         # but no more than 63 characters
1132         if (length ($hostname) < 2 || length ($hostname) > 63) {
1133                 return 0;}
1134         # Only valid characters are a-z, A-Z, 0-9 and -
1135         if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
1136                 return 0;}
1137         # First character can only be a letter or a digit
1138         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
1139                 return 0;}
1140         # Last character can only be a letter or a digit
1141         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
1142                 return 0;}
1143         return 1;
1144 }
1145
1146 sub validdomainname
1147 {
1148         # Checks a domain name against RFC1035
1149         my $domainname = $_[0];
1150         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
1151
1152         foreach $part (@parts) {
1153                 # Each part should be at least two characters in length
1154                 # but no more than 63 characters
1155                 if (length ($part) < 2 || length ($part) > 63) {
1156                         return 0;}
1157                 # Only valid characters are a-z, A-Z, 0-9 and -
1158                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
1159                         return 0;}
1160                 # First character can only be a letter or a digit
1161                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
1162                         return 0;}
1163                 # Last character can only be a letter or a digit
1164                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
1165                         return 0;}
1166         }
1167         return 1;
1168 }
1169
1170 sub validfqdn
1171 {
1172         # Checks a fully qualified domain name against RFC1035
1173         my $fqdn = $_[0];
1174         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
1175         if (scalar(@parts) < 2) {               # At least two parts should
1176                 return 0;}                      # exist in a FQDN
1177                                                 # (i.e. hostname.domain)
1178         foreach $part (@parts) {
1179                 # Each part should be at least two characters in length
1180                 # but no more than 63 characters
1181                 if (length ($part) < 2 || length ($part) > 63) {
1182                         return 0;}
1183                 # Only valid characters are a-z, A-Z, 0-9 and -
1184                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
1185                         return 0;}
1186                 # First character can only be a letter or a digit
1187                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
1188                         return 0;}
1189                 # Last character can only be a letter or a digit
1190                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
1191                         return 0;}
1192         }
1193         return 1;
1194 }
1195
1196 sub validportrange # used to check a port range
1197 {
1198         my $port = $_[0]; # port values
1199         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
1200         my $srcdst = $_[1]; # is it a source or destination port
1201
1202         if (!($port =~ /^(\d+)\:(\d+)$/)) {
1203
1204                 if (!(&validport($port))) {
1205                         if ($srcdst eq 'src'){
1206                                 return $tr{'source port numbers'};
1207                         } else  {
1208                                 return $tr{'destination port numbers'};
1209                         }
1210                 }
1211         }
1212         else
1213         {
1214                 @ports = ($1, $2);
1215                 if ($1 >= $2){
1216                         if ($srcdst eq 'src'){
1217                                 return $tr{'bad source range'};
1218                         } else  {
1219                                 return $tr{'bad destination range'};
1220                         }
1221                 }
1222                 foreach $_ (@ports)
1223                 {
1224                         if (!(&validport($_))) {
1225                                 if ($srcdst eq 'src'){
1226                                         return $tr{'source port numbers'};
1227                                 } else  {
1228                                         return $tr{'destination port numbers'};
1229                                 }
1230                         }
1231                 }
1232                 return;
1233         }
1234 }
1235
1236 # Test if IP is within a subnet
1237 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
1238 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
1239 #       Everything in dottted notation
1240 # Return: TRUE/FALSE
1241 sub IpInSubnet
1242 {
1243     $ip = unpack('N', inet_aton(shift));
1244     $start = unpack('N', inet_aton(shift));
1245     $mask  = unpack('N', inet_aton(shift));
1246     $start &= $mask;  # base of subnet...
1247     $end   = $start + ~$mask;
1248     return (($ip >= $start) && ($ip <= $end));
1249 }
1250
1251 sub validemail {
1252     my $mail = shift;
1253     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
1254     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
1255     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
1256     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
1257     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
1258     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
1259     return 0 if ( $mail !~ /\.([a-zA-Z]{2,3})$/ );
1260     return 1;
1261 }
1262
1263 sub readhasharray {
1264     my ($filename, $hash) = @_;
1265
1266     open(FILE, $filename) or die "Unable to read file $filename";
1267
1268     while (<FILE>) {
1269         my ($key, $rest, @temp);
1270         chomp;
1271         ($key, $rest) = split (/,/, $_, 2);
1272         if ($key =~ /^[0-9]+$/ && $rest) {
1273             @temp = split (/,/, $rest);
1274             $hash->{$key} = \@temp;
1275         }
1276     }
1277     close FILE;
1278     return;
1279 }
1280
1281 sub writehasharray {
1282     my ($filename, $hash) = @_;
1283     my ($key, @temp);
1284
1285     open(FILE, ">$filename") or die "Unable to write to file $filename";
1286
1287     foreach $key (keys %$hash) {
1288         if ( $hash->{$key} ) {
1289             print FILE "$key";
1290             foreach $i (0 .. $#{$hash->{$key}}) {
1291                 print FILE ",$hash->{$key}[$i]";
1292             }
1293         }
1294         print FILE "\n";
1295     }
1296     close FILE;
1297     return;
1298 }
1299
1300 sub findhasharraykey {
1301     foreach my $i (1 .. 1000000) {
1302         if ( ! exists $_[0]{$i}) {
1303              return $i;
1304         }
1305     }
1306 }
1307
1308 sub cleanhtml
1309 {
1310         my $outstring =$_[0];
1311         $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';
1312         $outstring =~ s/&/&amp;/g;
1313         $outstring =~ s/\'/&#039;/g;
1314         $outstring =~ s/\"/&quot;/g;
1315         $outstring =~ s/</&lt;/g;
1316         $outstring =~ s/>/&gt;/g;
1317         return $outstring;
1318 }
1319 sub connectionstatus
1320 {
1321         my $status;
1322         opendir UPLINKS, "/var/ipfire/uplinks" or die "Cannot read uplinks: $!";
1323                 foreach my $uplink (sort grep !/^\./, readdir UPLINKS) {
1324                     if ( -f "${swroot}/uplinks/${uplink}/active") {
1325                         if ( ! $status ) {
1326                                 $timestr = &age("${swroot}/uplinks/${uplink}/active");
1327                                 $status = "$tr{'connected'}: $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";
1328                         } else {
1329                                 $timestr = &age("${swroot}/uplinks/${uplink}/active");
1330                                 $status = "$status , $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";
1331                         }
1332                     } elsif ( -f "${swroot}/uplinks/${uplink}/connecting") {
1333                         if ( ! $status ) {
1334                                 $status = "$tr{'connecting'} $uplink";
1335                         } else {
1336                                 $status = "$status , $tr{'connecting'} $uplink (<span class='ipcop_StatusBigRed'>$timestr</span>) ";
1337                         }
1338                     }
1339                     $lines++;
1340                 }
1341                 closedir(UPLINKS);
1342                 if ( ! $status ) {
1343                         $status = "$tr{'idle'}";
1344                 }
1345                 $connstate = "<span class='ipcop_StatusBig'>$status</span>";
1346     return $connstate;
1347 }
1348
1349 sub srtarray
1350 # Darren Critchley - darrenc@telus.net - (c) 2003
1351 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
1352 # This subroutine will take the following parameters:
1353 #   ColumnNumber = the column which you want to sort on, starts at 1
1354 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
1355 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
1356 #   ArrayToBeSorted = the array that wants sorting
1357 #
1358 #   Returns an array that is sorted to your specs
1359 #
1360 #   If SortOrder is greater than the elements in array, then it defaults to the first element
1361 #
1362 {
1363         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
1364         my @tmparray;
1365         my @srtedarray;
1366         my $line;
1367         my $newline;
1368         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
1369         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
1370                 return (@tobesorted);
1371         }
1372         my @tmp = split(/\,/,$tobesorted[0]);
1373         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
1374
1375         # Darren Critchley - validate parameters
1376         if ($colno > $ttlitems){$colno = '1';}
1377         $colno--; # remove one from colno to deal with arrays starting at 0
1378         if($colno < 0){$colno = '0';}
1379         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
1380         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
1381
1382         foreach $line (@tobesorted)
1383         {
1384                 chomp($line);
1385                 if ($line ne '') {
1386                         my @temp = split(/\,/,$line);
1387                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
1388                         my $tmpholder = $temp[0];
1389                         $temp[0] = $temp[$colno];
1390                         $temp[$colno] = $tmpholder;
1391                         $newline = "";
1392                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
1393                                 $newline=$newline . $temp[$ctr] . ",";
1394                         }
1395                         chop($newline);
1396                         push(@tmparray,$newline);
1397                 }
1398         }
1399         if ($alpnum eq 'n') {
1400                 @tmparray = sort {$a <=> $b} @tmparray;
1401         } else {
1402                 @tmparray = (sort @tmparray);
1403         }
1404         foreach $line (@tmparray)
1405         {
1406                 chomp($line);
1407                 if ($line ne '') {
1408                         my @temp = split(/\,/,$line);
1409                         my $tmpholder = $temp[0];
1410                         $temp[0] = $temp[$colno];
1411                         $temp[$colno] = $tmpholder;
1412                         $newline = "";
1413                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
1414                                 $newline=$newline . $temp[$ctr] . ",";
1415                         }
1416                         chop($newline);
1417                         push(@srtedarray,$newline);
1418                 }
1419         }
1420
1421         if ($srtdir eq 'dsc') {
1422                 @tmparray = reverse(@srtedarray);
1423                 return (@tmparray);
1424         } else {
1425                 return (@srtedarray);
1426         }
1427 }
1428
1429 sub speedtouchversion
1430 {
1431         if (-f "/proc/bus/usb/devices")
1432         {
1433                 $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;
1434                 if ($speedtouch eq '') {
1435                         $speedtouch= $tr{'connect the modem'};
1436                 }
1437         } else {
1438                 $speedtouch='USB '.$tr{'not running'};
1439         }
1440         return $speedtouch
1441 }
1442
1443 sub CheckSortOrder {
1444 #Sorting of allocated leases
1445     if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {
1446         my $newsort=$ENV{'QUERY_STRING'};
1447         &readhash("${swroot}/dhcp/settings", \%dhcpsettings);
1448         $act=$dhcpsettings{'SORT_LEASELIST'};
1449         #Reverse actual ?
1450         if ($act =~ $newsort) {
1451             if ($act !~ 'Rev') {$Rev='Rev'};
1452             $newsort.=$Rev
1453         };
1454
1455         $dhcpsettings{'SORT_LEASELIST'}=$newsort;
1456         &writehash("${swroot}/dhcp/settings", \%dhcpsettings);
1457         $dhcpsettings{'ACTION'} = 'SORT';  # avoid the next test "First lauch"
1458     }
1459
1460 }
1461
1462 sub PrintActualLeases
1463 {
1464     &openbox('100%', 'left', $tr{'current dynamic leases'});
1465     print <<END
1466 <table width='100%'>
1467 <tr>
1468 <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$tr{'ip address'}</b></a></td>
1469 <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$tr{'mac address'}</b></a></td>
1470 <td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$tr{'hostname'}</b></a></td>
1471 <td width='30%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$tr{'lease expires'} (local time d/m/y)</b></a></td>
1472 </tr>
1473 END
1474     ;
1475
1476     open(LEASES,"/var/lib/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";
1477     while ($line = <LEASES>) {
1478         next if( $line =~ /^\s*#/ );
1479         chomp($line);
1480         @temp = split (' ', $line);
1481
1482         if ($line =~ /^\s*lease/) {
1483             $ip = $temp[1];
1484             #All field are not necessarily read. Clear everything
1485             $endtime = 0;
1486             $ether = "";
1487             $hostname = "";
1488         }
1489
1490         if ($line =~ /^\s*ends/) {
1491             $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;
1492             $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);
1493         }
1494
1495         if ($line =~ /^\s*hardware ethernet/) {
1496             $ether = $temp[2];
1497             $ether =~ s/;//g;
1498         }
1499
1500         if ($line =~ /^\s*client-hostname/) {
1501             $hostname = "$temp[1] $temp[2] $temp[3]";
1502             $hostname =~ s/;//g;
1503             $hostname =~ s/\"//g;
1504         }
1505
1506         if ($line eq "}") {
1507             @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);
1508             $record = {};                                       # create a reference to empty hash
1509             %{$record} = @record;                               # populate that hash with @record
1510             $entries{$record->{'IPADDR'}} = $record;    # add this to a hash of hashes
1511         }
1512     }
1513     close(LEASES);
1514
1515     my $id = 0;
1516     foreach my $key (sort leasesort keys %entries) {
1517
1518         my $hostname = &cleanhtml($entries{$key}->{HOSTNAME},"y");
1519
1520         if ($id % 2) {
1521             print "<tr bgcolor='$table1colour'>";
1522         }
1523         else {
1524             print "<tr bgcolor='$table2colour'>";
1525         }
1526
1527         print <<END
1528 <td align='center'>$entries{$key}->{IPADDR}</td>
1529 <td align='center'>$entries{$key}->{ETHER}</td>
1530 <td align='center'>&nbsp;$hostname </td>
1531 <td align='center'>
1532 END
1533         ;
1534
1535         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});
1536         $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);
1537
1538         if ($entries{$key}->{ENDTIME} < time() ){
1539             print "<strike>$enddate</strike>";
1540         } else {
1541             print "$enddate";
1542         }
1543         print "</td></tr>";
1544         $id++;
1545     }
1546
1547     print "</table>";
1548     &closebox();
1549 }
1550
1551
1552 # This sub is used during display of actives leases
1553 sub leasesort {
1554     if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)
1555     {
1556         $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);
1557         if ($qs eq 'IPADDR') {
1558             @a = split(/\./,$entries{$a}->{$qs});
1559             @b = split(/\./,$entries{$b}->{$qs});
1560             ($b[0]<=>$a[0]) ||
1561             ($b[1]<=>$a[1]) ||
1562             ($b[2]<=>$a[2]) ||
1563             ($b[3]<=>$a[3]);
1564         }else {
1565             $entries{$b}->{$qs} cmp $entries{$a}->{$qs};
1566         }
1567     }
1568     else #not reverse
1569     {
1570         $qs=$dhcpsettings{'SORT_LEASELIST'};
1571         if ($qs eq 'IPADDR') {
1572             @a = split(/\./,$entries{$a}->{$qs});
1573             @b = split(/\./,$entries{$b}->{$qs});
1574             ($a[0]<=>$b[0]) ||
1575             ($a[1]<=>$b[1]) ||
1576             ($a[2]<=>$b[2]) ||
1577             ($a[3]<=>$b[3]);
1578         }else {
1579             $entries{$a}->{$qs} cmp $entries{$b}->{$qs};
1580         }
1581     }
1582 }
1583
1584 sub get_uplinks() {
1585     my @uplinks = ();
1586     opendir(DIR, "${swroot}/uplinks/") || return \@uplinks;
1587     foreach my $dir (readdir(DIR)) {
1588         next if ($dir =~ /^\./);
1589         next if (-f "${swroot}/uplinks/$dir");
1590         push(@uplinks, $dir);
1591     }
1592     closedir(DIR);
1593     return \@uplinks;
1594 }
1595
1596 sub get_iface($) {
1597     my $filename = shift;
1598     chomp($filename);
1599     open (F, $filename) || return "";
1600     my $iface = <F>;
1601     close(F);
1602     chomp($iface);
1603     return $iface;
1604 }
1605
1606 sub get_red_ifaces_by_type($) {
1607     my $type=shift;
1608     my @gottypeiface = ();
1609     my @gottypeuplink = ();
1610     my @gottype = ();
1611
1612     my $ref=get_uplinks();
1613     my @uplinks=@$ref;
1614     my %set = ();
1615     foreach my $link (@uplinks) {
1616         eval {
1617             &readhash("${swroot}/uplinks/$link/settings", \%set);
1618         };
1619         push(@gottype, $link);
1620
1621         my $iface = $set{'RED_DEV'};
1622         if (!$iface) {
1623             $iface = get_iface("${swroot}/uplinks/$link/interface");
1624         }
1625         next if (!$iface);
1626
1627         if ($set{'RED_TYPE'} eq $type) {
1628             push(@gottypeiface, $iface);
1629             push(@gottypeuplink, $link);
1630         }
1631     }
1632     return (\@gottypeiface, \@gottypeuplink, \@gottype);
1633 }
1634
1635 sub get_red_ifaces() {
1636     return `cat ${swroot}/uplinks/*/interface 2>/dev/null`;
1637 }
1638
1639 sub get_zone_devices($) {
1640     my $bridge = shift;
1641     my @ifaces = ();
1642     open (FILE, "${swroot}/ethernet/$bridge") || return "";
1643     foreach my $line (<FILE>) {
1644         chomp($line);
1645         next if (!$line);
1646         push(@ifaces, $line);
1647     }
1648     close(FILE);
1649     return \@ifaces;
1650 }