general-functions.pl: Add function to get full country name.
[ipfire-2.x.git] / config / cfgroot / general-functions.pl
1 # SmoothWall CGIs
2 #
3 # This code is distributed under the terms of the GPL
4 #
5 # (c) The SmoothWall Team
6 # Copyright (C) 2002 Alex Hudson - getcgihash() rewrite
7 # Copyright (C) 2002 Bob Grant <bob@cache.ucr.edu> - validmac()
8 # Copyright (c) 2002/04/13 Steve Bootes - add alias section, helper functions
9 # Copyright (c) 2002/08/23 Mark Wormgoor <mark@wormgoor.com> validfqdn()
10 # Copyright (c) 2003/09/11 Darren Critchley <darrenc@telus.net> srtarray()
11 #
12 # $Id: general-functions.pl,v 1.1.2.26 2006/01/04 16:33:55 franck78 Exp $
13 #
14
15 package General;
16
17 use strict;
18 use Socket;
19 use IO::Socket;
20 use Locale::Country;
21 use Net::SSLeay;
22 use Net::IPv4Addr qw(:all);
23 $|=1; # line buffering
24
25 $General::version = 'VERSION';
26 $General::swroot = 'CONFIG_ROOT';
27 $General::noipprefix = 'noipg-';
28 $General::adminmanualurl = 'http://wiki.ipfire.org';
29
30 require "${General::swroot}/network-functions.pl";
31
32 #
33 # log ("message") use default 'ipcop' tag
34 # log ("tag","message") use your tag
35 #
36 sub log
37 {
38 my $tag='ipfire';
39 $tag = shift if (@_>1);
40 my $logmessage = $_[0];
41 $logmessage =~ /([\w\W]*)/;
42 $logmessage = $1;
43 system('logger', '-t', $tag, $logmessage);
44 }
45 sub 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'}";
57 $defaultNetworks->{$Lang::tr{'green'}}{'NET'} = "$netsettings{'GREEN_ADDRESS'}";
58 $defaultNetworks->{$Lang::tr{'green'}}{'NAME'} = "GREEN";
59
60 if ($netsettings{'RED_DEV'} ne ''){
61 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'IPT'} = "$netsettings{'RED_NETADDRESS'}/$netsettings{'RED_NETMASK'}";
62 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NET'} = "$netsettings{'RED_ADDRESS'}";
63 $defaultNetworks->{$Lang::tr{'fwdfw red'}}{'NAME'} = "RED";
64 }
65 if ($netsettings{'ORANGE_DEV'} ne ''){
66 $defaultNetworks->{$Lang::tr{'orange'}}{'IPT'} = "$netsettings{'ORANGE_NETADDRESS'}/$netsettings{'ORANGE_NETMASK'}";
67 $defaultNetworks->{$Lang::tr{'orange'}}{'NET'} = "$netsettings{'ORANGE_ADDRESS'}";
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'}";
73 $defaultNetworks->{$Lang::tr{'blue'}}{'NET'} = "$netsettings{'BLUE_ADDRESS'}";
74 $defaultNetworks->{$Lang::tr{'blue'}}{'NAME'} = "BLUE";
75 }
76
77 #IPFire himself
78 $defaultNetworks->{'IPFire'}{'NAME'} = "IPFire";
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'});
92 $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'ADR'} = $tempovpnsubnet[0];
93 $defaultNetworks->{'OpenVPN ' ."($ip/$sub)"}{'NAME'} = "OpenVPN-Dyn";
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'});
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);
109 }
110 }
111 }
112 sub 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]";
129 $defaultNetworks->{$temp[2]}{'NET'} = "$temp[0]";
130
131 $ctr++;
132 }
133 }
134 }
135
136 sub 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
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;
166 $hash->{$var} = $val;
167 }
168 }
169 close FILE;
170 }
171
172
173 sub 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 {
184 if ( $var eq "__CGI__"){next;}
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
199 sub 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 }
234
235 sub age {
236 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
237 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
238 my $totalsecs = time() - $mtime;
239 my @s = ();
240
241 my $secs = $totalsecs % 60;
242 $totalsecs /= 60;
243 if ($secs > 0) {
244 push(@s, "${secs}s");
245 }
246
247 my $min = $totalsecs % 60;
248 $totalsecs /= 60;
249 if ($min > 0) {
250 push(@s, "${min}m");
251 }
252
253 my $hrs = $totalsecs % 24;
254 $totalsecs /= 24;
255 if ($hrs > 0) {
256 push(@s, "${hrs}h");
257 }
258
259 my $days = int($totalsecs);
260 if ($days > 0) {
261 push(@s, "${days}d");
262 }
263
264 return join(" ", reverse(@s));
265 }
266
267 sub 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
287 sub validmask {
288 my $mask = shift;
289
290 return &Network::check_netmask($mask) || &Network::check_prefix($mask);
291 }
292
293 sub 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
311 sub subtocidr {
312 return &Network::convert_netmask2prefix(shift);
313 }
314
315 sub cidrtosub {
316 return &Network::convert_prefix2netmask(shift);
317 }
318
319 sub 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 ))) {
336 for (my $i=0;$i<=32;$i++){
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?
345 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
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
356 sub 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 ))) {
372 for (my $i=0;$i<=32;$i++){
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?
381 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
382 if($full == 0){ return $mask;}else{
383 return $net."/".$mask;
384 }
385 }else{
386 return 3;
387 }
388 return 3;
389 }
390
391 sub getnetworkip {
392 my $arg = join("/", @_);
393
394 return &Network::get_netaddress($arg);
395 }
396
397 sub 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 }
408
409 sub ip2dec {
410 return &Network::ip2bin(shift);
411 }
412
413 sub dec2ip {
414 return &Network::bin2ip(shift);
415 }
416
417 sub getnextip {
418 return &Network::find_next_ip_address(shift, 4);
419 }
420
421 sub getlastip {
422 return &Network::find_next_ip_address(shift, -1);
423 }
424
425 sub 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 ))) {
440 for (my $i=0;$i<=32;$i++){
441 if (&General::cidrtosub($i) eq $ccdsubnet){
442 return 1;
443 }
444 }
445 #Subnet already in binary format?
446 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=0))){
447 return 1;
448 }else{
449 return 0;
450 }
451
452 }
453 return 0;
454 }
455
456 sub checksubnets
457 {
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];
468 my $errormessage;
469 my ($ip,$cidr)=split(/\//,$ccdnet);
470 $cidr=&iporsubtocidr($cidr);
471
472 #get OVPN-Subnet (dynamic range)
473 &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
474 my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
475 $ovpncidr=&iporsubtocidr($ovpncidr);
476
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 }
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
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 {
509 $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}." $ccdconfhash{$key}[0]<br>";
510 return $errormessage;
511 }
512 }
513
514 #check if we use a ipsec right network which is already defined
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 }
526 }
527 }
528 }
529 }
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
542 #check if we use one of ipfire's networks (green,orange,blue)
543 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
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;}
548 }
549
550 sub 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 }
563
564 sub 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
577 sub 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
592 sub 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
603 sub 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 -
613 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
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
624 sub 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) {
633 # Each part should be no more than 63 characters in length
634 if (length ($part) < 1 || length ($part) > 63) {
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
649 sub 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
677 sub 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
717 sub IpInSubnet {
718 my $addr = shift;
719 my $network = shift;
720 my $netmask = shift;
721
722 return &Network::ip_address_in_network($addr, "$network/$netmask");
723 }
724
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 #
730 sub NextIP {
731 return &Network::find_next_ip_address(shift, 1);
732 }
733
734 sub NextIP2 {
735 return &Network::find_next_ip_address(shift, 4);
736 }
737
738 sub ipcidr {
739 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
740 return "$ip\/$cidr";
741 }
742
743 sub ipcidr2msk {
744 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
745 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
746 return "$ip\/$netmask";
747 }
748
749 sub 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
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 #
766 sub 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);
776 if ($key =~ /^[0-9]+$/) {
777 @temp = split (/,/, $rest);
778 $hash->{$key} = \@temp;
779 }
780 }
781 close FILE;
782 return;
783 }
784
785 sub 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) {
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 }
799 }
800 close FILE;
801 return;
802 }
803
804 sub findhasharraykey {
805 foreach my $i (1 .. 1000000) {
806 if ( ! exists $_[0]{$i}) {
807 return $i;
808 }
809 }
810 }
811
812 sub 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
893 sub 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 }
900 my $user_agent = &MakeUserAgent();
901 my ($out, $response) = Net::SSLeay::get_http( 'checkip4.dns.lightningwirelabs.com',
902 80,
903 "/",
904 Net::SSLeay::make_headers('User-Agent' => $user_agent )
905 );
906 if ($response =~ m%HTTP/1\.. 200 OK%) {
907 $out =~ /Your IP address is: (\d+.\d+.\d+.\d+)/;
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 #
924 sub 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 #
954 sub 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
963 # 100.64.0.0/10 is reserved for dual-stack lite (http://tools.ietf.org/html/rfc6598).
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') ||
966 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0') ||
967 &General::IpInSubnet ($ip,'100.64.0.0', '255.192.0.0'))
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 }
976
977 # Translate ICMP code to text
978 # ref: http://www.iana.org/assignments/icmp-parameters
979 sub 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');
1024 if ($index>41) {return 'unknown'} else {return $icmp_description[$index]};
1025 }
1026
1027 sub 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
1040 sub 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
1051 sub 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
1073 # Function to read a file with UTF-8 charset.
1074 sub 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
1082 return $all;
1083 }
1084
1085 # Function to write a file with UTF-8 charset.
1086 sub 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
1096 my $FIREWALL_RELOAD_INDICATOR = "${General::swroot}/firewall/reread";
1097
1098 sub firewall_config_changed() {
1099 open FILE, ">$FIREWALL_RELOAD_INDICATOR" or die "Could not open $FIREWALL_RELOAD_INDICATOR";
1100 close FILE;
1101 }
1102
1103 sub firewall_needs_reload() {
1104 if (-e "$FIREWALL_RELOAD_INDICATOR") {
1105 return 1;
1106 }
1107
1108 return 0;
1109 }
1110
1111 sub firewall_reload() {
1112 system("/usr/local/bin/firewallctrl");
1113 }
1114
1115 # Function which will return the used interface for the red network zone (red0, ppp0, etc).
1116 sub 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
1127 # Function to get the county name by a given country code.
1128 sub 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
1153 1;