general-functions.pl: Add function to get full country name.
[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;
cebb1b7c 20use Locale::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 ''){
519 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
520 $ipsecsub=&iporsubtodec($ipsecsub);
521 if($ipsecconf{$key}[1] ne $ccdname){
522 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
523 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[1]";
524 return $errormessage;
525 }
f7e3d208 526 }
e2429e8d
AM
527 }
528 }
529 }
4d81e0f3
AM
530
531 #check if we use the ipsec RW Network (if defined)
532 &readhash("${General::swroot}/vpn/settings", \%vpnconf);
533 if ($vpnconf{'RW_NET'} ne ''){
534 my ($ipsecrwnet,$ipsecrwsub)=split (/\//, $vpnconf{'RW_NET'});
535 if (&IpInSubnet($ip,$ipsecrwnet,&iporsubtodec($ipsecrwsub)))
536 {
537 $errormessage=$errormessage.$Lang::tr{'ccd err isipsecrw'}."<br>";
538 return $errormessage;
539 }
540 }
541
e2429e8d 542 #check if we use one of ipfire's networks (green,orange,blue)
e2429e8d 543 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
4d81e0f3
AM
544 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;}
545 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;}
546 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;}
547 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;}
e2429e8d
AM
548}
549
29f238b2
AM
550sub check_net_internal{
551 my $network=shift;
552 my ($ip,$cidr)=split(/\//,$network);
553 my %ownnet=();
554 my $errormessage;
555 $cidr=&iporsubtocidr($cidr);
556 #check if we use one of ipfire's networks (green,orange,blue)
557 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
558 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;}
559 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;}
560 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;}
561 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;}
562}
e2429e8d 563
ac1cfefa
MT
564sub validport
565{
566 $_ = $_[0];
567
568 if (!/^\d+$/) {
569 return 0; }
570 if (/^0./) {
571 return 0; }
572 if ($_ >= 1 && $_ <= 65535) {
573 return 1; }
574 return 0;
575}
576
d30ea451
CS
577sub validproxyport
578{
579 $_ = $_[0];
580
581 if (!/^\d+$/) {
582 return 0; }
583 if (/^0./) {
584 return 0; }
585 if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
586 return 0; }
587 elsif ($_ >= 1 && $_ <= 65535) {
588 return 1; }
589 return 0;
590}
591
ac1cfefa
MT
592sub validmac
593{
594 my $checkmac = $_[0];
595 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
596 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
597 {
598 return 0;
599 }
600 return 1;
601}
602
603sub validhostname
604{
605 # Checks a hostname against RFC1035
606 my $hostname = $_[0];
607
608 # Each part should be at least two characters in length
609 # but no more than 63 characters
610 if (length ($hostname) < 1 || length ($hostname) > 63) {
611 return 0;}
612 # Only valid characters are a-z, A-Z, 0-9 and -
8c877a82 613 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
ac1cfefa
MT
614 return 0;}
615 # First character can only be a letter or a digit
616 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
617 return 0;}
618 # Last character can only be a letter or a digit
619 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
620 return 0;}
621 return 1;
622}
623
624sub validdomainname
625{
626 my $part;
627
628 # Checks a domain name against RFC1035
629 my $domainname = $_[0];
630 my @parts = split (/\./, $domainname); # Split hostname at the '.'
631
632 foreach $part (@parts) {
8ed77b03
AG
633 # Each part should be no more than 63 characters in length
634 if (length ($part) < 1 || length ($part) > 63) {
ac1cfefa
MT
635 return 0;}
636 # Only valid characters are a-z, A-Z, 0-9 and -
637 if ($part !~ /^[a-zA-Z0-9-]*$/) {
638 return 0;}
639 # First character can only be a letter or a digit
640 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
641 return 0;}
642 # Last character can only be a letter or a digit
643 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
644 return 0;}
645 }
646 return 1;
647}
648
649sub validfqdn
650{
651 my $part;
652
653 # Checks a fully qualified domain name against RFC1035
654 my $fqdn = $_[0];
655 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
656 if (scalar(@parts) < 2) { # At least two parts should
657 return 0;} # exist in a FQDN
658 # (i.e. hostname.domain)
659 foreach $part (@parts) {
660 # Each part should be at least one character in length
661 # but no more than 63 characters
662 if (length ($part) < 1 || length ($part) > 63) {
663 return 0;}
664 # Only valid characters are a-z, A-Z, 0-9 and -
665 if ($part !~ /^[a-zA-Z0-9-]*$/) {
666 return 0;}
667 # First character can only be a letter or a digit
668 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
669 return 0;}
670 # Last character can only be a letter or a digit
671 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
672 return 0;}
673 }
674 return 1;
675}
676
677sub validportrange # used to check a port range
678{
679 my $port = $_[0]; # port values
680 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
681 my $srcdst = $_[1]; # is it a source or destination port
682
683 if (!($port =~ /^(\d+)\:(\d+)$/)) {
684
685 if (!(&validport($port))) {
686 if ($srcdst eq 'src'){
687 return $Lang::tr{'source port numbers'};
688 } else {
689 return $Lang::tr{'destination port numbers'};
690 }
691 }
692 }
693 else
694 {
695 my @ports = ($1, $2);
696 if ($1 >= $2){
697 if ($srcdst eq 'src'){
698 return $Lang::tr{'bad source range'};
699 } else {
700 return $Lang::tr{'bad destination range'};
701 }
702 }
703 foreach $_ (@ports)
704 {
705 if (!(&validport($_))) {
706 if ($srcdst eq 'src'){
707 return $Lang::tr{'source port numbers'};
708 } else {
709 return $Lang::tr{'destination port numbers'};
710 }
711 }
712 }
713 return;
714 }
715}
716
4e9a2b57 717sub IpInSubnet {
ab92dc0c
AM
718 my $addr = shift;
719 my $network = shift;
720 my $netmask = shift;
721
4e9a2b57 722 return &Network::ip_address_in_network($addr, "$network/$netmask");
ac1cfefa
MT
723}
724
c545beb1
MT
725#
726# Return the following IP (IP+1) in dotted notation.
727# Call: NextIP ('1.1.1.1');
728# Return: '1.1.1.2'
729#
4e9a2b57
MT
730sub NextIP {
731 return &Network::find_next_ip_address(shift, 1);
c545beb1 732}
4e9a2b57
MT
733
734sub NextIP2 {
735 return &Network::find_next_ip_address(shift, 4);
8c877a82 736}
4e9a2b57
MT
737
738sub ipcidr {
45762fc6
AF
739 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
740 return "$ip\/$cidr";
741}
742
4e9a2b57 743sub ipcidr2msk {
54fd0535
MT
744 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
745 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
746 return "$ip\/$netmask";
747}
748
ac1cfefa
MT
749sub validemail {
750 my $mail = shift;
751 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
752 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
753 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
754 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
755 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
756 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
757 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
758 return 1;
759}
760
c545beb1
MT
761#
762# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
763# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
764# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
765#
ac1cfefa
MT
766sub readhasharray {
767 my ($filename, $hash) = @_;
768 %$hash = ();
769
770 open(FILE, $filename) or die "Unable to read file $filename";
771
772 while (<FILE>) {
773 my ($key, $rest, @temp);
774 chomp;
775 ($key, $rest) = split (/,/, $_, 2);
c545beb1 776 if ($key =~ /^[0-9]+$/) {
ac1cfefa
MT
777 @temp = split (/,/, $rest);
778 $hash->{$key} = \@temp;
779 }
780 }
781 close FILE;
782 return;
783}
784
785sub writehasharray {
786 my ($filename, $hash) = @_;
787 my ($key, @temp, $i);
788
789 open(FILE, ">$filename") or die "Unable to write to file $filename";
790
791 foreach $key (keys %$hash) {
8c877a82
AM
792 if ($key =~ /^[0-9]+$/) {
793 print FILE "$key";
794 foreach $i (0 .. $#{$hash->{$key}}) {
795 print FILE ",$hash->{$key}[$i]";
796 }
797 print FILE "\n";
798 }
ac1cfefa
MT
799 }
800 close FILE;
801 return;
802}
803
804sub findhasharraykey {
805 foreach my $i (1 .. 1000000) {
806 if ( ! exists $_[0]{$i}) {
807 return $i;
808 }
809 }
810}
811
812sub srtarray
813# Darren Critchley - darrenc@telus.net - (c) 2003
814# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
815# This subroutine will take the following parameters:
816# ColumnNumber = the column which you want to sort on, starts at 1
817# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
818# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
819# ArrayToBeSorted = the array that wants sorting
820#
821# Returns an array that is sorted to your specs
822#
823# If SortOrder is greater than the elements in array, then it defaults to the first element
824#
825{
826 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
827 my @tmparray;
828 my @srtedarray;
829 my $line;
830 my $newline;
831 my $ctr;
832 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
833 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
834 return (@tobesorted);
835 }
836 my @tmp = split(/\,/,$tobesorted[0]);
837 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
838
839 # Darren Critchley - validate parameters
840 if ($colno > $ttlitems){$colno = '1';}
841 $colno--; # remove one from colno to deal with arrays starting at 0
842 if($colno < 0){$colno = '0';}
843 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
844 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
845
846 foreach $line (@tobesorted)
847 {
848 chomp($line);
849 if ($line ne '') {
850 my @temp = split(/\,/,$line);
851 # Darren Critchley - juggle the fields so that the one we want to sort on is first
852 my $tmpholder = $temp[0];
853 $temp[0] = $temp[$colno];
854 $temp[$colno] = $tmpholder;
855 $newline = "";
856 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
857 $newline=$newline . $temp[$ctr] . ",";
858 }
859 chop($newline);
860 push(@tmparray,$newline);
861 }
862 }
863 if ($alpnum eq 'n') {
864 @tmparray = sort {$a <=> $b} @tmparray;
865 } else {
866 @tmparray = (sort @tmparray);
867 }
868 foreach $line (@tmparray)
869 {
870 chomp($line);
871 if ($line ne '') {
872 my @temp = split(/\,/,$line);
873 my $tmpholder = $temp[0];
874 $temp[0] = $temp[$colno];
875 $temp[$colno] = $tmpholder;
876 $newline = "";
877 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
878 $newline=$newline . $temp[$ctr] . ",";
879 }
880 chop($newline);
881 push(@srtedarray,$newline);
882 }
883 }
884
885 if ($srtdir eq 'dsc') {
886 @tmparray = reverse(@srtedarray);
887 return (@tmparray);
888 } else {
889 return (@srtedarray);
890 }
891}
892
893sub FetchPublicIp {
894 my %proxysettings;
895 &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
896 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
897 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
898 Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
899 }
b2f8244a 900 my $user_agent = &MakeUserAgent();
0aa0cdcd 901 my ($out, $response) = Net::SSLeay::get_http( 'checkip4.dns.lightningwirelabs.com',
ac1cfefa
MT
902 80,
903 "/",
b2f8244a 904 Net::SSLeay::make_headers('User-Agent' => $user_agent )
ac1cfefa
MT
905 );
906 if ($response =~ m%HTTP/1\.. 200 OK%) {
5a2935b1 907 $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
ac1cfefa
MT
908 return $1;
909 }
910 return '';
911}
912
913#
914# Check if hostname.domain provided have IP provided
915# use gethostbyname to verify that
916# Params:
917# IP
918# hostname
919# domain
920# Output
921# 1 IP matches host.domain
922# 0 not in sync
923#
924sub DyndnsServiceSync ($;$;$) {
925
926 my ($ip,$hostName,$domain) = @_;
927 my @addresses;
928
929 #fix me no ip GROUP, what is the name ?
930 $hostName =~ s/$General::noipprefix//;
931 if ($hostName) { #may be empty
932 $hostName = "$hostName.$domain";
933 @addresses = gethostbyname($hostName);
934 }
935
936 if ($addresses[0] eq '') { # nothing returned ?
937 $hostName = $domain; # try resolving with domain only
938 @addresses = gethostbyname($hostName);
939 }
940
941 if ($addresses[0] ne '') { # got something ?
942 #&General::log("name:$addresses[0], alias:$addresses[1]");
943 # Build clear text list of IP
944 @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
945 if (grep (/$ip/, @addresses)) {
946 return 1;
947 }
948 }
949 return 0;
950}
951#
952# This sub returns the red IP used to compare in DyndnsServiceSync
953#
954sub GetDyndnsRedIP {
955 my %settings;
956 &General::readhash("${General::swroot}/ddns/settings", \%settings);
957
958 open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
959 my $ip = <IP>;
960 close(IP);
961 chomp $ip;
962
057dbeeb 963 # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
ac1cfefa
MT
964 if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
965 &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
057dbeeb
MT
966 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
967 &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
ac1cfefa
MT
968 {
969 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
970 my $RealIP = &General::FetchPublicIp;
971 $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
972 }
973 }
974 return $ip;
975}
c545beb1
MT
976
977# Translate ICMP code to text
978# ref: http://www.iana.org/assignments/icmp-parameters
979sub GetIcmpDescription ($) {
980 my $index = shift;
981 my @icmp_description = (
982 'Echo Reply', #0
983 'Unassigned',
984 'Unassigned',
985 'Destination Unreachable',
986 'Source Quench',
987 'Redirect',
988 'Alternate Host Address',
989 'Unassigned',
990 'Echo',
991 'Router Advertisement',
992 'Router Solicitation', #10
993 'Time Exceeded',
994 'Parameter Problem',
995 'Timestamp',
996 'Timestamp Reply',
997 'Information Request',
998 'Information Reply',
999 'Address Mask Request',
1000 'Address Mask Reply',
1001 'Reserved (for Security)',
1002 'Reserved (for Robustness Experiment)', #20
1003 'Reserved',
1004 'Reserved',
1005 'Reserved',
1006 'Reserved',
1007 'Reserved',
1008 'Reserved',
1009 'Reserved',
1010 'Reserved',
1011 'Reserved',
1012 'Traceroute', #30
1013 'Datagram Conversion Error',
1014 'Mobile Host Redirect',
1015 'IPv6 Where-Are-You',
1016 'IPv6 I-Am-Here',
1017 'Mobile Registration Request',
1018 'Mobile Registration Reply',
1019 'Domain Name Request',
1020 'Domain Name Reply',
1021 'SKIP',
1022 'Photur', #40
1023 'Experimental');
a2b3eba9 1024 if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
c545beb1 1025}
b2f8244a
MT
1026
1027sub GetCoreUpdateVersion() {
1028 my $core_update;
1029
1030 open(FILE, "/opt/pakfire/db/core/mine");
1031 while (<FILE>) {
1032 $core_update = $_;
1033 last;
1034 }
1035 close(FILE);
1036
1037 return $core_update;
1038}
1039
1040sub MakeUserAgent() {
1041 my $user_agent = "IPFire/$General::version";
1042
1043 my $core_update = &GetCoreUpdateVersion();
1044 if ($core_update ne "") {
1045 $user_agent .= "/$core_update";
1046 }
1047
1048 return $user_agent;
1049}
1050
61027579
MT
1051sub RedIsWireless() {
1052 # This function checks if a network device is a wireless device.
1053
1054 my %settings = ();
1055 &readhash("${General::swroot}/ethernet/settings", \%settings);
1056
1057 # Find the name of the network device.
1058 my $device = $settings{'RED_DEV'};
1059
1060 # Exit, if no device is configured.
1061 return 0 if ($device eq "");
1062
1063 # Return 1 if the device is a wireless one.
1064 my $path = "/sys/class/net/$device/wireless";
1065 if (-d $path) {
1066 return 1;
1067 }
1068
1069 # Otherwise return zero.
1070 return 0;
1071}
1072
dfee7582
SS
1073# Function to read a file with UTF-8 charset.
1074sub read_file_utf8 ($) {
1075 my ($file) = @_;
1076
1077 open my $in, '<:encoding(UTF-8)', $file or die "Could not open '$file' for reading $!";
1078 local $/ = undef;
1079 my $all = <$in>;
1080 close $in;
1081
3e862ce4 1082 return $all;
dfee7582
SS
1083}
1084
1085# Function to write a file with UTF-8 charset.
1086sub write_file_utf8 ($) {
1087 my ($file, $content) = @_;
1088
1089 open my $out, '>:encoding(UTF-8)', $file or die "Could not open '$file' for writing $!";;
1090 print $out $content;
1091 close $out;
1092
1093 return;
1094}
1095
6d8eb5de 1096my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
0e430797
MT
1097
1098sub firewall_config_changed() {
1099 open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1100 close FILE;
1101}
1102
1103sub firewall_needs_reload() {
1104 if (-e "$FIREWALL_RELOAD_INDICATOR") {
1105 return 1;
1106 }
1107
1108 return 0;
1109}
1110
1111sub firewall_reload() {
8039a710 1112 system("/usr/local/bin/firewallctrl");
0e430797
MT
1113}
1114
4cb523d4
SS
1115# Function which will return the used interface for the red network zone (red0, ppp0, etc).
1116sub get_red_interface() {
1117
1118 open(IFACE, "${General::swroot}/red/iface") or die "Could not open /var/ipfire/red/iface";
1119
1120 my $interface = <IFACE>;
1121 close(IFACE);
1122 chomp $interface;
1123
1124 return $interface;
1125}
1126
cebb1b7c
SS
1127# Function to get the county name by a given country code.
1128sub get_full_country_name($) {
1129 my ($input) = @_;
1130 my $name;
1131
1132 # Remove whitespaces.
1133 chomp($input);
1134
1135 # Convert input into lower case format.
1136 my $code = lc($input);
1137
1138 # Handle country codes which are not in the list.
1139 if ($code eq "a1") { $name = "Anonymous Proxy" }
1140 elsif ($code eq "a2") { $name = "Satellite Provider" }
1141 elsif ($code eq "o1") { $name = "Other Country" }
1142 elsif ($code eq "ap") { $name = "Asia/Pacific Region" }
1143 elsif ($code eq "eu") { $name = "Europe" }
1144 elsif ($code eq "yu") { $name = "Yugoslavia" }
1145 else {
1146 # Use perl built-in module to get the country code.
1147 $name = &Locale::Country::code2country($code);
1148 }
1149
1150 return $name;
1151}
1152
ac1cfefa 11531;