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