Firewall: Fixed portfw-converter (rules where not converted correctly) And Standard...
[people/teissler/ipfire-2.x.git] / config / cfgroot / general-functions.pl
CommitLineData
ac1cfefa
MT
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
15package General;
16
17use strict;
18use Socket;
19use IO::Socket;
c545beb1 20use Net::SSLeay;
8c877a82 21use Net::IPv4Addr qw(:all);
ac1cfefa
MT
22$|=1; # line buffering
23
776a1761
MT
24$General::version = 'VERSION';
25$General::swroot = 'CONFIG_ROOT';
ac1cfefa 26$General::noipprefix = 'noipg-';
c545beb1 27$General::adminmanualurl = 'http://wiki.ipfire.org';
ac1cfefa 28
c545beb1
MT
29#
30# log ("message") use default 'ipcop' tag
31# log ("tag","message") use your tag
32#
ac1cfefa
MT
33sub log
34{
c545beb1
MT
35 my $tag='ipfire';
36 $tag = shift if (@_>1);
ac1cfefa
MT
37 my $logmessage = $_[0];
38 $logmessage =~ /([\w\W]*)/;
39 $logmessage = $1;
77007ce5 40 system('logger', '-t', $tag, $logmessage);
ac1cfefa 41}
111c99dd
MT
42sub 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'}";
68f6312a 54 $defaultNetworks->{$Lang::tr{'green'}}{'NET'} = "$netsettings{'GREEN_ADDRESS'}";
111c99dd
MT
55 $defaultNetworks->{$Lang::tr{'green'}}{'NAME'} = "GREEN";
56
b9648e58 57 if ($netsettings{'RED_DEV'} ne ''){
223d3b1d 58 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'IPT'} = "$netsettings{'RED_NETADDRESS'}/$netsettings{'RED_NETMASK'}";
68f6312a 59 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NET'} = "$netsettings{'RED_ADDRESS'}";
223d3b1d 60 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NAME'} = "RED";
b9648e58 61 }
111c99dd
MT
62 if ($netsettings{'ORANGE_DEV'} ne ''){
63 $defaultNetworks->{$Lang::tr{'orange'}}{'IPT'} = "$netsettings{'ORANGE_NETADDRESS'}/$netsettings{'ORANGE_NETMASK'}";
68f6312a 64 $defaultNetworks->{$Lang::tr{'orange'}}{'NET'} = "$netsettings{'ORANGE_ADDRESS'}";
111c99dd
MT
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'}";
68f6312a 70 $defaultNetworks->{$Lang::tr{'blue'}}{'NET'} = "$netsettings{'BLUE_ADDRESS'}";
111c99dd
MT
71 $defaultNetworks->{$Lang::tr{'blue'}}{'NAME'} = "BLUE";
72 }
c7043621
AM
73
74 #IPFire himself
75 $defaultNetworks->{'IPFire'}{'NAME'} = "IPFire";
111c99dd
MT
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'});
1a8fde0e
AM
89 $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'ADR'} = $tempovpnsubnet[0];
90 $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'NAME'} = "OpenVPN-Dyn";
111c99dd
MT
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'});
6ee90535
AM
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);
111c99dd
MT
106 }
107 }
111c99dd
MT
108}
109sub 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]";
68f6312a 126 $defaultNetworks->{$temp[2]}{'NET'} = "$temp[0]";
111c99dd
MT
127
128 $ctr++;
129 }
130 }
131}
ac1cfefa
MT
132
133sub 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
77007ce5
MT
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;
ac1cfefa
MT
163 $hash->{$var} = $val;
164 }
165 }
166 close FILE;
167}
168
169
170sub 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 {
ad60e3ea 181 if ( $var eq "__CGI__"){next;}
ac1cfefa
MT
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
90c2e164
CS
196sub 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}
ac1cfefa
MT
231
232sub age
233{
234 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
235 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
236 my $now = time;
3687a2e2
JIW
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
ac1cfefa
MT
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
3687a2e2
JIW
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};
ac1cfefa
MT
294}
295
296sub 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
316sub 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
333sub 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
8c877a82 351sub subtocidr
ac1cfefa 352{
8c877a82
AM
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}
ac1cfefa 361
8c877a82
AM
362sub 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
371sub 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
408sub 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
443sub 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
454sub 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}
e81be1e1
AM
465
466sub 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
479sub 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
8c877a82
AM
494sub getnextip
495{
e81be1e1
AM
496 my $decip=&ip2dec($_[0]);
497 $decip=$decip+4;
498 return &dec2ip($decip);
8c877a82 499}
e81be1e1 500
8c877a82
AM
501sub getlastip
502{
e81be1e1
AM
503 my $decip=&ip2dec($_[0]);
504 $decip--;
505 return &dec2ip($decip);
8c877a82
AM
506}
507
508sub 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 ))) {
290007b3 523 for (my $i=8;$i<=32;$i++){
8c877a82
AM
524 if (&General::cidrtosub($i) eq $ccdsubnet){
525 return 1;
526 }
527 }
528 #Subnet already in binary format?
290007b3 529 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
8c877a82
AM
530 return 1;
531 }else{
532 return 0;
533 }
534
535 }
536 return 0;
ac1cfefa
MT
537}
538
e2429e8d
AM
539sub checksubnets
540{
e2429e8d
AM
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);
e2429e8d
AM
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);
e2429e8d
AM
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 }
e2429e8d
AM
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 }
e2429e8d 573 }
e2429e8d
AM
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 ''){
e2429e8d
AM
579 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
580 $ipsecsub=&iporsubtodec($ipsecsub);
f7e3d208
AM
581 if($ipsecconf{$key}[1] ne $ccdname){
582 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
ac2f7107 583 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[1]";
f7e3d208
AM
584 return $errormessage;
585 }
e2429e8d
AM
586 }
587 }
588 }
e2429e8d
AM
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;}
e2429e8d
AM
596}
597
598
ac1cfefa
MT
599sub 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
d30ea451
CS
612sub 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
ac1cfefa
MT
627sub 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
638sub 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 -
8c877a82 648 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
ac1cfefa
MT
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
659sub 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
685sub 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
713sub 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
758sub 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
c545beb1
MT
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#
773sub NextIP
774{
775 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
776 )
777 );
778}
8c877a82
AM
779sub NextIP2
780{
781 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
782 )
783 );
784}
45762fc6
AF
785sub ipcidr
786{
787 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
788 return "$ip\/$cidr";
789}
790
54fd0535
MT
791sub 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
ac1cfefa
MT
799sub 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
c545beb1
MT
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#
ac1cfefa
MT
816sub 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);
c545beb1 826 if ($key =~ /^[0-9]+$/) {
ac1cfefa
MT
827 @temp = split (/,/, $rest);
828 $hash->{$key} = \@temp;
829 }
830 }
831 close FILE;
832 return;
833}
834
835sub 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) {
8c877a82
AM
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 }
ac1cfefa
MT
849 }
850 close FILE;
851 return;
852}
853
854sub findhasharraykey {
855 foreach my $i (1 .. 1000000) {
856 if ( ! exists $_[0]{$i}) {
857 return $i;
858 }
859 }
860}
861
862sub 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
943sub 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 }
b2f8244a 950 my $user_agent = &MakeUserAgent();
0aa0cdcd 951 my ($out, $response) = Net::SSLeay::get_http( 'checkip4.dns.lightningwirelabs.com',
ac1cfefa
MT
952 80,
953 "/",
b2f8244a 954 Net::SSLeay::make_headers('User-Agent' => $user_agent )
ac1cfefa
MT
955 );
956 if ($response =~ m%HTTP/1\.. 200 OK%) {
5a2935b1 957 $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
ac1cfefa
MT
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#
974sub 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#
1004sub 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
057dbeeb 1013 # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
ac1cfefa
MT
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') ||
057dbeeb
MT
1016 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
1017 &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
ac1cfefa
MT
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}
c545beb1
MT
1026
1027# Translate ICMP code to text
1028# ref: http://www.iana.org/assignments/icmp-parameters
1029sub 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}
b2f8244a
MT
1076
1077sub 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
1090sub 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
61027579
MT
1101sub 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
dfee7582
SS
1123# Function to read a file with UTF-8 charset.
1124sub 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
3e862ce4 1132 return $all;
dfee7582
SS
1133}
1134
1135# Function to write a file with UTF-8 charset.
1136sub 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
6d8eb5de 1146my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
0e430797
MT
1147
1148sub firewall_config_changed() {
1149 open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1150 close FILE;
1151}
1152
1153sub firewall_needs_reload() {
1154 if (-e "$FIREWALL_RELOAD_INDICATOR") {
1155 return 1;
1156 }
1157
1158 return 0;
1159}
1160
1161sub firewall_reload() {
8039a710 1162 system("/usr/local/bin/firewallctrl");
0e430797
MT
1163}
1164
ac1cfefa 11651;