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