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