config/cfgroot/header.pl

   1 # SmoothWall CGIs
   2 #
   3 # This code is distributed under the terms of the GPL
   4 #
   5 # (c) The SmoothWall Team
   6 # Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
   7 # Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
   8 # Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
   9 # Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
  10 # Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
  11 #
  12 package Header;
  13
  14 use CGI();
  15 use Socket;
  16 use Time::Local;
  17
  18 $|=1; # line buffering
  19
  20 $Header::revision = 'final';
  21 $Header::swroot = '/var/ipfire';
  22 $Header::graphdir='/srv/web/ipfire/html/graphs';
  23 $Header::pagecolour = '#ffffff';
  24 #$Header::tablecolour = '#a0a0a0';
  25 $Header::tablecolour = '#FFFFFF';
  26 $Header::bigboxcolour = '#F6F4F4';
  27 $Header::boxcolour = '#EAE9EE';
  28 $Header::bordercolour = '#000000';
  29 $Header::table1colour = '#E0E0E0';
  30 $Header::table2colour = '#F0F0F0';
  31 $Header::colourred = '#993333';
  32 $Header::colourorange = '#FF9933';
  33 $Header::colouryellow = '#FFFF00';
  34 $Header::colourgreen = '#339933';
  35 $Header::colourblue = '#333399';
  36 $Header::colourovpn = '#339999';
  37 $Header::colourfw = '#000000';
  38 $Header::colourvpn = '#990099';
  39 $Header::colourerr = '#FF0000';
  40 $Header::viewsize = 150;
  41 $Header::errormessage = '';
  42 my %menuhash = ();
  43 my $menu = \%menuhash;
  44 %settings = ();
  45 %ethsettings = ();
  46 @URI = ();
  47
  48 ### Make sure this is an SSL request
  49 if ($ENV{'SERVER_ADDR'} && $ENV{'HTTPS'} ne 'on') {
  50     print "Status: 302 Moved\r\n";
  51     print "Location: https://$ENV{'SERVER_ADDR'}:444/$ENV{'PATH_INFO'}\r\n\r\n";
  52     exit 0;
  53 }
  54
  55 ### Initialize environment
  56 &readhash("${swroot}/main/settings", \%settings);
  57 &readhash("${swroot}/ethernet/settings", \%ethsettings);
  58 $language = $settings{'LANGUAGE'};
  59 $hostname = $settings{'HOSTNAME'};
  60 $hostnameintitle = 0;
  61
  62 ### Initialize language
  63 if ($language =~ /^(\w+)$/) {$language = $1;}
  64
  65 ### Read English Files
  66 if ( -d "/var/ipfire/langs/en/" ) {
  67     opendir(DIR, "/var/ipfire/langs/en/");
  68     @names = readdir(DIR) or die "Cannot Read Directory: $!\n";
  69     foreach $name(@names) {
  70         next if ($name eq ".");
  71         next if ($name eq "..");
  72         next if (!($name =~ /\.pl$/));
  73         require "${swroot}/langs/en/${name}";
  74     };
  75 };
  76
  77
  78 ### Enable Language Files
  79 if ( -d "/var/ipfire/langs/${language}/" ) {
  80     opendir(DIR, "/var/ipfire/langs/${language}/");
  81     @names = readdir(DIR) or die "Cannot Read Directory: $!\n";
  82     foreach $name(@names) {
  83         next if ($name eq ".");
  84         next if ($name eq "..");
  85         next if (!($name =~ /\.pl$/));
  86         require "${swroot}/langs/${language}/${name}";
  87     };
  88 };
  89
  90 ### Read IPFire Buildversion
  91 $FIREBUILD = "File not found: firebuild\n";
  92 if (open(MYFile, "<${swroot}/firebuild")) {
  93     $FIREBUILD = <MYFile>;
  94     chomp($FIREBUILD);
  95     $FIREBUILD = "(Build: $FIREBUILD)";
  96     close(MYFile);
  97 };
  98
  99 require "${swroot}/langs/en.pl";
 100 require "${swroot}/langs/${language}.pl";
 101 eval `/bin/cat /srv/web/ipfire/html/themes/$settings{'THEME'}/include/functions.pl`;
 102
 103 sub orange_used () {
 104     if ($ethsettings{'CONFIG_TYPE'} =~ /^[1357]$/) {
 105         return 1;
 106     }
 107     return 0;
 108 }
 109
 110 sub blue_used () {
 111     if ($ethsettings{'CONFIG_TYPE'} =~ /^[4567]$/) {
 112         return 1;
 113     }
 114     return 0;
 115 }
 116
 117 sub is_modem {
 118     if ($ethsettings{'CONFIG_TYPE'} =~ /^[0145]$/) {
 119         return 1;
 120     }
 121     return 0;
 122 }
 123
 124 ### Initialize menu
 125 sub genmenu {
 126
 127     my %subsystemhash = ();
 128     my $subsystem = \%subsystemhash;
 129
 130     my %substatushash = ();
 131     my $substatus = \%substatushash;
 132
 133     my %subnetworkhash = ();
 134     my $subnetwork = \%subnetworkhash;
 135
 136     my %subserviceshash = ();
 137     my $subservices = \%subserviceshash;
 138
 139     my %subfirewallhash = ();
 140     my $subfirewall = \%subfirewallhash;
 141
 142     my %subipfirehash = ();
 143     my $subipfire = \%subipfirehash;
 144
 145     my %sublogshash = ();
 146     my $sublogs = \%sublogshash;
 147
 148     eval `/bin/cat /var/ipfire/menu.d/*.menu`;
 149     eval `/bin/cat /var/ipfire/menu.d/*.main`;
 150
 151     if (! blue_used() && ! orange_used()) {
 152         $menu->{'05.firewall'}{'subMenu'}->{'40.dmz'}{'enabled'} = 0;
 153     }
 154     if (! blue_used()) {
 155         $menu->{'05.firewall'}{'subMenu'}->{'30.wireless'}{'enabled'} = 0;
 156     }
 157     if ( $ethsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $ethsettings{'RED_TYPE'} eq 'STATIC' ) {
 158         $menu->{'03.network'}{'subMenu'}->{'70.aliases'}{'enabled'} = 1;
 159     }
 160 }
 161
 162 sub showhttpheaders
 163 {
 164         print "Pragma: no-cache\n";
 165         print "Cache-control: no-cache\n";
 166         print "Connection: close\n";
 167         print "Content-type: text/html\n\n";
 168 }
 169
 170 sub is_menu_visible($) {
 171     my $link = shift;
 172     $link =~ s#\?.*$##;
 173     return (-e $ENV{'DOCUMENT_ROOT'}."/../$link");
 174 }
 175
 176
 177 sub getlink($) {
 178     my $root = shift;
 179     if (! $root->{'enabled'}) {
 180         return '';
 181     }
 182     if ($root->{'uri'} !~ /^$/) {
 183         my $vars = '';
 184         if ($root->{'vars'} !~ /^$/) {
 185             $vars = '?'. $root->{'vars'};
 186         }
 187         if (! is_menu_visible($root->{'uri'})) {
 188             return '';
 189         }
 190         return $root->{'uri'}.$vars;
 191     }
 192     my $submenus = $root->{'subMenu'};
 193     if (! $submenus) {
 194         return '';
 195     }
 196     foreach my $item (sort keys %$submenus) {
 197         my $link = getlink($submenus->{$item});
 198         if ($link ne '') {
 199             return $link;
 200         }
 201     }
 202     return '';
 203 }
 204
 205
 206 sub compare_url($) {
 207     my $conf = shift;
 208
 209     my $uri = $conf->{'uri'};
 210     my $vars = $conf->{'vars'};
 211     my $novars = $conf->{'novars'};
 212
 213     if ($uri eq '') {
 214         return 0;
 215     }
 216     if ($uri ne $URI[0]) {
 217         return 0;
 218     }
 219     if ($novars) {
 220         if ($URI[1] !~ /^$/) {
 221             return 0;
 222         }
 223     }
 224     if (! $vars) {
 225         return 1;
 226     }
 227     return ($URI[1] eq $vars);
 228 }
 229
 230
 231 sub gettitle($) {
 232     my $root = shift;
 233
 234     if (! $root) {
 235         return '';
 236     }
 237     foreach my $item (sort keys %$root) {
 238         my $val = $root->{$item};
 239         if (compare_url($val)) {
 240             $val->{'selected'} = 1;
 241             if ($val->{'title'} !~ /^$/) {
 242                 return $val->{'title'};
 243             }
 244             return 'EMPTY TITLE';
 245         }
 246
 247         my $title = gettitle($val->{'subMenu'});
 248         if ($title ne '') {
 249             $val->{'selected'} = 1;
 250             return $title;
 251         }
 252     }
 253     return '';
 254 }
 255
 256 sub writehash
 257 {
 258         my $filename = $_[0];
 259         my $hash = $_[1];
 260
 261         # write cgi vars to the file.
 262         open(FILE, ">${filename}") or die "Unable to write file $filename";
 263         flock FILE, 2;
 264         foreach $var (keys %$hash)
 265         {
 266                 $val = $hash->{$var};
 267                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 268                 # location of the mouse are submitted as well, this was being written to the settings file causing
 269                 # some serious grief! This skips the variable.x and variable.y
 270                 if (!($var =~ /(.x|.y)$/)) {
 271                         if ($val =~ / /) {
 272                                 $val = "\'$val\'"; }
 273                         if (!($var =~ /^ACTION/)) {
 274                                 print FILE "${var}=${val}\n"; }
 275                 }
 276         }
 277         close FILE;
 278 }
 279
 280 sub readhash
 281 {
 282         my $filename = $_[0];
 283         my $hash = $_[1];
 284         my ($var, $val);
 285
 286         open(FILE, $filename) or die "Unable to read file $filename";
 287
 288         while (<FILE>)
 289         {
 290                 chop;
 291                 ($var, $val) = split /=/, $_, 2;
 292                 if ($var)
 293                 {
 294                         $val =~ s/^\'//g;
 295                         $val =~ s/\'$//g;
 296
 297                         # Untaint variables read from hash
 298                         $var =~ /([A-Za-z0-9_-]*)/;        $var = $1;
 299                         $val =~ /([\w\W]*)/; $val = $1;
 300                         $hash->{$var} = $val;
 301                 }
 302         }
 303         close FILE;
 304 }
 305
 306 sub getcgihash {
 307         my ($hash, $params) = @_;
 308         my $cgi = CGI->new ();
 309         $hash->{'__CGI__'} = $cgi;
 310         return if ($ENV{'REQUEST_METHOD'} ne 'POST');
 311         if (!$params->{'wantfile'}) {
 312                 $CGI::DISABLE_UPLOADS = 1;
 313                 $CGI::POST_MAX        = 512 * 1024;
 314         } else {
 315                 $CGI::POST_MAX = 10 * 1024 * 1024;
 316         }
 317
 318         $cgi->referer() =~ m/^https?\:\/\/([^\/]+)/;
 319         my $referer = $1;
 320         $cgi->url() =~ m/^https?\:\/\/([^\/]+)/;
 321         my $servername = $1;
 322         return if ($referer ne $servername);
 323
 324         ### Modified for getting multi-vars, split by |
 325         %temp = $cgi->Vars();
 326         foreach my $key (keys %temp) {
 327                 $hash->{$key} = $temp{$key};
 328                 $hash->{$key} =~ s/\0/|/g;
 329                 $hash->{$key} =~ s/^\s*(.*?)\s*$/$1/;
 330         }
 331
 332         if (($params->{'wantfile'})&&($params->{'filevar'})) {
 333                 $hash->{$params->{'filevar'}} = $cgi->upload
 334                                                 ($params->{'filevar'});
 335         }
 336         return;
 337 }
 338
 339 sub log
 340 {
 341         my $logmessage = $_[0];
 342         $logmessage =~ /([\w\W]*)/;
 343         $logmessage = $1;
 344         system('/usr/bin/logger', '-t', 'ipfire', $logmessage);
 345 }
 346
 347 sub age
 348 {
 349         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 350                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 351         my $now = time;
 352
 353         my $totalsecs = $now - $mtime;
 354         my $days = int($totalsecs / 86400);
 355         my $totalhours = int($totalsecs / 3600);
 356         my $hours = $totalhours % 24;
 357         my $totalmins = int($totalsecs / 60);
 358         my $mins = $totalmins % 60;
 359         my $secs = $totalsecs % 60;
 360
 361         return "${days}d ${hours}h ${mins}m ${secs}s";
 362 }
 363
 364 sub validip
 365 {
 366         my $ip = $_[0];
 367
 368         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 369                 return 0; }
 370         else
 371         {
 372                 @octets = ($1, $2, $3, $4);
 373                 foreach $_ (@octets)
 374                 {
 375                         if (/^0./) {
 376                                 return 0; }
 377                         if ($_ < 0 || $_ > 255) {
 378                                 return 0; }
 379                 }
 380                 return 1;
 381         }
 382 }
 383
 384 sub validmask
 385 {
 386         my $mask = $_[0];
 387
 388         # secord part an ip?
 389         if (&validip($mask)) {
 390                 return 1; }
 391         # second part a number?
 392         if (/^0/) {
 393                 return 0; }
 394         if (!($mask =~ /^\d+$/)) {
 395                 return 0; }
 396         if ($mask >= 0 && $mask <= 32) {
 397                 return 1; }
 398         return 0;
 399 }
 400
 401 sub validipormask
 402 {
 403         my $ipormask = $_[0];
 404
 405         # see if it is a IP only.
 406         if (&validip($ipormask)) {
 407                 return 1; }
 408         # split it into number and mask.
 409         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 410                 return 0; }
 411         $ip = $1;
 412         $mask = $2;
 413         # first part not a ip?
 414         if (!(&validip($ip))) {
 415                 return 0; }
 416         return &validmask($mask);
 417 }
 418
 419 sub validipandmask
 420 {
 421         my $ipandmask = $_[0];
 422
 423         # split it into number and mask.
 424         if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
 425                 return 0; }
 426         $ip = $1;
 427         $mask = $2;
 428         # first part not a ip?
 429         if (!(&validip($ip))) {
 430                 return 0; }
 431         return &validmask($mask);
 432 }
 433
 434 sub validport
 435 {
 436         $_ = $_[0];
 437
 438         if (!/^\d+$/) {
 439                 return 0; }
 440         if (/^0./) {
 441                 return 0; }
 442         if ($_ >= 1 && $_ <= 65535) {
 443                 return 1; }
 444         return 0;
 445 }
 446
 447 sub validmac
 448 {
 449         my $checkmac = $_[0];
 450         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 451         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 452         {
 453                 return 0;
 454         }
 455         return 1;
 456 }
 457
 458 sub validhostname
 459 {
 460         # Checks a hostname against RFC1035
 461         my $hostname = $_[0];
 462
 463         # Each part should be at least two characters in length
 464         # but no more than 63 characters
 465         if (length ($hostname) < 2 || length ($hostname) > 63) {
 466                 return 0;}
 467         # Only valid characters are a-z, A-Z, 0-9 and -
 468         if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
 469                 return 0;}
 470         # First character can only be a letter or a digit
 471         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 472                 return 0;}
 473         # Last character can only be a letter or a digit
 474         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 475                 return 0;}
 476         return 1;
 477 }
 478
 479 sub validdomainname
 480 {
 481         # Checks a domain name against RFC1035
 482         my $domainname = $_[0];
 483         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 484
 485         foreach $part (@parts) {
 486                 # Each part should be at least two characters in length
 487                 # but no more than 63 characters
 488                 if (length ($part) < 2 || length ($part) > 63) {
 489                         return 0;}
 490                 # Only valid characters are a-z, A-Z, 0-9 and -
 491                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 492                         return 0;}
 493                 # First character can only be a letter or a digit
 494                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 495                         return 0;}
 496                 # Last character can only be a letter or a digit
 497                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 498                         return 0;}
 499         }
 500         return 1;
 501 }
 502
 503 sub validfqdn
 504 {
 505         # Checks a fully qualified domain name against RFC1035
 506         my $fqdn = $_[0];
 507         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 508         if (scalar(@parts) < 2) {               # At least two parts should
 509                 return 0;}                      # exist in a FQDN
 510                                                 # (i.e. hostname.domain)
 511         foreach $part (@parts) {
 512                 # Each part should be at least two characters in length
 513                 # but no more than 63 characters
 514                 if (length ($part) < 2 || length ($part) > 63) {
 515                         return 0;}
 516                 # Only valid characters are a-z, A-Z, 0-9 and -
 517                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 518                         return 0;}
 519                 # First character can only be a letter or a digit
 520                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 521                         return 0;}
 522                 # Last character can only be a letter or a digit
 523                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 524                         return 0;}
 525         }
 526         return 1;
 527 }
 528
 529 sub validportrange # used to check a port range
 530 {
 531         my $port = $_[0]; # port values
 532         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 533         my $srcdst = $_[1]; # is it a source or destination port
 534
 535         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 536
 537                 if (!(&validport($port))) {
 538                         if ($srcdst eq 'src'){
 539                                 return $tr{'source port numbers'};
 540                         } else  {
 541                                 return $tr{'destination port numbers'};
 542                         }
 543                 }
 544         }
 545         else
 546         {
 547                 @ports = ($1, $2);
 548                 if ($1 >= $2){
 549                         if ($srcdst eq 'src'){
 550                                 return $tr{'bad source range'};
 551                         } else  {
 552                                 return $tr{'bad destination range'};
 553                         }
 554                 }
 555                 foreach $_ (@ports)
 556                 {
 557                         if (!(&validport($_))) {
 558                                 if ($srcdst eq 'src'){
 559                                         return $tr{'source port numbers'};
 560                                 } else  {
 561                                         return $tr{'destination port numbers'};
 562                                 }
 563                         }
 564                 }
 565                 return;
 566         }
 567 }
 568
 569 # Test if IP is within a subnet
 570 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 571 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 572 #       Everything in dottted notation
 573 # Return: TRUE/FALSE
 574 sub IpInSubnet
 575 {
 576     $ip = unpack('N', inet_aton(shift));
 577     $start = unpack('N', inet_aton(shift));
 578     $mask  = unpack('N', inet_aton(shift));
 579     $start &= $mask;  # base of subnet...
 580     $end   = $start + ~$mask;
 581     return (($ip >= $start) && ($ip <= $end));
 582 }
 583
 584 sub validemail {
 585     my $mail = shift;
 586     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 587     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 588     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 589     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 590     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 591     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 592     return 0 if ( $mail !~ /\.([a-zA-Z]{2,3})$/ );
 593     return 1;
 594 }
 595
 596 sub readhasharray {
 597     my ($filename, $hash) = @_;
 598
 599     open(FILE, $filename) or die "Unable to read file $filename";
 600
 601     while (<FILE>) {
 602         my ($key, $rest, @temp);
 603         chomp;
 604         ($key, $rest) = split (/,/, $_, 2);
 605         if ($key =~ /^[0-9]+$/ && $rest) {
 606             @temp = split (/,/, $rest);
 607             $hash->{$key} = \@temp;
 608         }
 609     }
 610     close FILE;
 611     return;
 612 }
 613
 614 sub writehasharray {
 615     my ($filename, $hash) = @_;
 616     my ($key, @temp);
 617
 618     open(FILE, ">$filename") or die "Unable to write to file $filename";
 619
 620     foreach $key (keys %$hash) {
 621         if ( $hash->{$key} ) {
 622             print FILE "$key";
 623             foreach $i (0 .. $#{$hash->{$key}}) {
 624                 print FILE ",$hash->{$key}[$i]";
 625             }
 626         }
 627         print FILE "\n";
 628     }
 629     close FILE;
 630     return;
 631 }
 632
 633 sub findhasharraykey {
 634     foreach my $i (1 .. 1000000) {
 635         if ( ! exists $_[0]{$i}) {
 636              return $i;
 637         }
 638     }
 639 }
 640
 641 sub cleanhtml
 642 {
 643         my $outstring =$_[0];
 644         $outstring =~ tr/,/ / if not defined $_[1] or $_[1] ne 'y';
 645         $outstring =~ s/&/&amp;/g;
 646         $outstring =~ s/\'/&#039;/g;
 647         $outstring =~ s/\"/&quot;/g;
 648         $outstring =~ s/</&lt;/g;
 649         $outstring =~ s/>/&gt;/g;
 650         return $outstring;
 651 }
 652
 653 sub connectionstatus
 654 {
 655     my %pppsettings = ();
 656     my %netsettings = ();
 657     my $iface='';
 658
 659     $pppsettings{'PROFILENAME'} = 'None';
 660     &General::readhash("${General::swroot}/ppp/settings", \%pppsettings);
 661     &General::readhash("${General::swroot}/ethernet/settings", \%netsettings);
 662
 663     my $profileused='';
 664     if ( ! ( $netsettings{'CONFIG_TYPE'} =~ /^(2|3|6|7)$/ && $netsettings{'RED_TYPE'} =~ /^(DHCP|STATIC)$/ ) ) {
 665         $profileused="- $pppsettings{'PROFILENAME'}";
 666     }
 667
 668     if ( ( $pppsettings{'METHOD'} eq 'DHCP' && $netsettings{'RED_TYPE'} ne 'PPTP')
 669                                                 || $netsettings{'RED_TYPE'} eq 'DHCP' ) {
 670                 if (open(IFACE, "${General::swroot}/red/iface")) {
 671                         $iface = <IFACE>;
 672                         close IFACE;
 673                         chomp ($iface);
 674                         $iface =~ /([a-zA-Z0-9]*)/; $iface = $1;
 675                 }
 676     }
 677
 678     my ($timestr, $connstate);
 679     if ($netsettings{'CONFIG_TYPE'} =~ /^(0|1|4|5)$/ &&  $pppsettings{'TYPE'} =~ /^isdn/) {
 680         # Count ISDN channels
 681         my ($idmap, $chmap, $drmap, $usage, $flags, $phone);
 682         my @phonenumbers;
 683         my $count=0;
 684
 685         open (FILE, "/dev/isdninfo");
 686
 687         $idmap = <FILE>; chop $idmap;
 688         $chmap = <FILE>; chop $chmap;
 689         $drmap = <FILE>; chop $drmap;
 690         $usage = <FILE>; chop $usage;
 691         $flags = <FILE>; chop $flags;
 692         $phone = <FILE>; chop $phone;
 693
 694         $phone =~ s/^phone(\s*):(\s*)//;
 695
 696         @phonenumbers = split / /, $phone;
 697
 698         foreach (@phonenumbers) {
 699                 if ($_ ne '???') {
 700                         $count++;
 701                 }
 702         }
 703         close (FILE);
 704
 705         ## Connection status
 706         my $number;
 707         if ($count == 0) {
 708                 $number = 'none!';
 709         } elsif ($count == 1) {
 710                 $number = 'single';
 711         } else {
 712                 $number = 'dual';
 713         }
 714
 715         if (-e "${General::swroot}/red/active") {
 716                 $timestr = &General::age("${General::swroot}/red/active");
 717                 $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} - $number channel (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
 718         } else {
 719                 if ($count == 0) {
 720                         if (-e "${General::swroot}/red/dial-on-demand") {
 721                                 $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'dod waiting'} $profileused</span>";
 722                         } else {
 723                                 $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
 724                         }
 725                 } else {
 726                         $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connecting'} $profileused</span>";
 727                 }
 728         }
 729     } elsif ($netsettings{'RED_TYPE'} eq "STATIC" || $pppsettings {'METHOD'} eq 'STATIC') {
 730         if (-e "${General::swroot}/red/active") {
 731                 $timestr = &General::age("${General::swroot}/red/active");
 732                 $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'connected'} (<span class='ipcop_StatusBigRed'>$timestr</span>) $profileused</span>";
 733         } else {
 734                 $connstate = "<span class='ipcop_StatusBig'>$Lang::tr{'idle'} $profileused</span>";
 735         }
 736     } elsif ( ( (-e "${General::swroot}/dhcpc/dhcpcd-$iface.pid") && $netsettings{'RED_TYPE'} ne 'PPTP' ) ||
 737         !system("/bin/ps -ef | /bin/grep -q '[p]ppd'") || !system("/bin/ps -ef | /bin/grep -q '[c]onnectioncheck'")) {
 738         if (-e "${General::swroot}/red/active") {
 739                 $timestr = &General::age("${General::swroot}/red/active");
 740                 if ($pppsettings{'TYPE'} =~ /^(modem|bewanadsl|conexantpciadsl|eagleusbadsl)$/) {
 741                         my $speed;
 742                         if ($pppsettings{'TYPE'} eq 'modem') {
 743                                 open(CONNECTLOG, "/var/log/connect.log");
 744                                 while (<CONNECTLOG>) {
 745                                         if (/CONNECT/) {
 746                                                 $speed = (split / /)[6];
 747                                         }
 748                                 }
 749                                 close (CONNECTLOG);
 750                         } elsif ($pppsettings{'TYPE'} eq 'bewanadsl') {
 751                                 $speed = `/usr/bin/unicorn_status | /bin/grep Rate | /usr/bin/cut -f2 -d ':'`;
 752                         } elsif ($pppsettings{'TYPE'} eq 'conexantpciadsl') {
 753                                 $speed = `/bin/cat /proc/net/atm/CnxAdsl:* | /bin/grep 'Line Rates' | /bin/sed -e 's+Line Rates:   Receive+Rx+' -e 's+Transmit+Tx+'`;
 754                         } elsif ($pppsettings{'TYPE'} eq 'eagleusbadsl') {
 755                                 $speed = `/usr/sbin/eaglestat | /bin/grep Rate`;
 756                         }
 757                         $connstate = "$Lang::tr{'connected'} ($timestr) $profileused (\@$speed)";
 758                 } else {
 759                         $connstate = "$Lang::tr{'connected'} ($timestr) $profileused";
 760                 }
 761         } else {
 762                 if (-e "${General::swroot}/red/dial-on-demand") {
 763                     $connstate = "$Lang::tr{'dod waiting'} $profileused";
 764                 } else {
 765                     $connstate = "$Lang::tr{'connecting'} $profileused";
 766                 }
 767         }
 768     } else {
 769         $connstate = "$Lang::tr{'idle'} $profileused";
 770     }
 771     return $connstate;
 772 }
 773
 774 sub srtarray
 775 # Darren Critchley - darrenc@telus.net - (c) 2003
 776 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 777 # This subroutine will take the following parameters:
 778 #   ColumnNumber = the column which you want to sort on, starts at 1
 779 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 780 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 781 #   ArrayToBeSorted = the array that wants sorting
 782 #
 783 #   Returns an array that is sorted to your specs
 784 #
 785 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 786 #
 787 {
 788         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 789         my @tmparray;
 790         my @srtedarray;
 791         my $line;
 792         my $newline;
 793         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 794         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 795                 return (@tobesorted);
 796         }
 797         my @tmp = split(/\,/,$tobesorted[0]);
 798         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 799
 800         # Darren Critchley - validate parameters
 801         if ($colno > $ttlitems){$colno = '1';}
 802         $colno--; # remove one from colno to deal with arrays starting at 0
 803         if($colno < 0){$colno = '0';}
 804         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 805         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 806
 807         foreach $line (@tobesorted)
 808         {
 809                 chomp($line);
 810                 if ($line ne '') {
 811                         my @temp = split(/\,/,$line);
 812                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 813                         my $tmpholder = $temp[0];
 814                         $temp[0] = $temp[$colno];
 815                         $temp[$colno] = $tmpholder;
 816                         $newline = "";
 817                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 818                                 $newline=$newline . $temp[$ctr] . ",";
 819                         }
 820                         chop($newline);
 821                         push(@tmparray,$newline);
 822                 }
 823         }
 824         if ($alpnum eq 'n') {
 825                 @tmparray = sort {$a <=> $b} @tmparray;
 826         } else {
 827                 @tmparray = (sort @tmparray);
 828         }
 829         foreach $line (@tmparray)
 830         {
 831                 chomp($line);
 832                 if ($line ne '') {
 833                         my @temp = split(/\,/,$line);
 834                         my $tmpholder = $temp[0];
 835                         $temp[0] = $temp[$colno];
 836                         $temp[$colno] = $tmpholder;
 837                         $newline = "";
 838                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 839                                 $newline=$newline . $temp[$ctr] . ",";
 840                         }
 841                         chop($newline);
 842                         push(@srtedarray,$newline);
 843                 }
 844         }
 845
 846         if ($srtdir eq 'dsc') {
 847                 @tmparray = reverse(@srtedarray);
 848                 return (@tmparray);
 849         } else {
 850                 return (@srtedarray);
 851         }
 852 }
 853
 854 sub speedtouchversion
 855 {
 856         if (-f "/proc/bus/usb/devices")
 857         {
 858                 $speedtouch=`/bin/cat /proc/bus/usb/devices | /bin/grep 'Vendor=06b9 ProdID=4061' | /usr/bin/cut -d ' ' -f6`;
 859                 if ($speedtouch eq '') {
 860                         $speedtouch= $tr{'connect the modem'};
 861                 }
 862         } else {
 863                 $speedtouch='USB '.$tr{'not running'};
 864         }
 865         return $speedtouch
 866 }
 867
 868 sub CheckSortOrder {
 869 #Sorting of allocated leases
 870     if ($ENV{'QUERY_STRING'} =~ /^IPADDR|^ETHER|^HOSTNAME|^ENDTIME/ ) {
 871         my $newsort=$ENV{'QUERY_STRING'};
 872         &readhash("${swroot}/dhcp/settings", \%dhcpsettings);
 873         $act=$dhcpsettings{'SORT_LEASELIST'};
 874         #Reverse actual ?
 875         if ($act =~ $newsort) {
 876             if ($act !~ 'Rev') {$Rev='Rev'};
 877             $newsort.=$Rev
 878         };
 879
 880         $dhcpsettings{'SORT_LEASELIST'}=$newsort;
 881         &writehash("${swroot}/dhcp/settings", \%dhcpsettings);
 882         $dhcpsettings{'ACTION'} = 'SORT';  # avoid the next test "First lauch"
 883     }
 884
 885 }
 886
 887 sub PrintActualLeases
 888 {
 889     &openbox('100%', 'left', $tr{'current dynamic leases'});
 890     print <<END
 891 <table width='100%'>
 892 <tr>
 893 <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?IPADDR'><b>$tr{'ip address'}</b></a></td>
 894 <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ETHER'><b>$tr{'mac address'}</b></a></td>
 895 <td width='20%' align='center'><a href='$ENV{'SCRIPT_NAME'}?HOSTNAME'><b>$tr{'hostname'}</b></a></td>
 896 <td width='25%' align='center'><a href='$ENV{'SCRIPT_NAME'}?ENDTIME'><b>$tr{'lease expires'} (local time d/m/y)</b></a></td>
 897 <td width='5%' align='center'><b>Add to fix leases<b></td>
 898 </tr>
 899 END
 900     ;
 901
 902     open(LEASES,"/var/state/dhcp/dhcpd.leases") or die "Can't open dhcpd.leases";
 903     while ($line = <LEASES>) {
 904         next if( $line =~ /^\s*#/ );
 905         chomp($line);
 906         @temp = split (' ', $line);
 907
 908         if ($line =~ /^\s*lease/) {
 909             $ip = $temp[1];
 910             #All field are not necessarily read. Clear everything
 911             $endtime = 0;
 912             $ether = "";
 913             $hostname = "";
 914         }
 915
 916         if ($line =~ /^\s*ends/) {
 917             $line =~ /(\d+)\/(\d+)\/(\d+) (\d+):(\d+):(\d+)/;
 918             $endtime = timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);
 919         }
 920
 921         if ($line =~ /^\s*hardware ethernet/) {
 922             $ether = $temp[2];
 923             $ether =~ s/;//g;
 924         }
 925
 926         if ($line =~ /^\s*client-hostname/) {
 927             $hostname = "$temp[1] $temp[2] $temp[3]";
 928             $hostname =~ s/;//g;
 929             $hostname =~ s/\"//g;
 930         }
 931
 932         if ($line eq "}") {
 933             @record = ('IPADDR',$ip,'ENDTIME',$endtime,'ETHER',$ether,'HOSTNAME',$hostname);
 934             $record = {};                                       # create a reference to empty hash
 935             %{$record} = @record;                               # populate that hash with @record
 936             $entries{$record->{'IPADDR'}} = $record;    # add this to a hash of hashes
 937         }
 938     }
 939     close(LEASES);
 940
 941     my $id = 0;
 942     foreach my $key (sort leasesort keys %entries) {
 943         print "<form method='post' action='/cgi-bin/dhcp.cgi'>\n";
 944         my $hostname = &cleanhtml($entries{$key}->{HOSTNAME},"y");
 945
 946         if ($id % 2) {
 947             print "<tr bgcolor='$table1colour'>";
 948         }
 949         else {
 950             print "<tr bgcolor='$table2colour'>";
 951         }
 952
 953         print <<END
 954 <td align='center'><input type='hidden' name='FIX_ADDR' value='$entries{$key}->{IPADDR}' />$entries{$key}->{IPADDR}</td>
 955 <td align='center'><input type='hidden' name='FIX_MAC' value='$entries{$key}->{ETHER}' />$entries{$key}->{ETHER}</td>
 956 <td align='center'><input type='hidden' name='FIX_REMARK' value='$hostname' />&nbsp;$hostname</td>
 957 <td align='center'><input type='hidden' name='FIX_ENABLED' value='on' />
 958 END
 959         ;
 960
 961         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $dst) = localtime ($entries{$key}->{ENDTIME});
 962         $enddate = sprintf ("%02d/%02d/%d %02d:%02d:%02d",$mday,$mon+1,$year+1900,$hour,$min,$sec);
 963
 964         if ($entries{$key}->{ENDTIME} < time() ){
 965             print "<strike>$enddate</strike>";
 966         } else {
 967             print "$enddate";
 968         }
 969         print <<END
 970 <td><input type='hidden' name='ACTION' value='$Lang::tr{'add'}2' /><input type='submit' name='SUBMIT' value='$Lang::tr{'add'}' />
 971 </td></td></tr></form>
 972 END
 973         ;
 974         $id++;
 975     }
 976
 977     print "</table>";
 978     &closebox();
 979 }
 980
 981
 982 # This sub is used during display of actives leases
 983 sub leasesort {
 984     if (rindex ($dhcpsettings{'SORT_LEASELIST'},'Rev') != -1)
 985     {
 986         $qs=substr ($dhcpsettings{'SORT_LEASELIST'},0,length($dhcpsettings{'SORT_LEASELIST'})-3);
 987         if ($qs eq 'IPADDR') {
 988             @a = split(/\./,$entries{$a}->{$qs});
 989             @b = split(/\./,$entries{$b}->{$qs});
 990             ($b[0]<=>$a[0]) ||
 991             ($b[1]<=>$a[1]) ||
 992             ($b[2]<=>$a[2]) ||
 993             ($b[3]<=>$a[3]);
 994         }else {
 995             $entries{$b}->{$qs} cmp $entries{$a}->{$qs};
 996         }
 997     }
 998     else #not reverse
 999     {
1000         $qs=$dhcpsettings{'SORT_LEASELIST'};
1001         if ($qs eq 'IPADDR') {
1002             @a = split(/\./,$entries{$a}->{$qs});
1003             @b = split(/\./,$entries{$b}->{$qs});
1004             ($a[0]<=>$b[0]) ||
1005             ($a[1]<=>$b[1]) ||
1006             ($a[2]<=>$b[2]) ||
1007             ($a[3]<=>$b[3]);
1008         }else {
1009             $entries{$a}->{$qs} cmp $entries{$b}->{$qs};
1010         }
1011     }
1012 }
1013
1014 sub get_uplinks() {
1015     my @uplinks = ();
1016     opendir(DIR, "${swroot}/uplinks/") || return \@uplinks;
1017     foreach my $dir (readdir(DIR)) {
1018         next if ($dir =~ /^\./);
1019         next if (-f "${swroot}/uplinks/$dir");
1020         push(@uplinks, $dir);
1021     }
1022     closedir(DIR);
1023     return \@uplinks;
1024 }
1025
1026 sub get_iface($) {
1027     my $filename = shift;
1028     chomp($filename);
1029     open (F, $filename) || return "";
1030     my $iface = <F>;
1031     close(F);
1032     chomp($iface);
1033     return $iface;
1034 }
1035
1036 sub get_red_ifaces_by_type($) {
1037     my $type=shift;
1038     my @gottypeiface = ();
1039     my @gottypeuplink = ();
1040     my @gottype = ();
1041
1042     my $ref=get_uplinks();
1043     my @uplinks=@$ref;
1044     my %set = ();
1045     foreach my $link (@uplinks) {
1046         eval {
1047             &readhash("${swroot}/uplinks/$link/settings", \%set);
1048         };
1049         push(@gottype, $link);
1050
1051         my $iface = $set{'RED_DEV'};
1052         if (!$iface) {
1053             $iface = get_iface("${swroot}/uplinks/$link/interface");
1054         }
1055         next if (!$iface);
1056
1057         if ($set{'RED_TYPE'} eq $type) {
1058             push(@gottypeiface, $iface);
1059             push(@gottypeuplink, $link);
1060         }
1061     }
1062     return (\@gottypeiface, \@gottypeuplink, \@gottype);
1063 }
1064
1065 sub get_red_ifaces() {
1066     return `cat ${swroot}/uplinks/*/interface 2>/dev/null`;
1067 }
1068
1069 sub get_zone_devices($) {
1070     my $bridge = shift;
1071     my @ifaces = ();
1072     open (FILE, "${swroot}/ethernet/$bridge") || return "";
1073     foreach my $line (<FILE>) {
1074         chomp($line);
1075         next if (!$line);
1076         push(@ifaces, $line);
1077     }
1078     close(FILE);
1079     return \@ifaces;
1080 }