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