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