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