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