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