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 Locale::Codes::Country;
  21 use Net::SSLeay;
  22 use Net::IPv4Addr qw(:all);
  23 $|=1; # line buffering
  24
  25 $General::version = 'VERSION';
  26 $General::swroot = 'CONFIG_ROOT';
  27 $General::noipprefix = 'noipg-';
  28 $General::adminmanualurl = 'http://wiki.ipfire.org';
  29
  30 require "${General::swroot}/network-functions.pl";
  31
  32 #
  33 # log ("message") use default 'ipcop' tag
  34 # log ("tag","message") use your tag
  35 #
  36 sub log
  37 {
  38         my $tag='ipfire';
  39         $tag = shift if (@_>1);
  40         my $logmessage = $_[0];
  41         $logmessage =~ /([\w\W]*)/;
  42         $logmessage = $1;
  43         system('logger', '-t', $tag, $logmessage);
  44 }
  45 sub setup_default_networks
  46 {
  47         my %netsettings=();
  48         my $defaultNetworks = shift;
  49
  50         &readhash("/var/ipfire/ethernet/settings", \%netsettings);
  51
  52         # Get current defined networks (Red, Green, Blue, Orange)
  53         $defaultNetworks->{$Lang::tr{'fwhost any'}}{'IPT'} = "0.0.0.0/0.0.0.0";
  54         $defaultNetworks->{$Lang::tr{'fwhost any'}}{'NAME'} = "ALL";
  55
  56         $defaultNetworks->{$Lang::tr{'green'}}{'IPT'} = "$netsettings{'GREEN_NETADDRESS'}/$netsettings{'GREEN_NETMASK'}";
  57         $defaultNetworks->{$Lang::tr{'green'}}{'NET'} = "$netsettings{'GREEN_ADDRESS'}";
  58         $defaultNetworks->{$Lang::tr{'green'}}{'NAME'} = "GREEN";
  59
  60         if ($netsettings{'RED_DEV'} ne ''){
  61                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'IPT'} = "$netsettings{'RED_NETADDRESS'}/$netsettings{'RED_NETMASK'}";
  62                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NET'} = "$netsettings{'RED_ADDRESS'}";
  63                 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NAME'} = "RED";
  64         }
  65         if ($netsettings{'ORANGE_DEV'} ne ''){
  66                 $defaultNetworks->{$Lang::tr{'orange'}}{'IPT'} = "$netsettings{'ORANGE_NETADDRESS'}/$netsettings{'ORANGE_NETMASK'}";
  67                 $defaultNetworks->{$Lang::tr{'orange'}}{'NET'} = "$netsettings{'ORANGE_ADDRESS'}";
  68                 $defaultNetworks->{$Lang::tr{'orange'}}{'NAME'} = "ORANGE";
  69         }
  70
  71         if ($netsettings{'BLUE_DEV'} ne ''){
  72                 $defaultNetworks->{$Lang::tr{'blue'}}{'IPT'} = "$netsettings{'BLUE_NETADDRESS'}/$netsettings{'BLUE_NETMASK'}";
  73                 $defaultNetworks->{$Lang::tr{'blue'}}{'NET'} = "$netsettings{'BLUE_ADDRESS'}";
  74                 $defaultNetworks->{$Lang::tr{'blue'}}{'NAME'} = "BLUE";
  75         }
  76
  77         #IPFire himself
  78         $defaultNetworks->{'IPFire'}{'NAME'} = "IPFire";
  79
  80         # OpenVPN
  81         if(-e "${General::swroot}/ovpn/settings")
  82         {
  83                 my %ovpnSettings = ();
  84                 &readhash("${General::swroot}/ovpn/settings", \%ovpnSettings);
  85
  86                 # OpenVPN on Red?
  87                 if(defined($ovpnSettings{'DOVPN_SUBNET'}))
  88                 {
  89                         my ($ip,$sub) = split(/\//,$ovpnSettings{'DOVPN_SUBNET'});
  90                         $sub=&General::iporsubtocidr($sub);
  91                         my @tempovpnsubnet = split("\/", $ovpnSettings{'DOVPN_SUBNET'});
  92                         $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'ADR'} = $tempovpnsubnet[0];
  93                         $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'NAME'} = "OpenVPN-Dyn";
  94                 }
  95         } # end OpenVPN
  96         # IPsec RW NET
  97         if(-e "${General::swroot}/vpn/settings")
  98         {
  99                 my %ipsecsettings = ();
 100                 &readhash("${General::swroot}/vpn/settings", \%ipsecsettings);
 101                 if($ipsecsettings{'RW_NET'} ne '')
 102                 {
 103                         my ($ip,$sub) = split(/\//,$ipsecsettings{'RW_NET'});
 104                         $sub=&General::iporsubtocidr($sub);
 105                         my @tempipsecsubnet = split("\/", $ipsecsettings{'RW_NET'});
 106                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'ADR'} = $tempipsecsubnet[0];
 107                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NAME'} = "IPsec RW";
 108                         $defaultNetworks->{'IPsec RW (' .$ip."/".$sub.")"}{'NET'} = &getnextip($ip);
 109                 }
 110         }
 111 }
 112 sub get_aliases
 113 {
 114
 115         my $defaultNetworks = shift;
 116         open(FILE, "${General::swroot}/ethernet/aliases") or die 'Unable to open aliases file.';
 117         my @current = <FILE>;
 118         close(FILE);
 119         my $ctr = 0;
 120         foreach my $line (@current)
 121         {
 122                 if ($line ne ''){
 123                         chomp($line);
 124                         my @temp = split(/\,/,$line);
 125                         if ($temp[2] eq '') {
 126                                 $temp[2] = "Alias $ctr : $temp[0]";
 127                         }
 128                         $defaultNetworks->{$temp[2]}{'IPT'} = "$temp[0]";
 129                         $defaultNetworks->{$temp[2]}{'NET'} = "$temp[0]";
 130
 131                         $ctr++;
 132                 }
 133         }
 134 }
 135
 136 sub readhash
 137 {
 138         my $filename = $_[0];
 139         my $hash = $_[1];
 140         my ($var, $val);
 141
 142
 143         # Some ipcop code expects that readhash 'complete' the hash if new entries
 144         # are presents. Not clear it !!!
 145         #%$hash = ();
 146
 147         open(FILE, $filename) or die "Unable to read file $filename";
 148
 149         while (<FILE>)
 150         {
 151                 chop;
 152                 ($var, $val) = split /=/, $_, 2;
 153                 if ($var)
 154                 {
 155                         $val =~ s/^\'//g;
 156                         $val =~ s/\'$//g;
 157
 158                         # Untaint variables read from hash
 159                         # trim space from begin and end
 160                         $var =~ s/^\s+//;
 161                         $var =~ s/\s+$//;
 162                         $var =~ /([A-Za-z0-9_-]*)/;
 163                         $var = $1;
 164                         $val =~ /([\w\W]*)/;
 165                         $val = $1;
 166                         $hash->{$var} = $val;
 167                 }
 168         }
 169         close FILE;
 170 }
 171
 172
 173 sub writehash
 174 {
 175         my $filename = $_[0];
 176         my $hash = $_[1];
 177         my ($var, $val);
 178
 179         # write cgi vars to the file.
 180         open(FILE, ">${filename}") or die "Unable to write file $filename";
 181         flock FILE, 2;
 182         foreach $var (keys %$hash)
 183         {
 184                 if ( $var eq "__CGI__"){next;}
 185                 $val = $hash->{$var};
 186                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 187                 # location of the mouse are submitted as well, this was being written to the settings file causing
 188                 # some serious grief! This skips the variable.x and variable.y
 189                 if (!($var =~ /(.x|.y)$/)) {
 190                         if ($val =~ / /) {
 191                                 $val = "\'$val\'"; }
 192                         if (!($var =~ /^ACTION/)) {
 193                                 print FILE "${var}=${val}\n"; }
 194                 }
 195         }
 196         close FILE;
 197 }
 198
 199 sub writehashpart
 200 {
 201         # This function replaces the given hash in the original hash by keeping the old
 202         # content and just replacing the new content
 203
 204         my $filename = $_[0];
 205         my $newhash = $_[1];
 206         my %oldhash;
 207         my ($var, $val);
 208
 209         readhash("${filename}", \%oldhash);
 210
 211         foreach $var (keys %$newhash){
 212                 $oldhash{$var}=$newhash->{$var};
 213         }
 214
 215         # write cgi vars to the file.
 216         open(FILE, ">${filename}") or die "Unable to write file $filename";
 217         flock FILE, 2;
 218         foreach $var (keys %oldhash)
 219         {
 220                 if ( $var eq "__CGI__"){next;}
 221                 $val = $oldhash{$var};
 222                 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
 223                 # location of the mouse are submitted as well, this was being written to the settings file causing
 224                 # some serious grief! This skips the variable.x and variable.y
 225                 if (!($var =~ /(.x|.y)$/)) {
 226                         if ($val =~ / /) {
 227                                 $val = "\'$val\'"; }
 228                         if (!($var =~ /^ACTION/)) {
 229                                 print FILE "${var}=${val}\n"; }
 230                 }
 231         }
 232         close FILE;
 233 }
 234
 235 sub age {
 236         my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
 237                 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
 238         my $totalsecs = time() - $mtime;
 239         my @s = ();
 240
 241         my $secs = $totalsecs % 60;
 242         $totalsecs /= 60;
 243         if ($secs > 0) {
 244                 push(@s, "${secs}s");
 245         }
 246
 247         my $min = $totalsecs % 60;
 248         $totalsecs /= 60;
 249         if ($min > 0) {
 250                 push(@s, "${min}m");
 251         }
 252
 253         my $hrs = $totalsecs % 24;
 254         $totalsecs /= 24;
 255         if ($hrs > 0) {
 256                 push(@s, "${hrs}h");
 257         }
 258
 259         my $days = int($totalsecs);
 260         if ($days > 0) {
 261                 push(@s, "${days}d");
 262         }
 263
 264         return join(" ", reverse(@s));
 265 }
 266
 267 sub validip
 268 {
 269         my $ip = $_[0];
 270
 271         if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
 272                 return 0; }
 273         else
 274         {
 275                 my @octets = ($1, $2, $3, $4);
 276                 foreach $_ (@octets)
 277                 {
 278                         if (/^0./) {
 279                                 return 0; }
 280                         if ($_ < 0 || $_ > 255) {
 281                                 return 0; }
 282                 }
 283                 return 1;
 284         }
 285 }
 286
 287 sub validmask {
 288         my $mask = shift;
 289
 290         return &Network::check_netmask($mask) || &Network::check_prefix($mask);
 291 }
 292
 293 sub validipormask
 294 {
 295         my $ipormask = $_[0];
 296
 297         # see if it is a IP only.
 298         if (&validip($ipormask)) {
 299                 return 1; }
 300         # split it into number and mask.
 301         if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
 302                 return 0; }
 303         my $ip = $1;
 304         my $mask = $2;
 305         # first part not a ip?
 306         if (!(&validip($ip))) {
 307                 return 0; }
 308         return &validmask($mask);
 309 }
 310
 311 sub subtocidr {
 312         return &Network::convert_netmask2prefix(shift);
 313 }
 314
 315 sub cidrtosub {
 316         return &Network::convert_prefix2netmask(shift);
 317 }
 318
 319 sub iporsubtodec
 320 {
 321         #Gets: Ip address or subnetmask in decimal oder CIDR
 322         #Gives: What it gets only in CIDR format
 323         my $subnet=$_[0];
 324         my $net;
 325         my $mask;
 326         my $full=0;
 327         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 328                 ($net,$mask) = split (/\//,$subnet);
 329                 $full=1;
 330                 return "$subnet";
 331         }else{
 332                 $mask=$subnet;
 333         }
 334         #Subnet already in decimal and valid?
 335         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 336                 for (my $i=0;$i<=32;$i++){
 337                         if (&General::cidrtosub($i) eq $mask){
 338                                 if ($full == 0){return $mask;}else{
 339                                                          return $net."/".$mask;
 340                                 }
 341                         }
 342                 }
 343         }
 344         #Subnet in binary format?
 345         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 346                         if($full == 0){ return &General::cidrtosub($mask);}else{
 347                                                  return $net."/".&General::cidrtosub($mask);
 348                         }
 349         }else{
 350                         return 3;
 351         }
 352         return 3;
 353 }
 354
 355
 356 sub iporsubtocidr
 357 {
 358         #gets: Ip Address  or subnetmask in decimal oder CIDR
 359         #Gives: What it gets only in CIDR format
 360         my $subnet=$_[0];
 361         my $net;
 362         my $mask;
 363         my $full=0;
 364         if ($subnet =~ /^(.*?)\/(.*?)$/) {
 365                 ($net,$mask) = split (/\//,$subnet);
 366                 $full=1;
 367         }else{
 368                 $mask=$subnet;
 369         }
 370         #Subnet in decimal and valid?
 371         if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))       {
 372                 for (my $i=0;$i<=32;$i++){
 373                         if (&General::cidrtosub($i) eq $mask){
 374                                 if ($full == 0){return &General::subtocidr($mask);}else{
 375                                                          return $net."/".&General::subtocidr($mask);
 376                                 }
 377                         }
 378                 }
 379         }
 380         #Subnet already in binary format?
 381         if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 382                         if($full == 0){ return $mask;}else{
 383                                                  return $net."/".$mask;
 384                         }
 385         }else{
 386                         return 3;
 387         }
 388         return 3;
 389 }
 390
 391 sub getnetworkip {
 392         my $arg = join("/", @_);
 393
 394         return &Network::get_netaddress($arg);
 395 }
 396
 397 sub getccdbc
 398 {
 399         #Gets: IP in Form ("192.168.0.0/24")
 400         #Gives: Broadcastaddress of network
 401         my $ccdnet=$_;
 402         my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
 403         my $ip_address_binary = inet_aton( $ccdip );
 404         my $netmask_binary    = ~pack("N", (2**(32-$ccdsubnet))-1);
 405         my $broadcast_address  = inet_ntoa( $ip_address_binary | ~$netmask_binary );
 406         return $broadcast_address;
 407 }
 408
 409 sub ip2dec  {
 410         return &Network::ip2bin(shift);
 411 }
 412
 413 sub dec2ip  {
 414         return &Network::bin2ip(shift);
 415 }
 416
 417 sub getnextip {
 418         return &Network::find_next_ip_address(shift, 4);
 419 }
 420
 421 sub getlastip {
 422         return &Network::find_next_ip_address(shift, -1);
 423 }
 424
 425 sub validipandmask
 426 {
 427         #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
 428         #Gives: True bzw 0 if success or false
 429         my $ccdnet=$_[0];
 430         my $subcidr;
 431
 432         if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
 433                 return 0;
 434         }
 435         my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
 436         #IP valid?
 437         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 ))) {
 438                 #Subnet in decimal and valid?
 439                 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255  && $2<=$1 && $3<=$2  && $4<=$3 )))  {
 440                         for (my $i=0;$i<=32;$i++){
 441                                 if (&General::cidrtosub($i) eq $ccdsubnet){
 442                                         return 1;
 443                                 }
 444                         }
 445                 #Subnet already in binary format?
 446                 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
 447                         return 1;
 448                 }else{
 449                         return 0;
 450                 }
 451
 452         }
 453         return 0;
 454 }
 455
 456 sub checksubnets
 457 {
 458         my %ccdconfhash=();
 459         my %ovpnconfhash=();
 460         my %vpnconf=();
 461         my %ipsecconf=();
 462         my %ownnet=();
 463         my %ovpnconf=();
 464         my @ccdconf=();
 465         my $ccdname=$_[0];
 466         my $ccdnet=$_[1];
 467         my $ownnet=$_[2];
 468         my $errormessage;
 469         my ($ip,$cidr)=split(/\//,$ccdnet);
 470         $cidr=&iporsubtocidr($cidr);
 471
 472         #get OVPN-Subnet (dynamic range)
 473         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 474         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 475         $ovpncidr=&iporsubtocidr($ovpncidr);
 476
 477         #check if we try to use same network as ovpn server
 478         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 479                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 480                         return $errormessage;
 481         }
 482
 483         #check if we try to use same network as another ovpn N2N
 484         if($ownnet ne 'ovpn'){
 485                 &readhasharray("${General::swroot}/ovpn/ovpnconfig", \%ovpnconfhash);
 486                 foreach my $key (keys %ovpnconfhash) {
 487                         if ($ovpnconfhash{$key}[3] eq 'net'){
 488                                 my @ovpnnet=split (/\//,$ovpnconfhash{$key}[11]);
 489                                 if (&IpInSubnet($ip,$ovpnnet[0],&iporsubtodec($ovpnnet[1]))){
 490                                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnn2n'}." $ovpnconfhash{$key}[1] <br>";
 491                                         return $errormessage;
 492                                 }
 493                         }
 494                 }
 495         }
 496
 497         #check if we use a network-name/subnet (static-ovpn) that already exists
 498         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 499         foreach my $key (keys %ccdconfhash) {
 500                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 501                 if ($ccdname eq $ccdconfhash{$key}[0])
 502                 {
 503                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 504                         return $errormessage;
 505                 }
 506                 my ($newip,$newsub) = split(/\//,$ccdnet);
 507                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 508                 {
 509                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
 510                         return $errormessage;
 511                 }
 512         }
 513
 514         #check if we use a ipsec right network which is already defined
 515         if($ownnet ne 'ipsec'){
 516                 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 517                 foreach my $key (keys %ipsecconf){
 518                         if ($ipsecconf{$key}[11] ne ''){
 519                                 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
 520                                 $ipsecsub=&iporsubtodec($ipsecsub);
 521                                 if($ipsecconf{$key}[1] ne $ccdname){
 522                                         if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 523                                                 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
 524                                                 return $errormessage;
 525                                         }
 526                                 }
 527                         }
 528                 }
 529         }
 530
 531         #check if we use the ipsec RW Network (if defined)
 532         &readhash("${General::swroot}/vpn/settings", \%vpnconf);
 533         if ($vpnconf{'RW_NET'} ne ''){
 534                 my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
 535                 if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
 536                 {
 537                         $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
 538                         return $errormessage;
 539                 }
 540         }
 541
 542         #check if we use one of ipfire's networks (green,orange,blue)
 543         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 544         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'GREEN_NETADDRESS'},&iporsubtodec($ownnet{'GREEN_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 545         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'ORANGE_NETADDRESS'},&iporsubtodec($ownnet{'ORANGE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 546         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'BLUE_NETADDRESS'},&iporsubtodec($ownnet{'BLUE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 547         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'RED_NETADDRESS'},&iporsubtodec($ownnet{'RED_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 548 }
 549
 550 sub check_net_internal{
 551         my $network=shift;
 552         my ($ip,$cidr)=split(/\//,$network);
 553         my %ownnet=();
 554         my $errormessage;
 555         $cidr=&iporsubtocidr($cidr);
 556         #check if we use one of ipfire's networks (green,orange,blue)
 557         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 558         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'GREEN_NETADDRESS'},&iporsubtodec($ownnet{'GREEN_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 559         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'ORANGE_NETADDRESS'},&iporsubtodec($ownnet{'ORANGE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 560         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'BLUE_NETADDRESS'},&iporsubtodec($ownnet{'BLUE_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 561         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &IpInSubnet($ip,$ownnet{'RED_NETADDRESS'},&iporsubtodec($ownnet{'RED_NETMASK'}))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 562 }
 563
 564 sub validport
 565 {
 566         $_ = $_[0];
 567
 568         if (!/^\d+$/) {
 569                 return 0; }
 570         if (/^0./) {
 571                 return 0; }
 572         if ($_ >= 1 && $_ <= 65535) {
 573                 return 1; }
 574         return 0;
 575 }
 576
 577 sub validproxyport
 578 {
 579         $_ = $_[0];
 580
 581         if (!/^\d+$/) {
 582                 return 0; }
 583         if (/^0./) {
 584                 return 0; }
 585         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 586                 return 0; }
 587         elsif ($_ >= 1 && $_ <= 65535) {
 588                 return 1; }
 589         return 0;
 590 }
 591
 592 sub validmac
 593 {
 594         my $checkmac = $_[0];
 595         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 596         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 597         {
 598                 return 0;
 599         }
 600         return 1;
 601 }
 602
 603 sub validhostname
 604 {
 605         # Checks a hostname against RFC1035
 606         my $hostname = $_[0];
 607
 608         # Each part should be at least two characters in length
 609         # but no more than 63 characters
 610         if (length ($hostname) < 1 || length ($hostname) > 63) {
 611                 return 0;}
 612         # Only valid characters are a-z, A-Z, 0-9 and -
 613         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 614                 return 0;}
 615         # First character can only be a letter or a digit
 616         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 617                 return 0;}
 618         # Last character can only be a letter or a digit
 619         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 620                 return 0;}
 621         return 1;
 622 }
 623
 624 sub validdomainname
 625 {
 626         my $part;
 627
 628         # Checks a domain name against RFC1035
 629         my $domainname = $_[0];
 630         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 631
 632         foreach $part (@parts) {
 633                 # Each part should be no more than 63 characters in length
 634                 if (length ($part) < 1 || length ($part) > 63) {
 635                         return 0;}
 636                 # Only valid characters are a-z, A-Z, 0-9 and -
 637                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 638                         return 0;}
 639                 # First character can only be a letter or a digit
 640                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 641                         return 0;}
 642                 # Last character can only be a letter or a digit
 643                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 644                         return 0;}
 645         }
 646         return 1;
 647 }
 648
 649 sub validfqdn
 650 {
 651         my $part;
 652
 653         # Checks a fully qualified domain name against RFC1035
 654         my $fqdn = $_[0];
 655         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 656         if (scalar(@parts) < 2) {               # At least two parts should
 657                 return 0;}                      # exist in a FQDN
 658                                                 # (i.e.hostname.domain)
 659         foreach $part (@parts) {
 660                 # Each part should be at least one character in length
 661                 # but no more than 63 characters
 662                 if (length ($part) < 1 || length ($part) > 63) {
 663                         return 0;}
 664                 # Only valid characters are a-z, A-Z, 0-9 and -
 665                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 666                         return 0;}
 667                 # First character can only be a letter or a digit
 668                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 669                         return 0;}
 670                 # Last character can only be a letter or a digit
 671                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 672                         return 0;}
 673         }
 674         return 1;
 675 }
 676
 677 sub validportrange # used to check a port range
 678 {
 679         my $port = $_[0]; # port values
 680         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 681         my $srcdst = $_[1]; # is it a source or destination port
 682
 683         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 684
 685                 if (!(&validport($port))) {
 686                         if ($srcdst eq 'src'){
 687                                 return $Lang::tr{'source port numbers'};
 688                         } else  {
 689                                 return $Lang::tr{'destination port numbers'};
 690                         }
 691                 }
 692         }
 693         else
 694         {
 695                 my @ports = ($1, $2);
 696                 if ($1 >= $2){
 697                         if ($srcdst eq 'src'){
 698                                 return $Lang::tr{'bad source range'};
 699                         } else  {
 700                                 return $Lang::tr{'bad destination range'};
 701                         }
 702                 }
 703                 foreach $_ (@ports)
 704                 {
 705                         if (!(&validport($_))) {
 706                                 if ($srcdst eq 'src'){
 707                                         return $Lang::tr{'source port numbers'};
 708                                 } else  {
 709                                         return $Lang::tr{'destination port numbers'};
 710                                 }
 711                         }
 712                 }
 713                 return;
 714         }
 715 }
 716
 717 sub IpInSubnet {
 718         my $addr = shift;
 719         my $network = shift;
 720         my $netmask = shift;
 721
 722         return &Network::ip_address_in_network($addr, "$network/$netmask");
 723 }
 724
 725 #
 726 # Return the following IP (IP+1) in dotted notation.
 727 # Call: NextIP ('1.1.1.1');
 728 # Return: '1.1.1.2'
 729 #
 730 sub NextIP {
 731         return &Network::find_next_ip_address(shift, 1);
 732 }
 733
 734 sub NextIP2 {
 735         return &Network::find_next_ip_address(shift, 4);
 736 }
 737
 738 sub ipcidr {
 739         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 740         return "$ip\/$cidr";
 741 }
 742
 743 sub ipcidr2msk {
 744        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 745        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 746        return "$ip\/$netmask";
 747 }
 748
 749 sub validemail {
 750     my $address = shift;
 751     my @parts = split( /\@/, $address );
 752     my $count=@parts;
 753
 754     #check if we have one part before and after '@'
 755     return 0 if ( $count != 2 );
 756
 757     #check if one of the parts starts or ends with a dot
 758     return 0 if ( substr($parts[0],0,1) eq '.' );
 759     return 0 if ( substr($parts[0],-1,1) eq '.' );
 760     return 0 if ( substr($parts[1],0,1) eq '.' );
 761     return 0 if ( substr($parts[1],-1,1) eq '.' );
 762
 763     #check first addresspart (before '@' sign)
 764     return 0 if  ( $parts[0] !~ m/^[a-zA-Z0-9\.!\-\+#]+$/ );
 765
 766     #check second addresspart (after '@' sign)
 767     return 0 if  ( $parts[1] !~ m/^[a-zA-Z0-9\.\-]+$/ );
 768
 769     return 1;
 770 }
 771
 772 #
 773 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 774 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 775 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 776 #
 777 sub readhasharray {
 778     my ($filename, $hash) = @_;
 779     %$hash = ();
 780
 781     open(FILE, $filename) or die "Unable to read file $filename";
 782
 783     while (<FILE>) {
 784         my ($key, $rest, @temp);
 785         chomp;
 786         ($key, $rest) = split (/,/, $_, 2);
 787         if ($key =~ /^[0-9]+$/) {
 788             @temp = split (/,/, $rest);
 789             $hash->{$key} = \@temp;
 790         }
 791     }
 792     close FILE;
 793     return;
 794 }
 795
 796 sub writehasharray {
 797     my ($filename, $hash) = @_;
 798     my ($key, @temp, $i);
 799
 800     open(FILE, ">$filename") or die "Unable to write to file $filename";
 801
 802     foreach $key (keys %$hash) {
 803                 if ($key =~ /^[0-9]+$/) {
 804                         print FILE "$key";
 805                         foreach $i (0 .. $#{$hash->{$key}}) {
 806                                 print FILE ",$hash->{$key}[$i]";
 807                         }
 808                         print FILE "\n";
 809                 }
 810     }
 811     close FILE;
 812     return;
 813 }
 814
 815 sub findhasharraykey {
 816     foreach my $i (1 .. 1000000) {
 817         if ( ! exists $_[0]{$i}) {
 818              return $i;
 819         }
 820     }
 821 }
 822
 823 sub srtarray
 824 # Darren Critchley - darrenc@telus.net - (c) 2003
 825 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 826 # This subroutine will take the following parameters:
 827 #   ColumnNumber = the column which you want to sort on, starts at 1
 828 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 829 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 830 #   ArrayToBeSorted = the array that wants sorting
 831 #
 832 #   Returns an array that is sorted to your specs
 833 #
 834 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 835 #
 836 {
 837         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 838         my @tmparray;
 839         my @srtedarray;
 840         my $line;
 841         my $newline;
 842         my $ctr;
 843         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 844         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 845                 return (@tobesorted);
 846         }
 847         my @tmp = split(/\,/,$tobesorted[0]);
 848         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 849
 850         # Darren Critchley - validate parameters
 851         if ($colno > $ttlitems){$colno = '1';}
 852         $colno--; # remove one from colno to deal with arrays starting at 0
 853         if($colno < 0){$colno = '0';}
 854         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 855         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 856
 857         foreach $line (@tobesorted)
 858         {
 859                 chomp($line);
 860                 if ($line ne '') {
 861                         my @temp = split(/\,/,$line);
 862                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 863                         my $tmpholder = $temp[0];
 864                         $temp[0] = $temp[$colno];
 865                         $temp[$colno] = $tmpholder;
 866                         $newline = "";
 867                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 868                                 $newline=$newline . $temp[$ctr] . ",";
 869                         }
 870                         chop($newline);
 871                         push(@tmparray,$newline);
 872                 }
 873         }
 874         if ($alpnum eq 'n') {
 875                 @tmparray = sort {$a <=> $b} @tmparray;
 876         } else {
 877                 @tmparray = (sort @tmparray);
 878         }
 879         foreach $line (@tmparray)
 880         {
 881                 chomp($line);
 882                 if ($line ne '') {
 883                         my @temp = split(/\,/,$line);
 884                         my $tmpholder = $temp[0];
 885                         $temp[0] = $temp[$colno];
 886                         $temp[$colno] = $tmpholder;
 887                         $newline = "";
 888                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 889                                 $newline=$newline . $temp[$ctr] . ",";
 890                         }
 891                         chop($newline);
 892                         push(@srtedarray,$newline);
 893                 }
 894         }
 895
 896         if ($srtdir eq 'dsc') {
 897                 @tmparray = reverse(@srtedarray);
 898                 return (@tmparray);
 899         } else {
 900                 return (@srtedarray);
 901         }
 902 }
 903
 904 sub FetchPublicIp {
 905     my %proxysettings;
 906     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 907     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 908         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 909         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 910     }
 911     my $user_agent = &MakeUserAgent();
 912     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
 913                                                     80,
 914                                                     "/",
 915                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
 916                                                 );
 917     if ($response =~ m%HTTP/1\.. 200 OK%) {
 918         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
 919         return $1;
 920     }
 921     return '';
 922 }
 923
 924 #
 925 # Check if hostname.domain provided have IP provided
 926 # use gethostbyname to verify that
 927 # Params:
 928 #       IP
 929 #       hostname
 930 #       domain
 931 # Output
 932 #       1 IP matches host.domain
 933 #       0 not in sync
 934 #
 935 sub DyndnsServiceSync ($;$;$) {
 936
 937     my ($ip,$hostName,$domain) = @_;
 938     my @addresses;
 939
 940     #fix me no ip GROUP, what is the name ?
 941     $hostName =~ s/$General::noipprefix//;
 942     if ($hostName) { #may be empty
 943         $hostName = "$hostName.$domain";
 944         @addresses = gethostbyname($hostName);
 945     }
 946
 947     if ($addresses[0] eq '') {                  # nothing returned ?
 948         $hostName = $domain;                    # try resolving with domain only
 949         @addresses = gethostbyname($hostName);
 950     }
 951
 952     if ($addresses[0] ne '') {                  # got something ?
 953         #&General::log("name:$addresses[0], alias:$addresses[1]");
 954         # Build clear text list of IP
 955         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 956         if (grep (/$ip/, @addresses)) {
 957             return 1;
 958         }
 959     }
 960     return 0;
 961 }
 962 #
 963 # This sub returns the red IP used to compare in DyndnsServiceSync
 964 #
 965 sub GetDyndnsRedIP {
 966     my %settings;
 967     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 968
 969     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 970     my $ip = <IP>;
 971     close(IP);
 972     chomp $ip;
 973
 974     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
 975     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 976         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 977         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
 978         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
 979     {
 980         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 981             my $RealIP = &General::FetchPublicIp;
 982             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 983         }
 984     }
 985     return $ip;
 986 }
 987
 988 # Translate ICMP code to text
 989 # ref: http://www.iana.org/assignments/icmp-parameters
 990 sub GetIcmpDescription ($) {
 991     my $index = shift;
 992     my @icmp_description = (
 993     'Echo Reply',                       #0
 994     'Unassigned',
 995     'Unassigned',
 996     'Destination Unreachable',
 997     'Source Quench',
 998     'Redirect',
 999     'Alternate Host Address',
1000     'Unassigned',
1001     'Echo',
1002     'Router Advertisement',
1003     'Router Solicitation',              #10
1004     'Time Exceeded',
1005     'Parameter Problem',
1006     'Timestamp',
1007     'Timestamp Reply',
1008     'Information Request',
1009     'Information Reply',
1010     'Address Mask Request',
1011     'Address Mask Reply',
1012     'Reserved (for Security)',
1013     'Reserved (for Robustness Experiment)', #20
1014     'Reserved',
1015     'Reserved',
1016     'Reserved',
1017     'Reserved',
1018     'Reserved',
1019     'Reserved',
1020     'Reserved',
1021     'Reserved',
1022     'Reserved',
1023     'Traceroute',                               #30
1024     'Datagram Conversion Error',
1025     'Mobile Host Redirect',
1026     'IPv6 Where-Are-You',
1027     'IPv6 I-Am-Here',
1028     'Mobile Registration Request',
1029     'Mobile Registration Reply',
1030     'Domain Name Request',
1031     'Domain Name Reply',
1032     'SKIP',
1033     'Photur',                           #40
1034     'Experimental');
1035     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1036 }
1037
1038 sub GetCoreUpdateVersion() {
1039         my $core_update;
1040
1041         open(FILE, "/opt/pakfire/db/core/mine");
1042         while (<FILE>) {
1043                 $core_update = $_;
1044                 last;
1045         }
1046         close(FILE);
1047
1048         return $core_update;
1049 }
1050
1051 sub MakeUserAgent() {
1052         my $user_agent = "IPFire/$General::version";
1053
1054         my $core_update = &GetCoreUpdateVersion();
1055         if ($core_update ne "") {
1056                 $user_agent .= "/$core_update";
1057         }
1058
1059         return $user_agent;
1060 }
1061
1062 sub RedIsWireless() {
1063         # This function checks if a network device is a wireless device.
1064
1065         my %settings = ();
1066         &readhash("${General::swroot}/ethernet/settings", \%settings);
1067
1068         # Find the name of the network device.
1069         my $device = $settings{'RED_DEV'};
1070
1071         # Exit, if no device is configured.
1072         return 0 if ($device eq "");
1073
1074         # Return 1 if the device is a wireless one.
1075         my $path = "/sys/class/net/$device/wireless";
1076         if (-d $path) {
1077                 return 1;
1078         }
1079
1080         # Otherwise return zero.
1081         return 0;
1082 }
1083
1084 # Function to read a file with UTF-8 charset.
1085 sub read_file_utf8 ($) {
1086         my ($file) = @_;
1087
1088         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1089         local $/ = undef;
1090         my $all = <$in>;
1091         close $in;
1092
1093         return $all;
1094 }
1095
1096 # Function to write a file with UTF-8 charset.
1097 sub write_file_utf8 ($) {
1098         my ($file, $content) = @_;
1099
1100         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1101         print $out $content;
1102         close $out;
1103
1104         return;
1105 }
1106
1107 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1108
1109 sub firewall_config_changed() {
1110         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1111         close FILE;
1112 }
1113
1114 sub firewall_needs_reload() {
1115         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1116                 return 1;
1117         }
1118
1119         return 0;
1120 }
1121
1122 sub firewall_reload() {
1123         system("/usr/local/bin/firewallctrl");
1124 }
1125
1126 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1127 sub get_red_interface() {
1128
1129         open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
1130
1131         my $interface = <IFACE>;
1132         close(IFACE);
1133         chomp $interface;
1134
1135         return $interface;
1136 }
1137
1138 1;