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