]> git.ipfire.org Git - people/pmueller/ipfire-2.x.git/blame - config/cfgroot/general-functions.pl
projects / people / pmueller / ipfire-2.x.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
OpenVPN CCD: Bugfix: when editing an IPsec Net, the ipcheck produces an error.
[people/pmueller/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
24$General::version = 'VERSION';
25$General::swroot = 'CONFIG_ROOT';
26$General::noipprefix = 'noipg-';
c545beb1 27$General::adminmanualurl = 'http://wiki.ipfire.org';
ac1cfefa 28
c545beb1
MT		 29#
30# log ("message") use default 'ipcop' tag
31# log ("tag","message") use your tag
32#
ac1cfefa
MT		 33sub log
34{
c545beb1
MT		 35 my $tag='ipfire';
36 $tag = shift if (@_>1);
ac1cfefa
MT		 37 my $logmessage = $_[0];
38 $logmessage =~ /([\w\W]*)/;
39 $logmessage = $1;
77007ce5 40 system('logger', '-t', $tag, $logmessage);
ac1cfefa
MT		 41}
42
43sub readhash
44{
45 my $filename = $_[0];
46 my $hash = $_[1];
47 my ($var, $val);
48
49
50 # Some ipcop code expects that readhash 'complete' the hash if new entries
51 # are presents. Not clear it !!!
52 #%$hash = ();
53
54 open(FILE, $filename) or die "Unable to read file $filename";
55
56 while (<FILE>)
57 {
58 chop;
59 ($var, $val) = split /=/, $_, 2;
60 if ($var)
61 {
62 $val =~ s/^\'//g;
63 $val =~ s/\'$//g;
64
65 # Untaint variables read from hash
77007ce5
MT		 66 # trim space from begin and end
67 $var =~ s/^\s+//;
68 $var =~ s/\s+$//;
69 $var =~ /([A-Za-z0-9_-]*)/;
70 $var = $1;
71 $val =~ /([\w\W]*)/;
72 $val = $1;
ac1cfefa
MT		 73 $hash->{$var} = $val;
74 }
75 }
76 close FILE;
77}
78
79
80sub writehash
81{
82 my $filename = $_[0];
83 my $hash = $_[1];
84 my ($var, $val);
85
86 # write cgi vars to the file.
87 open(FILE, ">${filename}") or die "Unable to write file $filename";
88 flock FILE, 2;
89 foreach $var (keys %$hash)
90 {
ad60e3ea 91 if ( $var eq "__CGI__"){next;}
ac1cfefa
MT		 92 $val = $hash->{$var};
93 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
94 # location of the mouse are submitted as well, this was being written to the settings file causing
95 # some serious grief! This skips the variable.x and variable.y
96 if (!($var =~ /(.x|.y)$/)) {
97 if ($val =~ / /) {
98 $val = "\'$val\'"; }
99 if (!($var =~ /^ACTION/)) {
100 print FILE "${var}=${val}\n"; }
101 }
102 }
103 close FILE;
104}
105
90c2e164
CS		 106sub writehashpart
107{
108 # This function replaces the given hash in the original hash by keeping the old
109 # content and just replacing the new content
110
111 my $filename = $_[0];
112 my $newhash = $_[1];
113 my %oldhash;
114 my ($var, $val);
115
116 readhash("${filename}", \%oldhash);
117
118 foreach $var (keys %$newhash){
119 $oldhash{$var}=$newhash->{$var};
120 }
121
122 # write cgi vars to the file.
123 open(FILE, ">${filename}") or die "Unable to write file $filename";
124 flock FILE, 2;
125 foreach $var (keys %oldhash)
126 {
127 if ( $var eq "__CGI__"){next;}
128 $val = $oldhash{$var};
129 # Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
130 # location of the mouse are submitted as well, this was being written to the settings file causing
131 # some serious grief! This skips the variable.x and variable.y
132 if (!($var =~ /(.x|.y)$/)) {
133 if ($val =~ / /) {
134 $val = "\'$val\'"; }
135 if (!($var =~ /^ACTION/)) {
136 print FILE "${var}=${val}\n"; }
137 }
138 }
139 close FILE;
140}
ac1cfefa
MT		 141
142sub age
143{
144 my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
145 $atime, $mtime, $ctime, $blksize, $blocks) = stat $_[0];
146 my $now = time;
147
148 my $totalsecs = $now - $mtime;
149 my $days = int($totalsecs / 86400);
150 my $totalhours = int($totalsecs / 3600);
151 my $hours = $totalhours % 24;
152 my $totalmins = int($totalsecs / 60);
153 my $mins = $totalmins % 60;
154 my $secs = $totalsecs % 60;
155
156 return "${days}d ${hours}h ${mins}m ${secs}s";
157}
158
159sub validip
160{
161 my $ip = $_[0];
162
163 if (!($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) {
164 return 0; }
165 else
166 {
167 my @octets = ($1, $2, $3, $4);
168 foreach $_ (@octets)
169 {
170 if (/^0./) {
171 return 0; }
172 if ($_ < 0 || $_ > 255) {
173 return 0; }
174 }
175 return 1;
176 }
177}
178
179sub validmask
180{
181 my $mask = $_[0];
182
183 # secord part an ip?
184 if (&validip($mask)) {
185 return 1; }
186 # second part a number?
187 if (/^0/) {
188 return 0; }
189 if (!($mask =~ /^\d+$/)) {
190 return 0; }
191 if ($mask >= 0 && $mask <= 32) {
192 return 1; }
193 return 0;
194}
195
196sub validipormask
197{
198 my $ipormask = $_[0];
199
200 # see if it is a IP only.
201 if (&validip($ipormask)) {
202 return 1; }
203 # split it into number and mask.
204 if (!($ipormask =~ /^(.*?)\/(.*?)$/)) {
205 return 0; }
206 my $ip = $1;
207 my $mask = $2;
208 # first part not a ip?
209 if (!(&validip($ip))) {
210 return 0; }
211 return &validmask($mask);
212}
213
8c877a82 214sub subtocidr
ac1cfefa 215{
8c877a82
AM		 216 #gets: Subnet in decimal (255.255.255.0)
217 #Gives: 24 (The cidr of network)
218 my ($byte1, $byte2, $byte3, $byte4) = split(/\./, $_[0].".0.0.0.0");
219 my $num = ($byte1 * 16777216) + ($byte2 * 65536) + ($byte3 * 256) + $byte4;
220 my $bin = unpack("B*", pack("N", $num));
221 my $count = ($bin =~ tr/1/1/);
222 return $count;
223}
ac1cfefa 224
8c877a82
AM		 225sub cidrtosub
226{
227 #gets: Cidr of network (20-30 for ccd)
228 #Konverts 30 to 255.255.255.252 e.g
229 my $cidr=$_[0];
230 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
231 return "$netmask";
232}
233
234sub iporsubtodec
235{
236 #Gets: Ip address or subnetmask in decimal oder CIDR
237 #Gives: What it gets only in CIDR format
238 my $subnet=$_[0];
239 my $net;
240 my $mask;
241 my $full=0;
242 if ($subnet =~ /^(.*?)\/(.*?)$/) {
243 ($net,$mask) = split (/\//,$subnet);
244 $full=1;
245 return "$subnet";
246 }else{
247 $mask=$subnet;
248 }
249 #Subnet already in decimal and valid?
250 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
251 for (my $i=8;$i<=32;$i++){
252 if (&General::cidrtosub($i) eq $mask){
253 if ($full == 0){return $mask;}else{
254 return $net."/".$mask;
255 }
256 }
257 }
258 }
259 #Subnet in binary format?
260 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
261 if($full == 0){ return &General::cidrtosub($mask);}else{
262 return $net."/".&General::cidrtosub($mask);
263 }
264 }else{
265 return 3;
266 }
267 return 3;
268}
269
270
271sub iporsubtocidr
272{
273 #gets: Ip Address or subnetmask in decimal oder CIDR
274 #Gives: What it gets only in CIDR format
275 my $subnet=$_[0];
276 my $net;
277 my $mask;
278 my $full=0;
279 if ($subnet =~ /^(.*?)\/(.*?)$/) {
280 ($net,$mask) = split (/\//,$subnet);
281 $full=1;
282 }else{
283 $mask=$subnet;
284 }
285 #Subnet in decimal and valid?
286 if ($mask=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
287 for (my $i=8;$i<=32;$i++){
288 if (&General::cidrtosub($i) eq $mask){
289 if ($full == 0){return &General::subtocidr($mask);}else{
290 return $net."/".&General::subtocidr($mask);
291 }
292 }
293 }
294 }
295 #Subnet already in binary format?
296 if ($mask=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
297 if($full == 0){ return $mask;}else{
298 return $net."/".$mask;
299 }
300 }else{
301 return 3;
302 }
303 return 3;
304}
305
306sub getnetworkip
307{
308 #Gets: IP, CIDR (10.10.10.0-255, 24)
309 #Gives: 10.10.10.0
310 my ($ccdip,$ccdsubnet) = @_;
311 my $ip_address_binary = inet_aton( $ccdip );
312 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
313 my $network_address = inet_ntoa( $ip_address_binary & $netmask_binary );
314 return $network_address;
315}
316
317sub getccdbc
318{
319 #Gets: IP in Form ("192.168.0.0/24")
320 #Gives: Broadcastaddress of network
321 my $ccdnet=$_;
322 my ($ccdip,$ccdsubnet) = split "/",$ccdnet;
323 my $ip_address_binary = inet_aton( $ccdip );
324 my $netmask_binary = ~pack("N", (2**(32-$ccdsubnet))-1);
325 my $broadcast_address = inet_ntoa( $ip_address_binary | ~$netmask_binary );
326 return $broadcast_address;
327}
e81be1e1
AM		 328
329sub ip2dec
330{
331 my $ip_num;
332 my $ip=$_[0];
333 if ( $ip =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
334 $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
335 } else {
336 $ip_num = -1;
337 }
338 $ip_num = (($1*256**3) + ($2*256**2) + ($3*256) + $4);
339 return($ip_num);
340}
341
342sub dec2ip
343{
344 my $ip;
345 my $ip_num=$_[0];
346 my $o1=$ip_num%256;
347 $ip_num=int($ip_num/256);
348 my $o2=$ip_num%256;
349 $ip_num=int($ip_num/256);
350 my $o3=$ip_num%256;
351 $ip_num=int($ip_num/256);
352 my $o4=$ip_num%256;
353 $ip="$o4.$o3.$o2.$o1";
354 return ($ip);
355}
356
8c877a82
AM		 357sub getnextip
358{
e81be1e1
AM		 359 my $decip=&ip2dec($_[0]);
360 $decip=$decip+4;
361 return &dec2ip($decip);
8c877a82 362}
e81be1e1 363
8c877a82
AM		 364sub getlastip
365{
e81be1e1
AM		 366 my $decip=&ip2dec($_[0]);
367 $decip--;
368 return &dec2ip($decip);
8c877a82
AM		 369}
370
371sub validipandmask
372{
373 #Gets: Ip address in 192.168.0.0/24 or 192.168.0.0/255.255.255.0 and checks if subnet valid
374 #Gives: True bzw 0 if success or false
375 my $ccdnet=$_[0];
376 my $subcidr;
377
378 if (!($ccdnet =~ /^(.*?)\/(.*?)$/)) {
379 return 0;
380 }
381 my ($ccdip,$ccdsubnet)=split (/\//, $ccdnet);
382 #IP valid?
383 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 ))) {
384 #Subnet in decimal and valid?
385 if ($ccdsubnet=~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&(($1<=255 && $2<=$1 && $3<=$2 && $4<=$3 ))) {
290007b3 386 for (my $i=8;$i<=32;$i++){
8c877a82
AM		 387 if (&General::cidrtosub($i) eq $ccdsubnet){
388 return 1;
389 }
390 }
391 #Subnet already in binary format?
290007b3 392 }elsif ($ccdsubnet=~/^(\d{1,2})$/ && (($1<=32 && $1>=8))){
8c877a82
AM		 393 return 1;
394 }else{
395 return 0;
396 }
397
398 }
399 return 0;
ac1cfefa
MT		 400}
401
e2429e8d
AM		 402sub checksubnets
403{
e2429e8d
AM		 404 my %ccdconfhash=();
405 my @ccdconf=();
406 my $ccdname=$_[0];
407 my $ccdnet=$_[1];
408 my $errormessage;
409 my ($ip,$cidr)=split(/\//,$ccdnet);
410 $cidr=&iporsubtocidr($cidr);
411
e2429e8d
AM		 412 #get OVPN-Subnet (dynamic range)
413 my %ovpnconf=();
414 &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
415 my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
416 $ovpncidr=&iporsubtocidr($ovpncidr);
417
418 #check if we try to use same network as ovpn server
419 if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
420 $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
421 return $errormessage;
422 }
f7e3d208 423
e2429e8d
AM		 424 #check if we use a network-name/subnet that already exists
425 &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
426 foreach my $key (keys %ccdconfhash) {
427 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
428 if ($ccdname eq $ccdconfhash{$key}[0])
429 {
430 $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
431 return $errormessage;
432 }
433 my ($newip,$newsub) = split(/\//,$ccdnet);
434 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
435 {
436 $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
437 return $errormessage;
438 }
439
440 }
e2429e8d
AM		 441
442 #check if we use a ipsec right network which is already defined
443 my %ipsecconf=();
444 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
445 foreach my $key (keys %ipsecconf){
446 if ($ipsecconf{$key}[11] ne ''){
e2429e8d
AM		 447 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
448 $ipsecsub=&iporsubtodec($ipsecsub);
f7e3d208
AM		 449 if($ipsecconf{$key}[1] ne $ccdname){
450 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
451 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[2]";
452 return $errormessage;
453 }
e2429e8d
AM		 454 }
455 }
456 }
f7e3d208 457
e2429e8d
AM		 458 #check if we use one of ipfire's networks (green,orange,blue)
459 my %ownnet=();
460 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
461 if (($ownnet{'GREEN_NETADDRESS'} ne '' && $ownnet{'GREEN_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'GREEN_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err green'};return $errormessage;}
462 if (($ownnet{'ORANGE_NETADDRESS'} ne '' && $ownnet{'ORANGE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'ORANGE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err orange'};return $errormessage;}
463 if (($ownnet{'BLUE_NETADDRESS'} ne '' && $ownnet{'BLUE_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'BLUE_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err blue'};return $errormessage;}
464 if (($ownnet{'RED_NETADDRESS'} ne '' && $ownnet{'RED_NETADDRESS'} ne '0.0.0.0') && &IpInSubnet($ownnet{'RED_NETADDRESS'},$ip,&iporsubtodec($cidr))){ $errormessage=$Lang::tr{'ccd err red'};return $errormessage;}
465
466
467
468}
469
470
ac1cfefa
MT		 471sub validport
472{
473 $_ = $_[0];
474
475 if (!/^\d+$/) {
476 return 0; }
477 if (/^0./) {
478 return 0; }
479 if ($_ >= 1 && $_ <= 65535) {
480 return 1; }
481 return 0;
482}
483
d30ea451
CS		 484sub validproxyport
485{
486 $_ = $_[0];
487
488 if (!/^\d+$/) {
489 return 0; }
490 if (/^0./) {
491 return 0; }
492 if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
493 return 0; }
494 elsif ($_ >= 1 && $_ <= 65535) {
495 return 1; }
496 return 0;
497}
498
ac1cfefa
MT		 499sub validmac
500{
501 my $checkmac = $_[0];
502 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
503 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
504 {
505 return 0;
506 }
507 return 1;
508}
509
510sub validhostname
511{
512 # Checks a hostname against RFC1035
513 my $hostname = $_[0];
514
515 # Each part should be at least two characters in length
516 # but no more than 63 characters
517 if (length ($hostname) < 1 || length ($hostname) > 63) {
518 return 0;}
519 # Only valid characters are a-z, A-Z, 0-9 and -
8c877a82 520 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
ac1cfefa
MT		 521 return 0;}
522 # First character can only be a letter or a digit
523 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
524 return 0;}
525 # Last character can only be a letter or a digit
526 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
527 return 0;}
528 return 1;
529}
530
531sub validdomainname
532{
533 my $part;
534
535 # Checks a domain name against RFC1035
536 my $domainname = $_[0];
537 my @parts = split (/\./, $domainname); # Split hostname at the '.'
538
539 foreach $part (@parts) {
540 # Each part should be at least two characters in length
541 # but no more than 63 characters
542 if (length ($part) < 2 || length ($part) > 63) {
543 return 0;}
544 # Only valid characters are a-z, A-Z, 0-9 and -
545 if ($part !~ /^[a-zA-Z0-9-]*$/) {
546 return 0;}
547 # First character can only be a letter or a digit
548 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
549 return 0;}
550 # Last character can only be a letter or a digit
551 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
552 return 0;}
553 }
554 return 1;
555}
556
557sub validfqdn
558{
559 my $part;
560
561 # Checks a fully qualified domain name against RFC1035
562 my $fqdn = $_[0];
563 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
564 if (scalar(@parts) < 2) { # At least two parts should
565 return 0;} # exist in a FQDN
566 # (i.e. hostname.domain)
567 foreach $part (@parts) {
568 # Each part should be at least one character in length
569 # but no more than 63 characters
570 if (length ($part) < 1 || length ($part) > 63) {
571 return 0;}
572 # Only valid characters are a-z, A-Z, 0-9 and -
573 if ($part !~ /^[a-zA-Z0-9-]*$/) {
574 return 0;}
575 # First character can only be a letter or a digit
576 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
577 return 0;}
578 # Last character can only be a letter or a digit
579 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
580 return 0;}
581 }
582 return 1;
583}
584
585sub validportrange # used to check a port range
586{
587 my $port = $_[0]; # port values
588 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
589 my $srcdst = $_[1]; # is it a source or destination port
590
591 if (!($port =~ /^(\d+)\:(\d+)$/)) {
592
593 if (!(&validport($port))) {
594 if ($srcdst eq 'src'){
595 return $Lang::tr{'source port numbers'};
596 } else {
597 return $Lang::tr{'destination port numbers'};
598 }
599 }
600 }
601 else
602 {
603 my @ports = ($1, $2);
604 if ($1 >= $2){
605 if ($srcdst eq 'src'){
606 return $Lang::tr{'bad source range'};
607 } else {
608 return $Lang::tr{'bad destination range'};
609 }
610 }
611 foreach $_ (@ports)
612 {
613 if (!(&validport($_))) {
614 if ($srcdst eq 'src'){
615 return $Lang::tr{'source port numbers'};
616 } else {
617 return $Lang::tr{'destination port numbers'};
618 }
619 }
620 }
621 return;
622 }
623}
624
625# Test if IP is within a subnet
626# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
627# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
628# Everything in dottted notation
629# Return: TRUE/FALSE
630sub IpInSubnet
631{
632 my $ip = unpack('N', &Socket::inet_aton(shift));
633 my $start = unpack('N', &Socket::inet_aton(shift));
634 my $mask = unpack('N', &Socket::inet_aton(shift));
635 $start &= $mask; # base of subnet...
636 my $end = $start + ~$mask;
637 return (($ip >= $start) && ($ip <= $end));
638}
639
c545beb1
MT		 640#
641# Return the following IP (IP+1) in dotted notation.
642# Call: NextIP ('1.1.1.1');
643# Return: '1.1.1.2'
644#
645sub NextIP
646{
647 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
648 )
649 );
650}
8c877a82
AM		 651sub NextIP2
652{
653 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
654 )
655 );
656}
45762fc6
AF		 657sub ipcidr
658{
659 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
660 return "$ip\/$cidr";
661}
662
54fd0535
MT		 663sub ipcidr2msk
664{
665 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
666 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
667 return "$ip\/$netmask";
668}
669
670
ac1cfefa
MT		 671sub validemail {
672 my $mail = shift;
673 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
674 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
675 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
676 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
677 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
678 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
679 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
680 return 1;
681}
682
c545beb1
MT		 683#
684# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
685# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
686# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
687#
ac1cfefa
MT		 688sub readhasharray {
689 my ($filename, $hash) = @_;
690 %$hash = ();
691
692 open(FILE, $filename) or die "Unable to read file $filename";
693
694 while (<FILE>) {
695 my ($key, $rest, @temp);
696 chomp;
697 ($key, $rest) = split (/,/, $_, 2);
c545beb1 698 if ($key =~ /^[0-9]+$/) {
ac1cfefa
MT		 699 @temp = split (/,/, $rest);
700 $hash->{$key} = \@temp;
701 }
702 }
703 close FILE;
704 return;
705}
706
707sub writehasharray {
708 my ($filename, $hash) = @_;
709 my ($key, @temp, $i);
710
711 open(FILE, ">$filename") or die "Unable to write to file $filename";
712
713 foreach $key (keys %$hash) {
8c877a82
AM		 714 if ($key =~ /^[0-9]+$/) {
715 print FILE "$key";
716 foreach $i (0 .. $#{$hash->{$key}}) {
717 print FILE ",$hash->{$key}[$i]";
718 }
719 print FILE "\n";
720 }
ac1cfefa
MT		 721 }
722 close FILE;
723 return;
724}
725
726sub findhasharraykey {
727 foreach my $i (1 .. 1000000) {
728 if ( ! exists $_[0]{$i}) {
729 return $i;
730 }
731 }
732}
733
734sub srtarray
735# Darren Critchley - darrenc@telus.net - (c) 2003
736# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
737# This subroutine will take the following parameters:
738# ColumnNumber = the column which you want to sort on, starts at 1
739# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
740# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
741# ArrayToBeSorted = the array that wants sorting
742#
743# Returns an array that is sorted to your specs
744#
745# If SortOrder is greater than the elements in array, then it defaults to the first element
746#
747{
748 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
749 my @tmparray;
750 my @srtedarray;
751 my $line;
752 my $newline;
753 my $ctr;
754 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
755 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
756 return (@tobesorted);
757 }
758 my @tmp = split(/\,/,$tobesorted[0]);
759 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
760
761 # Darren Critchley - validate parameters
762 if ($colno > $ttlitems){$colno = '1';}
763 $colno--; # remove one from colno to deal with arrays starting at 0
764 if($colno < 0){$colno = '0';}
765 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
766 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
767
768 foreach $line (@tobesorted)
769 {
770 chomp($line);
771 if ($line ne '') {
772 my @temp = split(/\,/,$line);
773 # Darren Critchley - juggle the fields so that the one we want to sort on is first
774 my $tmpholder = $temp[0];
775 $temp[0] = $temp[$colno];
776 $temp[$colno] = $tmpholder;
777 $newline = "";
778 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
779 $newline=$newline . $temp[$ctr] . ",";
780 }
781 chop($newline);
782 push(@tmparray,$newline);
783 }
784 }
785 if ($alpnum eq 'n') {
786 @tmparray = sort {$a <=> $b} @tmparray;
787 } else {
788 @tmparray = (sort @tmparray);
789 }
790 foreach $line (@tmparray)
791 {
792 chomp($line);
793 if ($line ne '') {
794 my @temp = split(/\,/,$line);
795 my $tmpholder = $temp[0];
796 $temp[0] = $temp[$colno];
797 $temp[$colno] = $tmpholder;
798 $newline = "";
799 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
800 $newline=$newline . $temp[$ctr] . ",";
801 }
802 chop($newline);
803 push(@srtedarray,$newline);
804 }
805 }
806
807 if ($srtdir eq 'dsc') {
808 @tmparray = reverse(@srtedarray);
809 return (@tmparray);
810 } else {
811 return (@srtedarray);
812 }
813}
814
815sub FetchPublicIp {
816 my %proxysettings;
817 &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
818 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
819 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
820 Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
821 }
822 my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',
823 80,
824 "/",
39a7cc11 825 Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
ac1cfefa
MT		 826 );
827 if ($response =~ m%HTTP/1\.. 200 OK%) {
828 $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
829 return $1;
830 }
831 return '';
832}
833
834#
835# Check if hostname.domain provided have IP provided
836# use gethostbyname to verify that
837# Params:
838# IP
839# hostname
840# domain
841# Output
842# 1 IP matches host.domain
843# 0 not in sync
844#
845sub DyndnsServiceSync ($;$;$) {
846
847 my ($ip,$hostName,$domain) = @_;
848 my @addresses;
849
850 #fix me no ip GROUP, what is the name ?
851 $hostName =~ s/$General::noipprefix//;
852 if ($hostName) { #may be empty
853 $hostName = "$hostName.$domain";
854 @addresses = gethostbyname($hostName);
855 }
856
857 if ($addresses[0] eq '') { # nothing returned ?
858 $hostName = $domain; # try resolving with domain only
859 @addresses = gethostbyname($hostName);
860 }
861
862 if ($addresses[0] ne '') { # got something ?
863 #&General::log("name:$addresses[0], alias:$addresses[1]");
864 # Build clear text list of IP
865 @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
866 if (grep (/$ip/, @addresses)) {
867 return 1;
868 }
869 }
870 return 0;
871}
872#
873# This sub returns the red IP used to compare in DyndnsServiceSync
874#
875sub GetDyndnsRedIP {
876 my %settings;
877 &General::readhash("${General::swroot}/ddns/settings", \%settings);
878
879 open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
880 my $ip = <IP>;
881 close(IP);
882 chomp $ip;
883
884 if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
885 &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
886 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
887 {
888 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
889 my $RealIP = &General::FetchPublicIp;
890 $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
891 }
892 }
893 return $ip;
894}
c545beb1
MT		 895
896# Translate ICMP code to text
897# ref: http://www.iana.org/assignments/icmp-parameters
898sub GetIcmpDescription ($) {
899 my $index = shift;
900 my @icmp_description = (
901 'Echo Reply', #0
902 'Unassigned',
903 'Unassigned',
904 'Destination Unreachable',
905 'Source Quench',
906 'Redirect',
907 'Alternate Host Address',
908 'Unassigned',
909 'Echo',
910 'Router Advertisement',
911 'Router Solicitation', #10
912 'Time Exceeded',
913 'Parameter Problem',
914 'Timestamp',
915 'Timestamp Reply',
916 'Information Request',
917 'Information Reply',
918 'Address Mask Request',
919 'Address Mask Reply',
920 'Reserved (for Security)',
921 'Reserved (for Robustness Experiment)', #20
922 'Reserved',
923 'Reserved',
924 'Reserved',
925 'Reserved',
926 'Reserved',
927 'Reserved',
928 'Reserved',
929 'Reserved',
930 'Reserved',
931 'Traceroute', #30
932 'Datagram Conversion Error',
933 'Mobile Host Redirect',
934 'IPv6 Where-Are-You',
935 'IPv6 I-Am-Here',
936 'Mobile Registration Request',
937 'Mobile Registration Reply',
938 'Domain Name Request',
939 'Domain Name Reply',
940 'SKIP',
941 'Photur', #40
942 'Experimental');
943 if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
944}
ac1cfefa 9451;
Peter's tree of IPFire 2.x