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