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