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