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
 412         #get OVPN-Subnet (dynamic range)
 413         my %ovpnconf=();
 414         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 415         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 416         $ovpncidr=&iporsubtocidr($ovpncidr);
 417
 418         #check if we try to use same network as ovpn server
 419         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 420                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 421                         return $errormessage;
 422         }
 423
 424         #check if we use a network-name/subnet that already exists
 425         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 426         foreach my $key (keys %ccdconfhash) {
 427                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 428                 if ($ccdname eq $ccdconfhash{$key}[0])
 429                 {
 430                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 431                         return $errormessage;
 432                 }
 433                 my ($newip,$newsub) = split(/\//,$ccdnet);
 434                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 435                 {
 436                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
 437                         return $errormessage;
 438                 }
 439
 440         }
 441
 442         #check if we use a ipsec right network which is already defined
 443         my %ipsecconf=();
 444         &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 445         foreach my $key (keys %ipsecconf){
 446                 if ($ipsecconf{$key}[11] ne ''){
 447                         my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
 448                         $ipsecsub=&iporsubtodec($ipsecsub);
 449                         if($ipsecconf{$key}[1] ne $ccdname){
 450                                 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 451                                         $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[2]";
 452                                         return $errormessage;
 453                                 }
 454                         }
 455                 }
 456         }
 457
 458         #check if we use one of ipfire's networks (green,orange,blue)
 459         my %ownnet=();
 460         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 461         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;}
 462         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;}
 463         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;}
 464         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;}
 465
 466
 467
 468 }
 469
 470
 471 sub validport
 472 {
 473         $_ = $_[0];
 474
 475         if (!/^\d+$/) {
 476                 return 0; }
 477         if (/^0./) {
 478                 return 0; }
 479         if ($_ >= 1 && $_ <= 65535) {
 480                 return 1; }
 481         return 0;
 482 }
 483
 484 sub validproxyport
 485 {
 486         $_ = $_[0];
 487
 488         if (!/^\d+$/) {
 489                 return 0; }
 490         if (/^0./) {
 491                 return 0; }
 492         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 493                 return 0; }
 494         elsif ($_ >= 1 && $_ <= 65535) {
 495                 return 1; }
 496         return 0;
 497 }
 498
 499 sub validmac
 500 {
 501         my $checkmac = $_[0];
 502         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 503         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 504         {
 505                 return 0;
 506         }
 507         return 1;
 508 }
 509
 510 sub validhostname
 511 {
 512         # Checks a hostname against RFC1035
 513         my $hostname = $_[0];
 514
 515         # Each part should be at least two characters in length
 516         # but no more than 63 characters
 517         if (length ($hostname) < 1 || length ($hostname) > 63) {
 518                 return 0;}
 519         # Only valid characters are a-z, A-Z, 0-9 and -
 520         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 521                 return 0;}
 522         # First character can only be a letter or a digit
 523         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 524                 return 0;}
 525         # Last character can only be a letter or a digit
 526         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 527                 return 0;}
 528         return 1;
 529 }
 530
 531 sub validdomainname
 532 {
 533         my $part;
 534
 535         # Checks a domain name against RFC1035
 536         my $domainname = $_[0];
 537         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 538
 539         foreach $part (@parts) {
 540                 # Each part should be at least two characters in length
 541                 # but no more than 63 characters
 542                 if (length ($part) < 2 || length ($part) > 63) {
 543                         return 0;}
 544                 # Only valid characters are a-z, A-Z, 0-9 and -
 545                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 546                         return 0;}
 547                 # First character can only be a letter or a digit
 548                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 549                         return 0;}
 550                 # Last character can only be a letter or a digit
 551                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 552                         return 0;}
 553         }
 554         return 1;
 555 }
 556
 557 sub validfqdn
 558 {
 559         my $part;
 560
 561         # Checks a fully qualified domain name against RFC1035
 562         my $fqdn = $_[0];
 563         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 564         if (scalar(@parts) < 2) {               # At least two parts should
 565                 return 0;}                      # exist in a FQDN
 566                                                 # (i.e. hostname.domain)
 567         foreach $part (@parts) {
 568                 # Each part should be at least one character in length
 569                 # but no more than 63 characters
 570                 if (length ($part) < 1 || length ($part) > 63) {
 571                         return 0;}
 572                 # Only valid characters are a-z, A-Z, 0-9 and -
 573                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 574                         return 0;}
 575                 # First character can only be a letter or a digit
 576                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 577                         return 0;}
 578                 # Last character can only be a letter or a digit
 579                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 580                         return 0;}
 581         }
 582         return 1;
 583 }
 584
 585 sub validportrange # used to check a port range
 586 {
 587         my $port = $_[0]; # port values
 588         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 589         my $srcdst = $_[1]; # is it a source or destination port
 590
 591         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 592
 593                 if (!(&validport($port))) {
 594                         if ($srcdst eq 'src'){
 595                                 return $Lang::tr{'source port numbers'};
 596                         } else  {
 597                                 return $Lang::tr{'destination port numbers'};
 598                         }
 599                 }
 600         }
 601         else
 602         {
 603                 my @ports = ($1, $2);
 604                 if ($1 >= $2){
 605                         if ($srcdst eq 'src'){
 606                                 return $Lang::tr{'bad source range'};
 607                         } else  {
 608                                 return $Lang::tr{'bad destination range'};
 609                         }
 610                 }
 611                 foreach $_ (@ports)
 612                 {
 613                         if (!(&validport($_))) {
 614                                 if ($srcdst eq 'src'){
 615                                         return $Lang::tr{'source port numbers'};
 616                                 } else  {
 617                                         return $Lang::tr{'destination port numbers'};
 618                                 }
 619                         }
 620                 }
 621                 return;
 622         }
 623 }
 624
 625 # Test if IP is within a subnet
 626 # Call: IpInSubnet (Addr, Subnet, Subnet Mask)
 627 #       Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
 628 #       Everything in dottted notation
 629 # Return: TRUE/FALSE
 630 sub IpInSubnet
 631 {
 632     my $ip = unpack('N', &Socket::inet_aton(shift));
 633     my $start = unpack('N', &Socket::inet_aton(shift));
 634     my $mask  = unpack('N', &Socket::inet_aton(shift));
 635        $start &= $mask;  # base of subnet...
 636     my $end   = $start + ~$mask;
 637     return (($ip >= $start) && ($ip <= $end));
 638 }
 639
 640 #
 641 # Return the following IP (IP+1) in dotted notation.
 642 # Call: NextIP ('1.1.1.1');
 643 # Return: '1.1.1.2'
 644 #
 645 sub NextIP
 646 {
 647     return &Socket::inet_ntoa( pack("N", 1 +  unpack('N', &Socket::inet_aton(shift))
 648                                    )
 649                              );
 650 }
 651 sub NextIP2
 652 {
 653     return &Socket::inet_ntoa( pack("N", 4 +  unpack('N', &Socket::inet_aton(shift))
 654                                    )
 655                              );
 656 }
 657 sub ipcidr
 658 {
 659         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 660         return "$ip\/$cidr";
 661 }
 662
 663 sub ipcidr2msk
 664 {
 665        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 666        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 667        return "$ip\/$netmask";
 668 }
 669
 670
 671 sub validemail {
 672     my $mail = shift;
 673     return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
 674     return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
 675     return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
 676     return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
 677     return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
 678     return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
 679     return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
 680     return 1;
 681 }
 682
 683 #
 684 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 685 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 686 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 687 #
 688 sub readhasharray {
 689     my ($filename, $hash) = @_;
 690     %$hash = ();
 691
 692     open(FILE, $filename) or die "Unable to read file $filename";
 693
 694     while (<FILE>) {
 695         my ($key, $rest, @temp);
 696         chomp;
 697         ($key, $rest) = split (/,/, $_, 2);
 698         if ($key =~ /^[0-9]+$/) {
 699             @temp = split (/,/, $rest);
 700             $hash->{$key} = \@temp;
 701         }
 702     }
 703     close FILE;
 704     return;
 705 }
 706
 707 sub writehasharray {
 708     my ($filename, $hash) = @_;
 709     my ($key, @temp, $i);
 710
 711     open(FILE, ">$filename") or die "Unable to write to file $filename";
 712
 713     foreach $key (keys %$hash) {
 714                 if ($key =~ /^[0-9]+$/) {
 715                         print FILE "$key";
 716                         foreach $i (0 .. $#{$hash->{$key}}) {
 717                                 print FILE ",$hash->{$key}[$i]";
 718                         }
 719                         print FILE "\n";
 720                 }
 721     }
 722     close FILE;
 723     return;
 724 }
 725
 726 sub findhasharraykey {
 727     foreach my $i (1 .. 1000000) {
 728         if ( ! exists $_[0]{$i}) {
 729              return $i;
 730         }
 731     }
 732 }
 733
 734 sub srtarray
 735 # Darren Critchley - darrenc@telus.net - (c) 2003
 736 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 737 # This subroutine will take the following parameters:
 738 #   ColumnNumber = the column which you want to sort on, starts at 1
 739 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 740 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 741 #   ArrayToBeSorted = the array that wants sorting
 742 #
 743 #   Returns an array that is sorted to your specs
 744 #
 745 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 746 #
 747 {
 748         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 749         my @tmparray;
 750         my @srtedarray;
 751         my $line;
 752         my $newline;
 753         my $ctr;
 754         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 755         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 756                 return (@tobesorted);
 757         }
 758         my @tmp = split(/\,/,$tobesorted[0]);
 759         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 760
 761         # Darren Critchley - validate parameters
 762         if ($colno > $ttlitems){$colno = '1';}
 763         $colno--; # remove one from colno to deal with arrays starting at 0
 764         if($colno < 0){$colno = '0';}
 765         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 766         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 767
 768         foreach $line (@tobesorted)
 769         {
 770                 chomp($line);
 771                 if ($line ne '') {
 772                         my @temp = split(/\,/,$line);
 773                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 774                         my $tmpholder = $temp[0];
 775                         $temp[0] = $temp[$colno];
 776                         $temp[$colno] = $tmpholder;
 777                         $newline = "";
 778                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 779                                 $newline=$newline . $temp[$ctr] . ",";
 780                         }
 781                         chop($newline);
 782                         push(@tmparray,$newline);
 783                 }
 784         }
 785         if ($alpnum eq 'n') {
 786                 @tmparray = sort {$a <=> $b} @tmparray;
 787         } else {
 788                 @tmparray = (sort @tmparray);
 789         }
 790         foreach $line (@tmparray)
 791         {
 792                 chomp($line);
 793                 if ($line ne '') {
 794                         my @temp = split(/\,/,$line);
 795                         my $tmpholder = $temp[0];
 796                         $temp[0] = $temp[$colno];
 797                         $temp[$colno] = $tmpholder;
 798                         $newline = "";
 799                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 800                                 $newline=$newline . $temp[$ctr] . ",";
 801                         }
 802                         chop($newline);
 803                         push(@srtedarray,$newline);
 804                 }
 805         }
 806
 807         if ($srtdir eq 'dsc') {
 808                 @tmparray = reverse(@srtedarray);
 809                 return (@tmparray);
 810         } else {
 811                 return (@srtedarray);
 812         }
 813 }
 814
 815 sub FetchPublicIp {
 816     my %proxysettings;
 817     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 818     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 819         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 820         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 821     }
 822     my ($out, $response) = Net::SSLeay::get_http(  'checkip.dyndns.org',
 823                                                     80,
 824                                                     "/",
 825                                                     Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
 826                                                 );
 827     if ($response =~ m%HTTP/1\.. 200 OK%) {
 828         $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
 829         return $1;
 830     }
 831     return '';
 832 }
 833
 834 #
 835 # Check if hostname.domain provided have IP provided
 836 # use gethostbyname to verify that
 837 # Params:
 838 #       IP
 839 #       hostname
 840 #       domain
 841 # Output
 842 #       1 IP matches host.domain
 843 #       0 not in sync
 844 #
 845 sub DyndnsServiceSync ($;$;$) {
 846
 847     my ($ip,$hostName,$domain) = @_;
 848     my @addresses;
 849
 850     #fix me no ip GROUP, what is the name ?
 851     $hostName =~ s/$General::noipprefix//;
 852     if ($hostName) { #may be empty
 853         $hostName = "$hostName.$domain";
 854         @addresses = gethostbyname($hostName);
 855     }
 856
 857     if ($addresses[0] eq '') {                  # nothing returned ?
 858         $hostName = $domain;                    # try resolving with domain only
 859         @addresses = gethostbyname($hostName);
 860     }
 861
 862     if ($addresses[0] ne '') {                  # got something ?
 863         #&General::log("name:$addresses[0], alias:$addresses[1]");
 864         # Build clear text list of IP
 865         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 866         if (grep (/$ip/, @addresses)) {
 867             return 1;
 868         }
 869     }
 870     return 0;
 871 }
 872 #
 873 # This sub returns the red IP used to compare in DyndnsServiceSync
 874 #
 875 sub GetDyndnsRedIP {
 876     my %settings;
 877     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 878
 879     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 880     my $ip = <IP>;
 881     close(IP);
 882     chomp $ip;
 883
 884     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 885         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 886         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
 887     {
 888         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 889             my $RealIP = &General::FetchPublicIp;
 890             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 891         }
 892     }
 893     return $ip;
 894 }
 895
 896 # Translate ICMP code to text
 897 # ref: http://www.iana.org/assignments/icmp-parameters
 898 sub GetIcmpDescription ($) {
 899     my $index = shift;
 900     my @icmp_description = (
 901     'Echo Reply',                       #0
 902     'Unassigned',
 903     'Unassigned',
 904     'Destination Unreachable',
 905     'Source Quench',
 906     'Redirect',
 907     'Alternate Host Address',
 908     'Unassigned',
 909     'Echo',
 910     'Router Advertisement',
 911     'Router Solicitation',              #10
 912     'Time Exceeded',
 913     'Parameter Problem',
 914     'Timestamp',
 915     'Timestamp Reply',
 916     'Information Request',
 917     'Information Reply',
 918     'Address Mask Request',
 919     'Address Mask Reply',
 920     'Reserved (for Security)',
 921     'Reserved (for Robustness Experiment)', #20
 922     'Reserved',
 923     'Reserved',
 924     'Reserved',
 925     'Reserved',
 926     'Reserved',
 927     'Reserved',
 928     'Reserved',
 929     'Reserved',
 930     'Reserved',
 931     'Traceroute',                               #30
 932     'Datagram Conversion Error',
 933     'Mobile Host Redirect',
 934     'IPv6 Where-Are-You',
 935     'IPv6 I-Am-Here',
 936     'Mobile Registration Request',
 937     'Mobile Registration Reply',
 938     'Domain Name Request',
 939     'Domain Name Reply',
 940     'SKIP',
 941     'Photur',                           #40
 942     'Experimental');
 943     if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
 944 }
 945 1;