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 $checktype=$_[3];
 469         my $errormessage;
 470         my ($ip,$cidr)=split(/\//,$ccdnet);
 471         $cidr=&iporsubtocidr($cidr);
 472
 473         #get OVPN-Subnet (dynamic range)
 474         &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
 475         my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
 476         $ovpncidr=&iporsubtocidr($ovpncidr);
 477
 478         #check if we try to use same network as ovpn server
 479         if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
 480                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
 481                         return $errormessage;
 482         }
 483
 484         #check if we try to use same network as another ovpn N2N
 485         if($ownnet ne 'ovpn'){
 486                 &readhasharray("${General::swroot}/ovpn/ovpnconfig", \%ovpnconfhash);
 487                 foreach my $key (keys %ovpnconfhash) {
 488                         if ($ovpnconfhash{$key}[3] eq 'net'){
 489                                 my @ovpnnet=split (/\//,$ovpnconfhash{$key}[11]);
 490                                 if (&IpInSubnet($ip,$ovpnnet[0],&iporsubtodec($ovpnnet[1]))){
 491                                         $errormessage=$errormessage.$Lang::tr{'ccd err isovpnn2n'}." $ovpnconfhash{$key}[1] <br>";
 492                                         return $errormessage;
 493                                 }
 494                         }
 495                 }
 496         }
 497
 498         #check if we use a network-name/subnet (static-ovpn) that already exists
 499         &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
 500         foreach my $key (keys %ccdconfhash) {
 501                 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
 502                 if ($ccdname eq $ccdconfhash{$key}[0])
 503                 {
 504                         $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
 505                         return $errormessage;
 506                 }
 507                 my ($newip,$newsub) = split(/\//,$ccdnet);
 508                 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
 509                 {
 510                         $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
 511                         return $errormessage;
 512                 }
 513         }
 514
 515         #check if we use a ipsec right network which is already defined
 516         if($ownnet ne 'ipsec'){
 517                 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
 518                 foreach my $key (keys %ipsecconf){
 519                         if ($ipsecconf{$key}[11] ne ''){
 520                                 foreach my $ipsecsubitem (split(/\|/, $ipsecconf{$key}[11])) {
 521                                         my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
 522                                         $ipsecsub=&iporsubtodec($ipsecsub);
 523                                         if($ipsecconf{$key}[1] ne $ccdname){
 524                                                 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
 525                                                         $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name:  $ipsecconf{$key}[1]";
 526                                                         return $errormessage;
 527                                                 }
 528                                         }
 529                                 }
 530                         }
 531                 }
 532         }
 533
 534         #check if we use the ipsec RW Network (if defined)
 535         &readhash("${General::swroot}/vpn/settings", \%vpnconf);
 536         if ($vpnconf{'RW_NET'} ne ''){
 537                 my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
 538                 if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
 539                 {
 540                         $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
 541                         return $errormessage;
 542                 }
 543         }
 544
 545         #call check_net_internal
 546         if ($checktype eq "exact")
 547         {
 548                 &General::check_net_internal_exact($ccdnet);
 549         }else{
 550                 &General::check_net_internal_range($ccdnet);
 551         }
 552 }
 553
 554 sub check_net_internal_range{
 555         my $network=shift;
 556         my ($ip,$cidr)=split(/\//,$network);
 557         my %ownnet=();
 558         my $errormessage;
 559         $cidr=&iporsubtocidr($cidr);
 560         #check if we use one of ipfire's networks (green,orange,blue)
 561         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 562         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;}
 563         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;}
 564         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;}
 565         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;}
 566 }
 567
 568 sub check_net_internal_exact{
 569         my $network=shift;
 570         my ($ip,$cidr)=split(/\//,$network);
 571         my %ownnet=();
 572         my $errormessage;
 573         $cidr=&iporsubtocidr($cidr);
 574         #check if we use one of ipfire's networks (green,orange,blue)
 575         &readhash("${General::swroot}/ethernet/settings", \%ownnet);
 576         if (($ownnet{'GREEN_NETADDRESS'}        ne '' && $ownnet{'GREEN_NETADDRESS'}    ne '0.0.0.0') && &Network::network_equal("$ownnet{'GREEN_NETADDRESS'}/$ownnet{'GREEN_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
 577         if (($ownnet{'ORANGE_NETADDRESS'}       ne '' && $ownnet{'ORANGE_NETADDRESS'}   ne '0.0.0.0') && &Network::network_equal("$ownnet{'ORANGE_NETADDRESS'}/$ownnet{'ORANGE_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
 578         if (($ownnet{'BLUE_NETADDRESS'}         ne '' && $ownnet{'BLUE_NETADDRESS'}     ne '0.0.0.0') && &Network::network_equal("$ownnet{'BLUE_NETADDRESS'}/$ownnet{'BLUE_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
 579         if (($ownnet{'RED_NETADDRESS'}          ne '' && $ownnet{'RED_NETADDRESS'}              ne '0.0.0.0') && &Network::network_equal("$ownnet{'RED_NETADDRESS'}/$ownnet{'RED_NETMASK'}", $network)){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
 580 }
 581
 582 sub validport
 583 {
 584         $_ = $_[0];
 585
 586         if (!/^\d+$/) {
 587                 return 0; }
 588         if (/^0./) {
 589                 return 0; }
 590         if ($_ >= 1 && $_ <= 65535) {
 591                 return 1; }
 592         return 0;
 593 }
 594
 595 sub validproxyport
 596 {
 597         $_ = $_[0];
 598
 599         if (!/^\d+$/) {
 600                 return 0; }
 601         if (/^0./) {
 602                 return 0; }
 603         if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
 604                 return 0; }
 605         elsif ($_ >= 1 && $_ <= 65535) {
 606                 return 1; }
 607         return 0;
 608 }
 609
 610 sub validmac
 611 {
 612         my $checkmac = $_[0];
 613         my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
 614         if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
 615         {
 616                 return 0;
 617         }
 618         return 1;
 619 }
 620
 621 sub validhostname
 622 {
 623         # Checks a hostname against RFC1035
 624         my $hostname = $_[0];
 625
 626         # Each part should be at least two characters in length
 627         # but no more than 63 characters
 628         if (length ($hostname) < 1 || length ($hostname) > 63) {
 629                 return 0;}
 630         # Only valid characters are a-z, A-Z, 0-9 and -
 631         if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
 632                 return 0;}
 633         # First character can only be a letter or a digit
 634         if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 635                 return 0;}
 636         # Last character can only be a letter or a digit
 637         if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 638                 return 0;}
 639         return 1;
 640 }
 641
 642 sub validdomainname
 643 {
 644         my $part;
 645
 646         # Checks a domain name against RFC1035
 647         my $domainname = $_[0];
 648         my @parts = split (/\./, $domainname);  # Split hostname at the '.'
 649
 650         foreach $part (@parts) {
 651                 # Each part should be no more than 63 characters in length
 652                 if (length ($part) < 1 || length ($part) > 63) {
 653                         return 0;}
 654                 # Only valid characters are a-z, A-Z, 0-9, _ and -
 655                 if ($part !~ /^[a-zA-Z0-9_-]*$/) {
 656                         return 0;
 657                 }
 658         }
 659         return 1;
 660 }
 661
 662 sub validfqdn
 663 {
 664         my $part;
 665
 666         # Checks a fully qualified domain name against RFC1035
 667         my $fqdn = $_[0];
 668         my @parts = split (/\./, $fqdn);        # Split hostname at the '.'
 669         if (scalar(@parts) < 2) {               # At least two parts should
 670                 return 0;}                      # exist in a FQDN
 671                                                 # (i.e.hostname.domain)
 672         foreach $part (@parts) {
 673                 # Each part should be at least one character in length
 674                 # but no more than 63 characters
 675                 if (length ($part) < 1 || length ($part) > 63) {
 676                         return 0;}
 677                 # Only valid characters are a-z, A-Z, 0-9 and -
 678                 if ($part !~ /^[a-zA-Z0-9-]*$/) {
 679                         return 0;}
 680                 # First character can only be a letter or a digit
 681                 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
 682                         return 0;}
 683                 # Last character can only be a letter or a digit
 684                 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
 685                         return 0;}
 686         }
 687         return 1;
 688 }
 689
 690 sub validportrange # used to check a port range
 691 {
 692         my $port = $_[0]; # port values
 693         $port =~ tr/-/:/; # replace all - with colons just in case someone used -
 694         my $srcdst = $_[1]; # is it a source or destination port
 695
 696         if (!($port =~ /^(\d+)\:(\d+)$/)) {
 697
 698                 if (!(&validport($port))) {
 699                         if ($srcdst eq 'src'){
 700                                 return $Lang::tr{'source port numbers'};
 701                         } else  {
 702                                 return $Lang::tr{'destination port numbers'};
 703                         }
 704                 }
 705         }
 706         else
 707         {
 708                 my @ports = ($1, $2);
 709                 if ($1 >= $2){
 710                         if ($srcdst eq 'src'){
 711                                 return $Lang::tr{'bad source range'};
 712                         } else  {
 713                                 return $Lang::tr{'bad destination range'};
 714                         }
 715                 }
 716                 foreach $_ (@ports)
 717                 {
 718                         if (!(&validport($_))) {
 719                                 if ($srcdst eq 'src'){
 720                                         return $Lang::tr{'source port numbers'};
 721                                 } else  {
 722                                         return $Lang::tr{'destination port numbers'};
 723                                 }
 724                         }
 725                 }
 726                 return;
 727         }
 728 }
 729
 730 sub IpInSubnet {
 731         my $addr = shift;
 732         my $network = shift;
 733         my $netmask = shift;
 734
 735         return &Network::ip_address_in_network($addr, "$network/$netmask");
 736 }
 737
 738 #
 739 # Return the following IP (IP+1) in dotted notation.
 740 # Call: NextIP ('1.1.1.1');
 741 # Return: '1.1.1.2'
 742 #
 743 sub NextIP {
 744         return &Network::find_next_ip_address(shift, 1);
 745 }
 746
 747 sub NextIP2 {
 748         return &Network::find_next_ip_address(shift, 4);
 749 }
 750
 751 sub ipcidr {
 752         my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 753         return "$ip\/$cidr";
 754 }
 755
 756 sub ipcidr2msk {
 757        my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
 758        my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
 759        return "$ip\/$netmask";
 760 }
 761
 762 sub validemail {
 763     my $address = shift;
 764     my @parts = split( /\@/, $address );
 765     my $count=@parts;
 766
 767     #check if we have one part before and after '@'
 768     return 0 if ( $count != 2 );
 769
 770     #check if one of the parts starts or ends with a dot
 771     return 0 if ( substr($parts[0],0,1) eq '.' );
 772     return 0 if ( substr($parts[0],-1,1) eq '.' );
 773     return 0 if ( substr($parts[1],0,1) eq '.' );
 774     return 0 if ( substr($parts[1],-1,1) eq '.' );
 775
 776     #check first addresspart (before '@' sign)
 777     return 0 if  ( $parts[0] !~ m/^[a-zA-Z0-9\.!\-\+#]+$/ );
 778
 779     #check second addresspart (after '@' sign)
 780     return 0 if  ( $parts[1] !~ m/^[a-zA-Z0-9\.\-]+$/ );
 781
 782     return 1;
 783 }
 784
 785 #
 786 # Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
 787 # The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
 788 # this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
 789 #
 790 sub readhasharray {
 791     my ($filename, $hash) = @_;
 792     %$hash = ();
 793
 794     open(FILE, $filename) or die "Unable to read file $filename";
 795
 796     while (<FILE>) {
 797         my ($key, $rest, @temp);
 798         chomp;
 799         ($key, $rest) = split (/,/, $_, 2);
 800         if ($key =~ /^[0-9]+$/) {
 801             @temp = split (/,/, $rest);
 802             $hash->{$key} = \@temp;
 803         }
 804     }
 805     close FILE;
 806     return;
 807 }
 808
 809 sub writehasharray {
 810     my ($filename, $hash) = @_;
 811     my ($key, @temp, $i);
 812
 813     open(FILE, ">$filename") or die "Unable to write to file $filename";
 814
 815     foreach $key (keys %$hash) {
 816                 if ($key =~ /^[0-9]+$/) {
 817                         print FILE "$key";
 818                         foreach $i (0 .. $#{$hash->{$key}}) {
 819                                 print FILE ",$hash->{$key}[$i]";
 820                         }
 821                         print FILE "\n";
 822                 }
 823     }
 824     close FILE;
 825     return;
 826 }
 827
 828 sub findhasharraykey {
 829     foreach my $i (1 .. 1000000) {
 830         if ( ! exists $_[0]{$i}) {
 831              return $i;
 832         }
 833     }
 834 }
 835
 836 sub srtarray
 837 # Darren Critchley - darrenc@telus.net - (c) 2003
 838 # &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
 839 # This subroutine will take the following parameters:
 840 #   ColumnNumber = the column which you want to sort on, starts at 1
 841 #   AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
 842 #   SortDirection = asc or dsc (lowercase) Ascending or Descending sort
 843 #   ArrayToBeSorted = the array that wants sorting
 844 #
 845 #   Returns an array that is sorted to your specs
 846 #
 847 #   If SortOrder is greater than the elements in array, then it defaults to the first element
 848 #
 849 {
 850         my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
 851         my @tmparray;
 852         my @srtedarray;
 853         my $line;
 854         my $newline;
 855         my $ctr;
 856         my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
 857         if ($ttlitems < 1){ # if no items, don't waste our time lets leave
 858                 return (@tobesorted);
 859         }
 860         my @tmp = split(/\,/,$tobesorted[0]);
 861         $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
 862
 863         # Darren Critchley - validate parameters
 864         if ($colno > $ttlitems){$colno = '1';}
 865         $colno--; # remove one from colno to deal with arrays starting at 0
 866         if($colno < 0){$colno = '0';}
 867         if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
 868         if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
 869
 870         foreach $line (@tobesorted)
 871         {
 872                 chomp($line);
 873                 if ($line ne '') {
 874                         my @temp = split(/\,/,$line);
 875                         # Darren Critchley - juggle the fields so that the one we want to sort on is first
 876                         my $tmpholder = $temp[0];
 877                         $temp[0] = $temp[$colno];
 878                         $temp[$colno] = $tmpholder;
 879                         $newline = "";
 880                         for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
 881                                 $newline=$newline . $temp[$ctr] . ",";
 882                         }
 883                         chop($newline);
 884                         push(@tmparray,$newline);
 885                 }
 886         }
 887         if ($alpnum eq 'n') {
 888                 @tmparray = sort {$a <=> $b} @tmparray;
 889         } else {
 890                 @tmparray = (sort @tmparray);
 891         }
 892         foreach $line (@tmparray)
 893         {
 894                 chomp($line);
 895                 if ($line ne '') {
 896                         my @temp = split(/\,/,$line);
 897                         my $tmpholder = $temp[0];
 898                         $temp[0] = $temp[$colno];
 899                         $temp[$colno] = $tmpholder;
 900                         $newline = "";
 901                         for ($ctr=0; $ctr < $ttlitems ; $ctr++){
 902                                 $newline=$newline . $temp[$ctr] . ",";
 903                         }
 904                         chop($newline);
 905                         push(@srtedarray,$newline);
 906                 }
 907         }
 908
 909         if ($srtdir eq 'dsc') {
 910                 @tmparray = reverse(@srtedarray);
 911                 return (@tmparray);
 912         } else {
 913                 return (@srtedarray);
 914         }
 915 }
 916
 917 sub FetchPublicIp {
 918     my %proxysettings;
 919     &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
 920     if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
 921         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
 922         Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
 923     }
 924     my $user_agent = &MakeUserAgent();
 925     my ($out, $response) = Net::SSLeay::get_http(  'checkip4.dns.lightningwirelabs.com',
 926                                                     80,
 927                                                     "/",
 928                                                     Net::SSLeay::make_headers('User-Agent' => $user_agent )
 929                                                 );
 930     if ($response =~ m%HTTP/1\.. 200 OK%) {
 931         $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
 932         return $1;
 933     }
 934     return '';
 935 }
 936
 937 #
 938 # Check if hostname.domain provided have IP provided
 939 # use gethostbyname to verify that
 940 # Params:
 941 #       IP
 942 #       hostname
 943 #       domain
 944 # Output
 945 #       1 IP matches host.domain
 946 #       0 not in sync
 947 #
 948 sub DyndnsServiceSync ($;$;$) {
 949
 950     my ($ip,$hostName,$domain) = @_;
 951     my @addresses;
 952
 953     #fix me no ip GROUP, what is the name ?
 954     $hostName =~ s/$General::noipprefix//;
 955     if ($hostName) { #may be empty
 956         $hostName = "$hostName.$domain";
 957         @addresses = gethostbyname($hostName);
 958     }
 959
 960     if ($addresses[0] eq '') {                  # nothing returned ?
 961         $hostName = $domain;                    # try resolving with domain only
 962         @addresses = gethostbyname($hostName);
 963     }
 964
 965     if ($addresses[0] ne '') {                  # got something ?
 966         #&General::log("name:$addresses[0], alias:$addresses[1]");
 967         # Build clear text list of IP
 968         @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
 969         if (grep (/$ip/, @addresses)) {
 970             return 1;
 971         }
 972     }
 973     return 0;
 974 }
 975 #
 976 # This sub returns the red IP used to compare in DyndnsServiceSync
 977 #
 978 sub GetDyndnsRedIP {
 979     my %settings;
 980     &General::readhash("${General::swroot}/ddns/settings", \%settings);
 981
 982     open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
 983     my $ip = <IP>;
 984     close(IP);
 985     chomp $ip;
 986
 987     # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
 988     if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
 989         &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
 990         &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
 991         &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
 992     {
 993         if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
 994             my $RealIP = &General::FetchPublicIp;
 995             $ip = (&General::validip ($RealIP) ?  $RealIP : 'unavailable');
 996         }
 997     }
 998     return $ip;
 999 }
1000
1001 # Translate ICMP code to text
1002 # ref: http://www.iana.org/assignments/icmp-parameters
1003 sub GetIcmpDescription ($) {
1004     my $index = shift;
1005     my @icmp_description = (
1006     'Echo Reply',                       #0
1007     'Unassigned',
1008     'Unassigned',
1009     'Destination Unreachable',
1010     'Source Quench',
1011     'Redirect',
1012     'Alternate Host Address',
1013     'Unassigned',
1014     'Echo',
1015     'Router Advertisement',
1016     'Router Solicitation',              #10
1017     'Time Exceeded',
1018     'Parameter Problem',
1019     'Timestamp',
1020     'Timestamp Reply',
1021     'Information Request',
1022     'Information Reply',
1023     'Address Mask Request',
1024     'Address Mask Reply',
1025     'Reserved (for Security)',
1026     'Reserved (for Robustness Experiment)', #20
1027     'Reserved',
1028     'Reserved',
1029     'Reserved',
1030     'Reserved',
1031     'Reserved',
1032     'Reserved',
1033     'Reserved',
1034     'Reserved',
1035     'Reserved',
1036     'Traceroute',                               #30
1037     'Datagram Conversion Error',
1038     'Mobile Host Redirect',
1039     'IPv6 Where-Are-You',
1040     'IPv6 I-Am-Here',
1041     'Mobile Registration Request',
1042     'Mobile Registration Reply',
1043     'Domain Name Request',
1044     'Domain Name Reply',
1045     'SKIP',
1046     'Photur',                           #40
1047     'Experimental');
1048     if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1049 }
1050
1051 sub GetCoreUpdateVersion() {
1052         my $core_update;
1053
1054         open(FILE, "/opt/pakfire/db/core/mine");
1055         while (<FILE>) {
1056                 $core_update = $_;
1057                 last;
1058         }
1059         close(FILE);
1060
1061         return $core_update;
1062 }
1063
1064 sub MakeUserAgent() {
1065         my $user_agent = "IPFire/$General::version";
1066
1067         my $core_update = &GetCoreUpdateVersion();
1068         if ($core_update ne "") {
1069                 $user_agent .= "/$core_update";
1070         }
1071
1072         return $user_agent;
1073 }
1074
1075 sub RedIsWireless() {
1076         # This function checks if a network device is a wireless device.
1077
1078         my %settings = ();
1079         &readhash("${General::swroot}/ethernet/settings", \%settings);
1080
1081         # Find the name of the network device.
1082         my $device = $settings{'RED_DEV'};
1083
1084         # Exit, if no device is configured.
1085         return 0 if ($device eq "");
1086
1087         # Return 1 if the device is a wireless one.
1088         my $path = "/sys/class/net/$device/wireless";
1089         if (-d $path) {
1090                 return 1;
1091         }
1092
1093         # Otherwise return zero.
1094         return 0;
1095 }
1096
1097 # Function to read a file with UTF-8 charset.
1098 sub read_file_utf8 ($) {
1099         my ($file) = @_;
1100
1101         open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1102         local $/ = undef;
1103         my $all = <$in>;
1104         close $in;
1105
1106         return $all;
1107 }
1108
1109 # Function to write a file with UTF-8 charset.
1110 sub write_file_utf8 ($) {
1111         my ($file, $content) = @_;
1112
1113         open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1114         print $out $content;
1115         close $out;
1116
1117         return;
1118 }
1119
1120 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1121
1122 sub firewall_config_changed() {
1123         open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1124         close FILE;
1125 }
1126
1127 sub firewall_needs_reload() {
1128         if (-e "$FIREWALL_RELOAD_INDICATOR") {
1129                 return 1;
1130         }
1131
1132         return 0;
1133 }
1134
1135 sub firewall_reload() {
1136         system("/usr/local/bin/firewallctrl");
1137 }
1138
1139 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1140 sub get_red_interface() {
1141
1142         open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
1143
1144         my $interface = <IFACE>;
1145         close(IFACE);
1146         chomp $interface;
1147
1148         return $interface;
1149 }
1150
1151 sub dnssec_status() {
1152         my $path = "${General::swroot}/red/dnssec-status";
1153
1154         open(STATUS, $path) or return 0;
1155         my $status = <STATUS>;
1156         close(STATUS);
1157
1158         chomp($status);
1159
1160         return $status;
1161 }
1162
1163 1;