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 use Net::IPv4Addr qw(:all);
  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                 if ( $var eq "__CGI__"){next;}
  92                 $val = $hash->{$var};
  93                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
  94                 # location of the mouse are submitted as well, this was being written to the settings file causing
  95                 # some serious grief! This skips the variable.x and variable.y
  96                 if (!($var =~ /(.x|.y)$/)) {
  97                         if ($val =~ / /) {
  98                                 $val = "\'$val\'"; }
  99                         if (!($var =~ /^ACTION/)) {
 100                                 print FILE "${var}=${val}\n"; }
 101                 }
 102         }
 103         close FILE;
 104 }
 105
 106 sub writehashpart
 107 {
 108         # This function replaces the given hash in the original hash by keeping the old
 109         # content and just replacing the new content
 110
 111         my $filename = $_[0];
 112         my $newhash = $_[1];
 113         my %oldhash;
 114         my ($var, $val);
 115
 116         readhash("${filename}", \%oldhash);
 117
 118         foreach $var (keys %$newhash){
 119                 $oldhash{$var}=$newhash->{$var};
 120         }
 121
 122         # write cgi vars to the file.
 123         open(FILE, ">${filename}") or die "Unable to write file $filename";
 124         flock FILE, 2;
 125         foreach $var (keys %oldhash)
 126         {
 127                 if ( $var eq "__CGI__"){next;}
 128                 $val = $oldhash{$var};
 129                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 130                 # location of the mouse are submitted as well, this was being written to the settings file causing
 131                 # some serious grief! This skips the variable.x and variable.y
 132                 if (!($var =~ /(.x|.y)$/)) {
 133                         if ($val =~ / /) {
 134                                 $val = "\'$val\'"; }
 135                         if (!($var =~ /^ACTION/)) {
 136                                 print FILE "${var}=${val}\n"; }
 137                 }
 138         }
 139         close FILE;
 140 }
 141
 142 sub age
 143 {
 144         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 145                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 146         my $now = time;
 147         my $timestring = '';
 148         my $dset = 0;           # Day is set, when > 0
 149         my $hset = 0;           # Hour is set, when > 0
 150         my $mset = 0;           # Minute is set, when > 0
 151
 152         my $totalsecs = $now - $mtime;
 153         my $days = int($totalsecs / 86400);
 154         my $totalhours = int($totalsecs / 3600);
 155         my $hours = $totalhours % 24;
 156         my $totalmins = int($totalsecs / 60);
 157         my $mins = $totalmins % 60;
 158         my $secs = $totalsecs % 60;
 159
 160         if      ($days > 1) {
 161                 ${timestring} .= ${days}.' '.$Lang::tr{'days'}.', ';
 162                 $dset = 1;
 163         }
 164         elsif   ($days == 1) {
 165                 ${timestring} .= ${days}.' '.$Lang::tr{'day'}.', ';
 166                 $dset = 1;
 167         }
 168
 169         if      (($hours > 1) && !($dset)) {
 170                 ${timestring} .= ${hours}.' '.$Lang::tr{'hours'}.', ';
 171                 $hset = 1;
 172         }
 173         elsif   (($hours == 1) && !($dset)) {
 174                 ${timestring} .= ${hours}.' '.$Lang::tr{'hour'}.', ';
 175                 $hset = 1;
 176         }
 177         elsif ($dset) {
 178                 ${timestring} .= ${hours}.' '.$Lang::tr{'age shour'}.', ';
 179                 $hset = 1;
 180         }
 181
 182         if      ((($mins > 1) || ($mins == 0)) && !($dset || $hset)) {
 183                 ${timestring} .= ${mins}.' '.$Lang::tr{'minutes'}.', ';
 184                 $mset = 1;
 185         }
 186         elsif   (($mins == 1) && !($dset || $hset)) {
 187                 ${timestring} .= ${mins}.' '.$Lang::tr{'minute'}.', ';
 188                 $mset = 1;
 189         }
 190         else {
 191                 ${timestring} .= ${mins}.' '.$Lang::tr{'age sminute'}.', ';
 192                 $mset = 1;
 193         }
 194
 195         if      ((($secs > 1) || ($secs == 0)) && !($dset || $hset || $mset)) {
 196                 ${timestring} .= ${secs}.' '.$Lang::tr{'age seconds'};
 197         }
 198         elsif   (($secs == 1) && !($dset || $hset || $mset)) {
 199                 ${timestring} .= $secs.' '.$Lang::tr{'age second'};
 200         }
 201         else    { ${timestring} .= $secs.' '.$Lang::tr{'age ssecond'}; }
 202
 203         return ${timestring};
 204 }
 205
 206 sub validip
 207 {
 208         my $ip = $_[0];
 209
 210         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 211                 return 0; }
 212         else
 213         {
 214                 my @octets = ($1, $2, $3, $4);
 215                 foreach $_ (@octets)
 216                 {
 217                         if (/^0./) {
 218                                 return 0; }
 219                         if ($_ < 0 || $_ > 255) {
 220                                 return 0; }
 221                 }
 222                 return 1;
 223         }
 224 }
 225
 226 sub validmask
 227 {
 228         my $mask = $_[0];
 229
 230         # secord part an ip?
 231         if (&validip($mask)) {
 232                 return 1; }
 233         # second part a number?
 234         if (/^0/) {
 235                 return 0; }
 236         if (!($mask =~ /^\d+$/)) {
 237                 return 0; }
 238         if ($mask >= 0 && $mask <= 32) {
 239                 return 1; }
 240         return 0;
 241 }
 242
 243 sub validipormask
 244 {
 245         my $ipormask = $_[0];
 246
 247         # see if it is a IP only.
 248         if (&validip($ipormask)) {
 249                 return 1; }
 250         # split it into number and mask.
 251         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 252                 return 0; }
 253         my $ip = $1;
 254         my $mask = $2;
 255         # first part not a ip?
 256         if (!(&validip($ip))) {
 257                 return 0; }
 258         return &validmask($mask);
 259 }
 260
 261 sub subtocidr
 262 {
 263         #gets: Subnet in decimal (255.255.255.0)
 264         #Gives: 24 (The cidr of network)
 265         my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
 266         my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
 267         my $bin = unpack("B*", pack("N", $num));
 268         my $count = ($bin =~ tr/1/1/);
 269         return $count;
 270 }
 271
 272 sub cidrtosub
 273 {
 274         #gets: Cidr of network (20-30 for ccd)
 275         #Konverts 30 to 255.255.255.252 e.g
 276         my $cidr=$_[0];
 277     my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 278     return "$netmask";
 279 }
 280
 281 sub iporsubtodec
 282 {
 283         #Gets: Ip address or subnetmask in decimal oder CIDR
 284         #Gives: What it gets only in CIDR format
 285         my $subnet=$_[0];
 286         my $net;
 287         my $mask;
 288         my $full=0;
 289         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 290                 ($net,$mask) = split (/\//,$subnet);
 291                 $full=1;
 292                 return "$subnet";
 293         }else{
 294                 $mask=$subnet;
 295         }
 296         #Subnet already in decimal and valid?
 297         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 298                 for (my $i=8;$i<=32;$i++){
 299                         if (&General::cidrtosub($i) eq $mask){
 300                                 if ($full == 0){return $mask;}else{
 301                                                          return $net."/".$mask;
 302                                 }
 303                         }
 304                 }
 305         }
 306         #Subnet in binary format?
 307         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 308                         if($full == 0){ return &General::cidrtosub($mask);}else{
 309                                                  return $net."/".&General::cidrtosub($mask);
 310                         }
 311         }else{
 312                         return 3;
 313         }
 314         return 3;
 315 }
 316
 317
 318 sub iporsubtocidr
 319 {
 320         #gets: Ip Address  or subnetmask in decimal oder CIDR
 321         #Gives: What it gets only in CIDR format
 322         my $subnet=$_[0];
 323         my $net;
 324         my $mask;
 325         my $full=0;
 326         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 327                 ($net,$mask) = split (/\//,$subnet);
 328                 $full=1;
 329         }else{
 330                 $mask=$subnet;
 331         }
 332         #Subnet in decimal and valid?
 333         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 334                 for (my $i=8;$i<=32;$i++){
 335                         if (&General::cidrtosub($i) eq $mask){
 336                                 if ($full == 0){return &General::subtocidr($mask);}else{
 337                                                          return $net."/".&General::subtocidr($mask);
 338                                 }
 339                         }
 340                 }
 341         }
 342         #Subnet already in binary format?
 343         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 344                         if($full == 0){ return $mask;}else{
 345                                                  return $net."/".$mask;
 346                         }
 347         }else{
 348                         return 3;
 349         }
 350         return 3;
 351 }
 352
 353 sub getnetworkip
 354 {
 355         #Gets:  IP, CIDR    (10.10.10.0-255, 24)
 356         #Gives:  10.10.10.0
 357         my ($ccdip,$ccdsubnet) = @_;
 358         my $ip_address_binary = inet_aton( $ccdip );
 359         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 360         my $network_address    = inet_ntoa( $ip_address_binary & $netmask_binary );
 361         return $network_address;
 362 }
 363
 364 sub getccdbc
 365 {
 366         #Gets: IP in Form ("192.168.0.0/24")
 367         #Gives: Broadcastaddress of network
 368         my $ccdnet=$_;
 369         my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
 370         my $ip_address_binary = inet_aton( $ccdip );
 371         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 372         my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
 373         return $broadcast_address;
 374 }
 375
 376 sub ip2dec
 377 {
 378     my $ip_num;
 379     my $ip=$_[0];
 380     if ( $ip =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
 381         $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
 382     } else {
 383         $ip_num = -1;
 384     }
 385     $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
 386     return($ip_num);
 387 }
 388
 389 sub dec2ip
 390 {
 391     my $ip;
 392     my $ip_num=$_[0];
 393         my $o1=$ip_num%256;
 394         $ip_num=int($ip_num/256);
 395         my $o2=$ip_num%256;
 396         $ip_num=int($ip_num/256);
 397         my $o3=$ip_num%256;
 398         $ip_num=int($ip_num/256);
 399         my $o4=$ip_num%256;
 400         $ip="$o4.$o3.$o2.$o1";
 401     return ($ip);
 402 }
 403
 404 sub getnextip
 405 {
 406         my $decip=&ip2dec($_[0]);
 407         $decip=$decip+4;
 408         return &dec2ip($decip);
 409 }
 410
 411 sub getlastip
 412 {
 413         my $decip=&ip2dec($_[0]);
 414         $decip--;
 415         return &dec2ip($decip);
 416 }
 417
 418 sub validipandmask
 419 {
 420         #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
 421         #Gives: True bzw 0 if success or false
 422         my $ccdnet=$_[0];
 423         my $subcidr;
 424
 425         if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
 426                 return 0;
 427         }
 428         my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
 429         #IP valid?
 430         if ($ccdip=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1>0 && $1<=255 && $2>=0 && $2<=255 && $3>=0 && $3<=255 && $4<=255 ))) {
 431                 #Subnet in decimal and valid?
 432                 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
 433                         for (my $i=8;$i<=32;$i++){
 434                                 if (&General::cidrtosub($i) eq $ccdsubnet){
 435                                         return 1;
 436                                 }
 437                         }
 438                 #Subnet already in binary format?
 439                 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
 440                         return 1;
 441                 }else{
 442                         return 0;
 443                 }
 444
 445         }
 446         return 0;
 447 }
 448
 449 sub checksubnets
 450 {
 451         my %ccdconfhash=();
 452         my @ccdconf=();
 453         my $ccdname=$_[0];
 454         my $ccdnet=$_[1];
 455         my $errormessage;
 456         my ($ip,$cidr)=split(/\//,$ccdnet);
 457         $cidr=&iporsubtocidr($cidr);
 458         #get OVPN-Subnet (dynamic range)
 459         my %ovpnconf=();
 460         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 461         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 462         $ovpncidr=&iporsubtocidr($ovpncidr);
 463         #check if we try to use same network as ovpn server
 464         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 465                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 466                         return $errormessage;
 467         }
 468         #check if we use a network-name/subnet that already exists
 469         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 470         foreach my $key (keys %ccdconfhash) {
 471                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 472                 if ($ccdname eq $ccdconfhash{$key}[0])
 473                 {
 474                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 475                         return $errormessage;
 476                 }
 477                 my ($newip,$newsub) = split(/\//,$ccdnet);
 478                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 479                 {
 480                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
 481                         return $errormessage;
 482                 }
 483         }
 484         #check if we use a ipsec right network which is already defined
 485         my %ipsecconf=();
 486         &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 487         foreach my $key (keys %ipsecconf){
 488                 if ($ipsecconf{$key}[11] ne ''){
 489                         my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
 490                         $ipsecsub=&iporsubtodec($ipsecsub);
 491                         if($ipsecconf{$key}[1] ne $ccdname){
 492                                 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 493                                         $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
 494                                         return $errormessage;
 495                                 }
 496                         }
 497                 }
 498         }
 499         #check if we use one of ipfire's networks (green,orange,blue)
 500         my %ownnet=();
 501         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 502         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &IpInSubnet($ownnet{'GREEN_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 503         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &IpInSubnet($ownnet{'ORANGE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 504         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &IpInSubnet($ownnet{'BLUE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 505         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &IpInSubnet($ownnet{'RED_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 506 }
 507
 508
 509 sub validport
 510 {
 511         $_ = $_[0];
 512
 513         if (!/^\d+$/) {
 514                 return 0; }
 515         if (/^0./) {
 516                 return 0; }
 517         if ($_ >= 1 && $_ <= 65535) {
 518                 return 1; }
 519         return 0;
 520 }
 521
 522 sub validproxyport
 523 {
 524         $_ = $_[0];
 525
 526         if (!/^\d+$/) {
 527                 return 0; }
 528         if (/^0./) {
 529                 return 0; }
 530         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 531                 return 0; }
 532         elsif ($_ >= 1 && $_ <= 65535) {
 533                 return 1; }
 534         return 0;
 535 }
 536
 537 sub validmac
 538 {
 539         my $checkmac = $_[0];
 540         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 541         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 542         {
 543                 return 0;
 544         }
 545         return 1;
 546 }
 547
 548 sub validhostname
 549 {
 550         # Checks a hostname against RFC1035
 551         my $hostname = $_[0];
 552
 553         # Each part should be at least two characters in length
 554         # but no more than 63 characters
 555         if (length ($hostname) < 1 || length ($hostname) > 63) {
 556                 return 0;}
 557         # Only valid characters are a-z, A-Z, 0-9 and -
 558         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 559                 return 0;}
 560         # First character can only be a letter or a digit
 561         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 562                 return 0;}
 563         # Last character can only be a letter or a digit
 564         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 565                 return 0;}
 566         return 1;
 567 }
 568
 569 sub validdomainname
 570 {
 571         my $part;
 572
 573         # Checks a domain name against RFC1035
 574         my $domainname = $_[0];
 575         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 576
 577         foreach $part (@parts) {
 578                 # Each part should be at least two characters in length
 579                 # but no more than 63 characters
 580                 if (length ($part) < 2 || length ($part) > 63) {
 581                         return 0;}
 582                 # Only valid characters are a-z, A-Z, 0-9 and -
 583                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 584                         return 0;}
 585                 # First character can only be a letter or a digit
 586                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 587                         return 0;}
 588                 # Last character can only be a letter or a digit
 589                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 590                         return 0;}
 591         }
 592         return 1;
 593 }
 594
 595 sub validfqdn
 596 {
 597         my $part;
 598
 599         # Checks a fully qualified domain name against RFC1035
 600         my $fqdn = $_[0];
 601         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 602         if (scalar(@parts) < 2) {               # At least two parts should
 603                 return 0;}                      # exist in a FQDN
 604                                                 # (i.e. hostname.domain)
 605         foreach $part (@parts) {
 606                 # Each part should be at least one character in length
 607                 # but no more than 63 characters
 608                 if (length ($part) < 1 || length ($part) > 63) {
 609                         return 0;}
 610                 # Only valid characters are a-z, A-Z, 0-9 and -
 611                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 612                         return 0;}
 613                 # First character can only be a letter or a digit
 614                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 615                         return 0;}
 616                 # Last character can only be a letter or a digit
 617                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 618                         return 0;}
 619         }
 620         return 1;
 621 }
 622
 623 sub validportrange # used to check a port range
 624 {
 625         my $port = $_[0]; # port values
 626         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 627         my $srcdst = $_[1]; # is it a source or destination port
 628
 629         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 630
 631                 if (!(&validport($port))) {
 632                         if ($srcdst eq 'src'){
 633                                 return $Lang::tr{'source port numbers'};
 634                         } else  {
 635                                 return $Lang::tr{'destination port numbers'};
 636                         }
 637                 }
 638         }
 639         else
 640         {
 641                 my @ports = ($1, $2);
 642                 if ($1 >= $2){
 643                         if ($srcdst eq 'src'){
 644                                 return $Lang::tr{'bad source range'};
 645                         } else  {
 646                                 return $Lang::tr{'bad destination range'};
 647                         }
 648                 }
 649                 foreach $_ (@ports)
 650                 {
 651                         if (!(&validport($_))) {
 652                                 if ($srcdst eq 'src'){
 653                                         return $Lang::tr{'source port numbers'};
 654                                 } else  {
 655                                         return $Lang::tr{'destination port numbers'};
 656                                 }
 657                         }
 658                 }
 659                 return;
 660         }
 661 }
 662
 663 # Test if IP is within a subnet
 664 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 665 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 666 #       Everything in dottted notation
 667 # Return: TRUE/FALSE
 668 sub IpInSubnet
 669 {
 670     my $ip = unpack('N', &Socket::inet_aton(shift));
 671     my $start = unpack('N', &Socket::inet_aton(shift));
 672     my $mask  = unpack('N', &Socket::inet_aton(shift));
 673        $start &= $mask;  # base of subnet...
 674     my $end   = $start + ~$mask;
 675     return (($ip >= $start) && ($ip <= $end));
 676 }
 677
 678 #
 679 # Return the following IP (IP+1) in dotted notation.
 680 # Call: NextIP ('1.1.1.1');
 681 # Return: '1.1.1.2'
 682 #
 683 sub NextIP
 684 {
 685     return &Socket::inet_ntoa( pack("N", 1 +  unpack('N', &Socket::inet_aton(shift))
 686                                    )
 687                              );
 688 }
 689 sub NextIP2
 690 {
 691     return &Socket::inet_ntoa( pack("N", 4 +  unpack('N', &Socket::inet_aton(shift))
 692                                    )
 693                              );
 694 }
 695 sub ipcidr
 696 {
 697         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 698         return "$ip\/$cidr";
 699 }
 700
 701 sub ipcidr2msk
 702 {
 703        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 704        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 705        return "$ip\/$netmask";
 706 }
 707
 708
 709 sub validemail {
 710     my $mail = shift;
 711     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 712     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 713     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 714     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 715     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 716     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 717     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 718     return 1;
 719 }
 720
 721 #
 722 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 723 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 724 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 725 #
 726 sub readhasharray {
 727     my ($filename, $hash) = @_;
 728     %$hash = ();
 729
 730     open(FILE, $filename) or die "Unable to read file $filename";
 731
 732     while (<FILE>) {
 733         my ($key, $rest, @temp);
 734         chomp;
 735         ($key, $rest) = split (/,/, $_, 2);
 736         if ($key =~ /^[0-9]+$/) {
 737             @temp = split (/,/, $rest);
 738             $hash->{$key} = \@temp;
 739         }
 740     }
 741     close FILE;
 742     return;
 743 }
 744
 745 sub writehasharray {
 746     my ($filename, $hash) = @_;
 747     my ($key, @temp, $i);
 748
 749     open(FILE, ">$filename") or die "Unable to write to file $filename";
 750
 751     foreach $key (keys %$hash) {
 752                 if ($key =~ /^[0-9]+$/) {
 753                         print FILE "$key";
 754                         foreach $i (0 .. $#{$hash->{$key}}) {
 755                                 print FILE ",$hash->{$key}[$i]";
 756                         }
 757                         print FILE "\n";
 758                 }
 759     }
 760     close FILE;
 761     return;
 762 }
 763
 764 sub findhasharraykey {
 765     foreach my $i (1 .. 1000000) {
 766         if ( ! exists $_[0]{$i}) {
 767              return $i;
 768         }
 769     }
 770 }
 771
 772 sub srtarray
 773 # Darren Critchley - darrenc@telus.net - (c) 2003
 774 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 775 # This subroutine will take the following parameters:
 776 #   ColumnNumber = the column which you want to sort on, starts at 1
 777 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 778 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 779 #   ArrayToBeSorted = the array that wants sorting
 780 #
 781 #   Returns an array that is sorted to your specs
 782 #
 783 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 784 #
 785 {
 786         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 787         my @tmparray;
 788         my @srtedarray;
 789         my $line;
 790         my $newline;
 791         my $ctr;
 792         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 793         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 794                 return (@tobesorted);
 795         }
 796         my @tmp = split(/\,/,$tobesorted[0]);
 797         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 798
 799         # Darren Critchley - validate parameters
 800         if ($colno > $ttlitems){$colno = '1';}
 801         $colno--; # remove one from colno to deal with arrays starting at 0
 802         if($colno < 0){$colno = '0';}
 803         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 804         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 805
 806         foreach $line (@tobesorted)
 807         {
 808                 chomp($line);
 809                 if ($line ne '') {
 810                         my @temp = split(/\,/,$line);
 811                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 812                         my $tmpholder = $temp[0];
 813                         $temp[0] = $temp[$colno];
 814                         $temp[$colno] = $tmpholder;
 815                         $newline = "";
 816                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 817                                 $newline=$newline . $temp[$ctr] . ",";
 818                         }
 819                         chop($newline);
 820                         push(@tmparray,$newline);
 821                 }
 822         }
 823         if ($alpnum eq 'n') {
 824                 @tmparray = sort {$a <=> $b} @tmparray;
 825         } else {
 826                 @tmparray = (sort @tmparray);
 827         }
 828         foreach $line (@tmparray)
 829         {
 830                 chomp($line);
 831                 if ($line ne '') {
 832                         my @temp = split(/\,/,$line);
 833                         my $tmpholder = $temp[0];
 834                         $temp[0] = $temp[$colno];
 835                         $temp[$colno] = $tmpholder;
 836                         $newline = "";
 837                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 838                                 $newline=$newline . $temp[$ctr] . ",";
 839                         }
 840                         chop($newline);
 841                         push(@srtedarray,$newline);
 842                 }
 843         }
 844
 845         if ($srtdir eq 'dsc') {
 846                 @tmparray = reverse(@srtedarray);
 847                 return (@tmparray);
 848         } else {
 849                 return (@srtedarray);
 850         }
 851 }
 852
 853 sub FetchPublicIp {
 854     my %proxysettings;
 855     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 856     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 857         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 858         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 859     }
 860     my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
 861                                                     80,
 862                                                     "/",
 863                                                     Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
 864                                                 );
 865     if ($response =~ m%HTTP/1\.. 200 OK%) {
 866         $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
 867         return $1;
 868     }
 869     return '';
 870 }
 871
 872 #
 873 # Check if hostname.domain provided have IP provided
 874 # use gethostbyname to verify that
 875 # Params:
 876 #       IP
 877 #       hostname
 878 #       domain
 879 # Output
 880 #       1 IP matches host.domain
 881 #       0 not in sync
 882 #
 883 sub DyndnsServiceSync ($;$;$) {
 884
 885     my ($ip,$hostName,$domain) = @_;
 886     my @addresses;
 887
 888     #fix me no ip GROUP, what is the name ?
 889     $hostName =~ s/$General::noipprefix//;
 890     if ($hostName) { #may be empty
 891         $hostName = "$hostName.$domain";
 892         @addresses = gethostbyname($hostName);
 893     }
 894
 895     if ($addresses[0] eq '') {                  # nothing returned ?
 896         $hostName = $domain;                    # try resolving with domain only
 897         @addresses = gethostbyname($hostName);
 898     }
 899
 900     if ($addresses[0] ne '') {                  # got something ?
 901         #&General::log("name:$addresses[0], alias:$addresses[1]");
 902         # Build clear text list of IP
 903         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 904         if (grep (/$ip/, @addresses)) {
 905             return 1;
 906         }
 907     }
 908     return 0;
 909 }
 910 #
 911 # This sub returns the red IP used to compare in DyndnsServiceSync
 912 #
 913 sub GetDyndnsRedIP {
 914     my %settings;
 915     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 916
 917     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 918     my $ip = <IP>;
 919     close(IP);
 920     chomp $ip;
 921
 922     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 923         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 924         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
 925     {
 926         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 927             my $RealIP = &General::FetchPublicIp;
 928             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 929         }
 930     }
 931     return $ip;
 932 }
 933
 934 # Translate ICMP code to text
 935 # ref: http://www.iana.org/assignments/icmp-parameters
 936 sub GetIcmpDescription ($) {
 937     my $index = shift;
 938     my @icmp_description = (
 939     'Echo Reply',                       #0
 940     'Unassigned',
 941     'Unassigned',
 942     'Destination Unreachable',
 943     'Source Quench',
 944     'Redirect',
 945     'Alternate Host Address',
 946     'Unassigned',
 947     'Echo',
 948     'Router Advertisement',
 949     'Router Solicitation',              #10
 950     'Time Exceeded',
 951     'Parameter Problem',
 952     'Timestamp',
 953     'Timestamp Reply',
 954     'Information Request',
 955     'Information Reply',
 956     'Address Mask Request',
 957     'Address Mask Reply',
 958     'Reserved (for Security)',
 959     'Reserved (for Robustness Experiment)', #20
 960     'Reserved',
 961     'Reserved',
 962     'Reserved',
 963     'Reserved',
 964     'Reserved',
 965     'Reserved',
 966     'Reserved',
 967     'Reserved',
 968     'Reserved',
 969     'Traceroute',                               #30
 970     'Datagram Conversion Error',
 971     'Mobile Host Redirect',
 972     'IPv6 Where-Are-You',
 973     'IPv6 I-Am-Here',
 974     'Mobile Registration Request',
 975     'Mobile Registration Reply',
 976     'Domain Name Request',
 977     'Domain Name Reply',
 978     'SKIP',
 979     'Photur',                           #40
 980     'Experimental');
 981     if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
 982 }
 983 1;