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