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