config/cfgroot/general-functions.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: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
  13 #
  14
  15 package General;
  16
  17 use strict;
  18 use Socket;
  19 use IO::Socket;
  20 use Net::SSLeay;
  21
  22 $|=1; # line buffering
  23
  24 $General::version = 'VERSION';
  25 $General::swroot = 'CONFIG_ROOT';
  26 $General::noipprefix = 'noipg-';
  27 $General::adminmanualurl = 'http://wiki.ipfire.org';
  28
  29 #
  30 # log ("message") use default 'ipcop' tag
  31 # log ("tag","message") use your tag
  32 #
  33 sub log
  34 {
  35         my $tag='ipfire';
  36         $tag = shift if (@_>1);
  37         my $logmessage = $_[0];
  38         $logmessage =~ /([\w\W]*)/;
  39         $logmessage = $1;
  40         system('/usr/bin/logger', '-t', $tag, $logmessage);
  41 }
  42
  43 sub readhash
  44 {
  45         my $filename = $_[0];
  46         my $hash = $_[1];
  47         my ($var, $val);
  48
  49
  50         # Some ipcop code expects that readhash 'complete' the hash if new entries
  51         # are presents. Not clear it !!!
  52         #%$hash = ();
  53
  54         open(FILE, $filename) or die "Unable to read file $filename";
  55
  56         while (<FILE>)
  57         {
  58                 chop;
  59                 ($var, $val) = split /=/, $_, 2;
  60                 if ($var)
  61                 {
  62                         $val =~ s/^\'//g;
  63                         $val =~ s/\'$//g;
  64
  65                         # Untaint variables read from hash
  66                         $var =~ /([A-Za-z0-9_-]*)/;        $var = $1;
  67                         $val =~ /([\w\W]*)/; $val = $1;
  68                         $hash->{$var} = $val;
  69                 }
  70         }
  71         close FILE;
  72 }
  73
  74
  75 sub writehash
  76 {
  77         my $filename = $_[0];
  78         my $hash = $_[1];
  79         my ($var, $val);
  80
  81         # write cgi vars to the file.
  82         open(FILE, ">${filename}") or die "Unable to write file $filename";
  83         flock FILE, 2;
  84         foreach $var (keys %$hash)
  85         {
  86                 $val = $hash->{$var};
  87                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
  88                 # location of the mouse are submitted as well, this was being written to the settings file causing
  89                 # some serious grief! This skips the variable.x and variable.y
  90                 if (!($var =~ /(.x|.y)$/)) {
  91                         if ($val =~ / /) {
  92                                 $val = "\'$val\'"; }
  93                         if (!($var =~ /^ACTION/)) {
  94                                 print FILE "${var}=${val}\n"; }
  95                 }
  96         }
  97         close FILE;
  98 }
  99
 100
 101 sub age
 102 {
 103         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 104                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 105         my $now = time;
 106
 107         my $totalsecs = $now - $mtime;
 108         my $days = int($totalsecs / 86400);
 109         my $totalhours = int($totalsecs / 3600);
 110         my $hours = $totalhours % 24;
 111         my $totalmins = int($totalsecs / 60);
 112         my $mins = $totalmins % 60;
 113         my $secs = $totalsecs % 60;
 114
 115         return "${days}d ${hours}h ${mins}m ${secs}s";
 116 }
 117
 118 sub validip
 119 {
 120         my $ip = $_[0];
 121
 122         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 123                 return 0; }
 124         else
 125         {
 126                 my @octets = ($1, $2, $3, $4);
 127                 foreach $_ (@octets)
 128                 {
 129                         if (/^0./) {
 130                                 return 0; }
 131                         if ($_ < 0 || $_ > 255) {
 132                                 return 0; }
 133                 }
 134                 return 1;
 135         }
 136 }
 137
 138 sub validmask
 139 {
 140         my $mask = $_[0];
 141
 142         # secord part an ip?
 143         if (&validip($mask)) {
 144                 return 1; }
 145         # second part a number?
 146         if (/^0/) {
 147                 return 0; }
 148         if (!($mask =~ /^\d+$/)) {
 149                 return 0; }
 150         if ($mask >= 0 && $mask <= 32) {
 151                 return 1; }
 152         return 0;
 153 }
 154
 155 sub validipormask
 156 {
 157         my $ipormask = $_[0];
 158
 159         # see if it is a IP only.
 160         if (&validip($ipormask)) {
 161                 return 1; }
 162         # split it into number and mask.
 163         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 164                 return 0; }
 165         my $ip = $1;
 166         my $mask = $2;
 167         # first part not a ip?
 168         if (!(&validip($ip))) {
 169                 return 0; }
 170         return &validmask($mask);
 171 }
 172
 173 sub validipandmask
 174 {
 175         my $ipandmask = $_[0];
 176
 177         # split it into number and mask.
 178         if (!($ipandmask =~ /^(.*?)\/(.*?)$/)) {
 179                 return 0; }
 180         my $ip = $1;
 181         my $mask = $2;
 182         # first part not a ip?
 183         if (!(&validip($ip))) {
 184                 return 0; }
 185         return &validmask($mask);
 186 }
 187
 188 sub validport
 189 {
 190         $_ = $_[0];
 191
 192         if (!/^\d+$/) {
 193                 return 0; }
 194         if (/^0./) {
 195                 return 0; }
 196         if ($_ >= 1 && $_ <= 65535) {
 197                 return 1; }
 198         return 0;
 199 }
 200
 201 sub validmac
 202 {
 203         my $checkmac = $_[0];
 204         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 205         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 206         {
 207                 return 0;
 208         }
 209         return 1;
 210 }
 211
 212 sub validhostname
 213 {
 214         # Checks a hostname against RFC1035
 215         my $hostname = $_[0];
 216
 217         # Each part should be at least two characters in length
 218         # but no more than 63 characters
 219         if (length ($hostname) < 1 || length ($hostname) > 63) {
 220                 return 0;}
 221         # Only valid characters are a-z, A-Z, 0-9 and -
 222         if ($hostname !~ /^[a-zA-Z0-9-]*$/) {
 223                 return 0;}
 224         # First character can only be a letter or a digit
 225         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 226                 return 0;}
 227         # Last character can only be a letter or a digit
 228         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 229                 return 0;}
 230         return 1;
 231 }
 232
 233 sub validdomainname
 234 {
 235         my $part;
 236
 237         # Checks a domain name against RFC1035
 238         my $domainname = $_[0];
 239         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 240
 241         foreach $part (@parts) {
 242                 # Each part should be at least two characters in length
 243                 # but no more than 63 characters
 244                 if (length ($part) < 2 || length ($part) > 63) {
 245                         return 0;}
 246                 # Only valid characters are a-z, A-Z, 0-9 and -
 247                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 248                         return 0;}
 249                 # First character can only be a letter or a digit
 250                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 251                         return 0;}
 252                 # Last character can only be a letter or a digit
 253                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 254                         return 0;}
 255         }
 256         return 1;
 257 }
 258
 259 sub validfqdn
 260 {
 261         my $part;
 262
 263         # Checks a fully qualified domain name against RFC1035
 264         my $fqdn = $_[0];
 265         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 266         if (scalar(@parts) < 2) {               # At least two parts should
 267                 return 0;}                      # exist in a FQDN
 268                                                 # (i.e. hostname.domain)
 269         foreach $part (@parts) {
 270                 # Each part should be at least one character in length
 271                 # but no more than 63 characters
 272                 if (length ($part) < 1 || length ($part) > 63) {
 273                         return 0;}
 274                 # Only valid characters are a-z, A-Z, 0-9 and -
 275                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 276                         return 0;}
 277                 # First character can only be a letter or a digit
 278                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 279                         return 0;}
 280                 # Last character can only be a letter or a digit
 281                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 282                         return 0;}
 283         }
 284         return 1;
 285 }
 286
 287 sub validportrange # used to check a port range
 288 {
 289         my $port = $_[0]; # port values
 290         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 291         my $srcdst = $_[1]; # is it a source or destination port
 292
 293         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 294
 295                 if (!(&validport($port))) {
 296                         if ($srcdst eq 'src'){
 297                                 return $Lang::tr{'source port numbers'};
 298                         } else  {
 299                                 return $Lang::tr{'destination port numbers'};
 300                         }
 301                 }
 302         }
 303         else
 304         {
 305                 my @ports = ($1, $2);
 306                 if ($1 >= $2){
 307                         if ($srcdst eq 'src'){
 308                                 return $Lang::tr{'bad source range'};
 309                         } else  {
 310                                 return $Lang::tr{'bad destination range'};
 311                         }
 312                 }
 313                 foreach $_ (@ports)
 314                 {
 315                         if (!(&validport($_))) {
 316                                 if ($srcdst eq 'src'){
 317                                         return $Lang::tr{'source port numbers'};
 318                                 } else  {
 319                                         return $Lang::tr{'destination port numbers'};
 320                                 }
 321                         }
 322                 }
 323                 return;
 324         }
 325 }
 326
 327 # Test if IP is within a subnet
 328 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 329 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 330 #       Everything in dottted notation
 331 # Return: TRUE/FALSE
 332 sub IpInSubnet
 333 {
 334     my $ip = unpack('N', &Socket::inet_aton(shift));
 335     my $start = unpack('N', &Socket::inet_aton(shift));
 336     my $mask  = unpack('N', &Socket::inet_aton(shift));
 337        $start &= $mask;  # base of subnet...
 338     my $end   = $start + ~$mask;
 339     return (($ip >= $start) && ($ip <= $end));
 340 }
 341
 342 #
 343 # Return the following IP (IP+1) in dotted notation.
 344 # Call: NextIP ('1.1.1.1');
 345 # Return: '1.1.1.2'
 346 #
 347 sub NextIP
 348 {
 349     return &Socket::inet_ntoa( pack("N", 1 +  unpack('N', &Socket::inet_aton(shift))
 350                                    )
 351                              );
 352 }
 353
 354 sub validemail {
 355     my $mail = shift;
 356     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 357     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 358     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 359     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 360     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 361     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 362     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 363     return 1;
 364 }
 365
 366 #
 367 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 368 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 369 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 370 #
 371 sub readhasharray {
 372     my ($filename, $hash) = @_;
 373     %$hash = ();
 374
 375     open(FILE, $filename) or die "Unable to read file $filename";
 376
 377     while (<FILE>) {
 378         my ($key, $rest, @temp);
 379         chomp;
 380         ($key, $rest) = split (/,/, $_, 2);
 381         if ($key =~ /^[0-9]+$/) {
 382             @temp = split (/,/, $rest);
 383             $hash->{$key} = \@temp;
 384         }
 385     }
 386     close FILE;
 387     return;
 388 }
 389
 390 sub writehasharray {
 391     my ($filename, $hash) = @_;
 392     my ($key, @temp, $i);
 393
 394     open(FILE, ">$filename") or die "Unable to write to file $filename";
 395
 396     foreach $key (keys %$hash) {
 397         if ($key =~ /^[0-9]+$/) {
 398             print FILE "$key";
 399             foreach $i (0 .. $#{$hash->{$key}}) {
 400                 print FILE ",$hash->{$key}[$i]";
 401             }
 402             print FILE "\n";
 403         }
 404     }
 405     close FILE;
 406     return;
 407 }
 408
 409 sub findhasharraykey {
 410     foreach my $i (1 .. 1000000) {
 411         if ( ! exists $_[0]{$i}) {
 412              return $i;
 413         }
 414     }
 415 }
 416
 417 sub srtarray
 418 # Darren Critchley - darrenc@telus.net - (c) 2003
 419 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 420 # This subroutine will take the following parameters:
 421 #   ColumnNumber = the column which you want to sort on, starts at 1
 422 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 423 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 424 #   ArrayToBeSorted = the array that wants sorting
 425 #
 426 #   Returns an array that is sorted to your specs
 427 #
 428 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 429 #
 430 {
 431         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 432         my @tmparray;
 433         my @srtedarray;
 434         my $line;
 435         my $newline;
 436         my $ctr;
 437         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 438         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 439                 return (@tobesorted);
 440         }
 441         my @tmp = split(/\,/,$tobesorted[0]);
 442         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 443
 444         # Darren Critchley - validate parameters
 445         if ($colno > $ttlitems){$colno = '1';}
 446         $colno--; # remove one from colno to deal with arrays starting at 0
 447         if($colno < 0){$colno = '0';}
 448         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 449         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 450
 451         foreach $line (@tobesorted)
 452         {
 453                 chomp($line);
 454                 if ($line ne '') {
 455                         my @temp = split(/\,/,$line);
 456                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 457                         my $tmpholder = $temp[0];
 458                         $temp[0] = $temp[$colno];
 459                         $temp[$colno] = $tmpholder;
 460                         $newline = "";
 461                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 462                                 $newline=$newline . $temp[$ctr] . ",";
 463                         }
 464                         chop($newline);
 465                         push(@tmparray,$newline);
 466                 }
 467         }
 468         if ($alpnum eq 'n') {
 469                 @tmparray = sort {$a <=> $b} @tmparray;
 470         } else {
 471                 @tmparray = (sort @tmparray);
 472         }
 473         foreach $line (@tmparray)
 474         {
 475                 chomp($line);
 476                 if ($line ne '') {
 477                         my @temp = split(/\,/,$line);
 478                         my $tmpholder = $temp[0];
 479                         $temp[0] = $temp[$colno];
 480                         $temp[$colno] = $tmpholder;
 481                         $newline = "";
 482                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 483                                 $newline=$newline . $temp[$ctr] . ",";
 484                         }
 485                         chop($newline);
 486                         push(@srtedarray,$newline);
 487                 }
 488         }
 489
 490         if ($srtdir eq 'dsc') {
 491                 @tmparray = reverse(@srtedarray);
 492                 return (@tmparray);
 493         } else {
 494                 return (@srtedarray);
 495         }
 496 }
 497
 498 sub FetchPublicIp {
 499     my %proxysettings;
 500     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 501     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 502         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 503         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 504     }
 505     my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
 506                                                     80,
 507                                                     "/",
 508                                                     Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
 509                                                 );
 510     if ($response =~ m%HTTP/1\.. 200 OK%) {
 511         $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
 512         return $1;
 513     }
 514     return '';
 515 }
 516
 517 #
 518 # Check if hostname.domain provided have IP provided
 519 # use gethostbyname to verify that
 520 # Params:
 521 #       IP
 522 #       hostname
 523 #       domain
 524 # Output
 525 #       1 IP matches host.domain
 526 #       0 not in sync
 527 #
 528 sub DyndnsServiceSync ($;$;$) {
 529
 530     my ($ip,$hostName,$domain) = @_;
 531     my @addresses;
 532
 533     #fix me no ip GROUP, what is the name ?
 534     $hostName =~ s/$General::noipprefix//;
 535     if ($hostName) { #may be empty
 536         $hostName = "$hostName.$domain";
 537         @addresses = gethostbyname($hostName);
 538     }
 539
 540     if ($addresses[0] eq '') {                  # nothing returned ?
 541         $hostName = $domain;                    # try resolving with domain only
 542         @addresses = gethostbyname($hostName);
 543     }
 544
 545     if ($addresses[0] ne '') {                  # got something ?
 546         #&General::log("name:$addresses[0], alias:$addresses[1]");
 547         # Build clear text list of IP
 548         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 549         if (grep (/$ip/, @addresses)) {
 550             return 1;
 551         }
 552     }
 553     return 0;
 554 }
 555 #
 556 # This sub returns the red IP used to compare in DyndnsServiceSync
 557 #
 558 sub GetDyndnsRedIP {
 559     my %settings;
 560     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 561
 562     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 563     my $ip = <IP>;
 564     close(IP);
 565     chomp $ip;
 566
 567     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 568         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 569         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
 570     {
 571         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 572             my $RealIP = &General::FetchPublicIp;
 573             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 574         }
 575     }
 576     return $ip;
 577 }
 578
 579 # Translate ICMP code to text
 580 # ref: http://www.iana.org/assignments/icmp-parameters
 581 sub GetIcmpDescription ($) {
 582     my $index = shift;
 583     my @icmp_description = (
 584     'Echo Reply',                       #0
 585     'Unassigned',
 586     'Unassigned',
 587     'Destination Unreachable',
 588     'Source Quench',
 589     'Redirect',
 590     'Alternate Host Address',
 591     'Unassigned',
 592     'Echo',
 593     'Router Advertisement',
 594     'Router Solicitation',              #10
 595     'Time Exceeded',
 596     'Parameter Problem',
 597     'Timestamp',
 598     'Timestamp Reply',
 599     'Information Request',
 600     'Information Reply',
 601     'Address Mask Request',
 602     'Address Mask Reply',
 603     'Reserved (for Security)',
 604     'Reserved (for Robustness Experiment)', #20
 605     'Reserved',
 606     'Reserved',
 607     'Reserved',
 608     'Reserved',
 609     'Reserved',
 610     'Reserved',
 611     'Reserved',
 612     'Reserved',
 613     'Reserved',
 614     'Traceroute',                               #30
 615     'Datagram Conversion Error',
 616     'Mobile Host Redirect',
 617     'IPv6 Where-Are-You',
 618     'IPv6 I-Am-Here',
 619     'Mobile Registration Request',
 620     'Mobile Registration Reply',
 621     'Domain Name Request',
 622     'Domain Name Reply',
 623     'SKIP',
 624     'Photur',                           #40
 625     'Experimental');
 626     if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
 627 }
 628 1;