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