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