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