]> git.ipfire.org Git - people/teissler/ipfire-2.x.git/blame - config/cfgroot/general-functions.pl
projects / people / teissler / ipfire-2.x.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Merge remote-tracking branch 'stevee/axel-log-fix' into axel-fixperms
[people/teissler/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);
e2429e8d
AM		 411 #get OVPN-Subnet (dynamic range)
412 my %ovpnconf=();
413 &readhash("${General::swroot}/ovpn/settings", \%ovpnconf);
414 my ($ovpnip,$ovpncidr)= split (/\//,$ovpnconf{'DOVPN_SUBNET'});
415 $ovpncidr=&iporsubtocidr($ovpncidr);
e2429e8d
AM		 416 #check if we try to use same network as ovpn server
417 if ("$ip/$cidr" eq "$ovpnip/$ovpncidr") {
418 $errormessage=$errormessage.$Lang::tr{'ccd err isovpnnet'}."<br>";
419 return $errormessage;
420 }
e2429e8d
AM		 421 #check if we use a network-name/subnet that already exists
422 &readhasharray("${General::swroot}/ovpn/ccd.conf", \%ccdconfhash);
423 foreach my $key (keys %ccdconfhash) {
424 @ccdconf=split(/\//,$ccdconfhash{$key}[1]);
425 if ($ccdname eq $ccdconfhash{$key}[0])
426 {
427 $errormessage=$errormessage.$Lang::tr{'ccd err nameexist'}."<br>";
428 return $errormessage;
429 }
430 my ($newip,$newsub) = split(/\//,$ccdnet);
431 if (&IpInSubnet($newip,$ccdconf[0],&iporsubtodec($ccdconf[1])))
432 {
433 $errormessage=$errormessage.$Lang::tr{'ccd err issubnet'}."<br>";
434 return $errormessage;
435 }
e2429e8d 436 }
e2429e8d
AM		 437 #check if we use a ipsec right network which is already defined
438 my %ipsecconf=();
439 &General::readhasharray("${General::swroot}/vpn/config", \%ipsecconf);
440 foreach my $key (keys %ipsecconf){
441 if ($ipsecconf{$key}[11] ne ''){
e2429e8d
AM		 442 my ($ipsecip,$ipsecsub) = split (/\//, $ipsecconf{$key}[11]);
443 $ipsecsub=&iporsubtodec($ipsecsub);
f7e3d208
AM		 444 if($ipsecconf{$key}[1] ne $ccdname){
445 if ( &IpInSubnet ($ip,$ipsecip,$ipsecsub) ){
ac2f7107 446 $errormessage=$Lang::tr{'ccd err isipsecnet'}." Name: $ipsecconf{$key}[1]";
f7e3d208
AM		 447 return $errormessage;
448 }
e2429e8d
AM		 449 }
450 }
451 }
e2429e8d
AM		 452 #check if we use one of ipfire's networks (green,orange,blue)
453 my %ownnet=();
454 &readhash("${General::swroot}/ethernet/settings", \%ownnet);
455 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;}
456 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;}
457 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;}
458 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;}
e2429e8d
AM		 459}
460
461
ac1cfefa
MT		 462sub validport
463{
464 $_ = $_[0];
465
466 if (!/^\d+$/) {
467 return 0; }
468 if (/^0./) {
469 return 0; }
470 if ($_ >= 1 && $_ <= 65535) {
471 return 1; }
472 return 0;
473}
474
d30ea451
CS		 475sub validproxyport
476{
477 $_ = $_[0];
478
479 if (!/^\d+$/) {
480 return 0; }
481 if (/^0./) {
482 return 0; }
483 if ($_ == 53 || $_ == 222 || $_ == 444 || $_ == 81 ) {
484 return 0; }
485 elsif ($_ >= 1 && $_ <= 65535) {
486 return 1; }
487 return 0;
488}
489
ac1cfefa
MT		 490sub validmac
491{
492 my $checkmac = $_[0];
493 my $ot = '[0-9a-f]{2}'; # 2 Hex digits (one octet)
494 if ($checkmac !~ /^$ot:$ot:$ot:$ot:$ot:$ot$/i)
495 {
496 return 0;
497 }
498 return 1;
499}
500
501sub validhostname
502{
503 # Checks a hostname against RFC1035
504 my $hostname = $_[0];
505
506 # Each part should be at least two characters in length
507 # but no more than 63 characters
508 if (length ($hostname) < 1 || length ($hostname) > 63) {
509 return 0;}
510 # Only valid characters are a-z, A-Z, 0-9 and -
8c877a82 511 if ($hostname !~ /^[a-zA-Z0-9-\s]*$/) {
ac1cfefa
MT		 512 return 0;}
513 # First character can only be a letter or a digit
514 if (substr ($hostname, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
515 return 0;}
516 # Last character can only be a letter or a digit
517 if (substr ($hostname, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
518 return 0;}
519 return 1;
520}
521
522sub validdomainname
523{
524 my $part;
525
526 # Checks a domain name against RFC1035
527 my $domainname = $_[0];
528 my @parts = split (/\./, $domainname); # Split hostname at the '.'
529
530 foreach $part (@parts) {
531 # Each part should be at least two characters in length
532 # but no more than 63 characters
533 if (length ($part) < 2 || length ($part) > 63) {
534 return 0;}
535 # Only valid characters are a-z, A-Z, 0-9 and -
536 if ($part !~ /^[a-zA-Z0-9-]*$/) {
537 return 0;}
538 # First character can only be a letter or a digit
539 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
540 return 0;}
541 # Last character can only be a letter or a digit
542 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
543 return 0;}
544 }
545 return 1;
546}
547
548sub validfqdn
549{
550 my $part;
551
552 # Checks a fully qualified domain name against RFC1035
553 my $fqdn = $_[0];
554 my @parts = split (/\./, $fqdn); # Split hostname at the '.'
555 if (scalar(@parts) < 2) { # At least two parts should
556 return 0;} # exist in a FQDN
557 # (i.e. hostname.domain)
558 foreach $part (@parts) {
559 # Each part should be at least one character in length
560 # but no more than 63 characters
561 if (length ($part) < 1 || length ($part) > 63) {
562 return 0;}
563 # Only valid characters are a-z, A-Z, 0-9 and -
564 if ($part !~ /^[a-zA-Z0-9-]*$/) {
565 return 0;}
566 # First character can only be a letter or a digit
567 if (substr ($part, 0, 1) !~ /^[a-zA-Z0-9]*$/) {
568 return 0;}
569 # Last character can only be a letter or a digit
570 if (substr ($part, -1, 1) !~ /^[a-zA-Z0-9]*$/) {
571 return 0;}
572 }
573 return 1;
574}
575
576sub validportrange # used to check a port range
577{
578 my $port = $_[0]; # port values
579 $port =~ tr/-/:/; # replace all - with colons just in case someone used -
580 my $srcdst = $_[1]; # is it a source or destination port
581
582 if (!($port =~ /^(\d+)\:(\d+)$/)) {
583
584 if (!(&validport($port))) {
585 if ($srcdst eq 'src'){
586 return $Lang::tr{'source port numbers'};
587 } else {
588 return $Lang::tr{'destination port numbers'};
589 }
590 }
591 }
592 else
593 {
594 my @ports = ($1, $2);
595 if ($1 >= $2){
596 if ($srcdst eq 'src'){
597 return $Lang::tr{'bad source range'};
598 } else {
599 return $Lang::tr{'bad destination range'};
600 }
601 }
602 foreach $_ (@ports)
603 {
604 if (!(&validport($_))) {
605 if ($srcdst eq 'src'){
606 return $Lang::tr{'source port numbers'};
607 } else {
608 return $Lang::tr{'destination port numbers'};
609 }
610 }
611 }
612 return;
613 }
614}
615
616# Test if IP is within a subnet
617# Call: IpInSubnet (Addr, Subnet, Subnet Mask)
618# Subnet can be an IP of the subnet: 10.0.0.0 or 10.0.0.1
619# Everything in dottted notation
620# Return: TRUE/FALSE
621sub IpInSubnet
622{
623 my $ip = unpack('N', &Socket::inet_aton(shift));
624 my $start = unpack('N', &Socket::inet_aton(shift));
625 my $mask = unpack('N', &Socket::inet_aton(shift));
626 $start &= $mask; # base of subnet...
627 my $end = $start + ~$mask;
628 return (($ip >= $start) && ($ip <= $end));
629}
630
c545beb1
MT		 631#
632# Return the following IP (IP+1) in dotted notation.
633# Call: NextIP ('1.1.1.1');
634# Return: '1.1.1.2'
635#
636sub NextIP
637{
638 return &Socket::inet_ntoa( pack("N", 1 + unpack('N', &Socket::inet_aton(shift))
639 )
640 );
641}
8c877a82
AM		 642sub NextIP2
643{
644 return &Socket::inet_ntoa( pack("N", 4 + unpack('N', &Socket::inet_aton(shift))
645 )
646 );
647}
45762fc6
AF		 648sub ipcidr
649{
650 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
651 return "$ip\/$cidr";
652}
653
54fd0535
MT		 654sub ipcidr2msk
655{
656 my ($ip,$cidr) = &Net::IPv4Addr::ipv4_parse(shift);
657 my $netmask = &Net::IPv4Addr::ipv4_cidr2msk($cidr);
658 return "$ip\/$netmask";
659}
660
661
ac1cfefa
MT		 662sub validemail {
663 my $mail = shift;
664 return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ );
665 return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/);
666 return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ );
667 return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ );
668 return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g );
669 return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g );
670 return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ );
671 return 1;
672}
673
c545beb1
MT		 674#
675# Currently only vpnmain use this three procs (readhasharray, writehasharray, findhasharray)
676# The 'key' used is numeric but is perfectly unneeded! This will to be removed so don't use
677# this code. Vpnmain will be splitted in parts: x509/pki, connection ipsec, connection other,... .
678#
ac1cfefa
MT		 679sub readhasharray {
680 my ($filename, $hash) = @_;
681 %$hash = ();
682
683 open(FILE, $filename) or die "Unable to read file $filename";
684
685 while (<FILE>) {
686 my ($key, $rest, @temp);
687 chomp;
688 ($key, $rest) = split (/,/, $_, 2);
c545beb1 689 if ($key =~ /^[0-9]+$/) {
ac1cfefa
MT		 690 @temp = split (/,/, $rest);
691 $hash->{$key} = \@temp;
692 }
693 }
694 close FILE;
695 return;
696}
697
698sub writehasharray {
699 my ($filename, $hash) = @_;
700 my ($key, @temp, $i);
701
702 open(FILE, ">$filename") or die "Unable to write to file $filename";
703
704 foreach $key (keys %$hash) {
8c877a82
AM		 705 if ($key =~ /^[0-9]+$/) {
706 print FILE "$key";
707 foreach $i (0 .. $#{$hash->{$key}}) {
708 print FILE ",$hash->{$key}[$i]";
709 }
710 print FILE "\n";
711 }
ac1cfefa
MT		 712 }
713 close FILE;
714 return;
715}
716
717sub findhasharraykey {
718 foreach my $i (1 .. 1000000) {
719 if ( ! exists $_[0]{$i}) {
720 return $i;
721 }
722 }
723}
724
725sub srtarray
726# Darren Critchley - darrenc@telus.net - (c) 2003
727# &srtarray(SortOrder, AlphaNumeric, SortDirection, ArrayToBeSorted)
728# This subroutine will take the following parameters:
729# ColumnNumber = the column which you want to sort on, starts at 1
730# AlphaNumberic = a or n (lowercase) defines whether the sort should be alpha or numberic
731# SortDirection = asc or dsc (lowercase) Ascending or Descending sort
732# ArrayToBeSorted = the array that wants sorting
733#
734# Returns an array that is sorted to your specs
735#
736# If SortOrder is greater than the elements in array, then it defaults to the first element
737#
738{
739 my ($colno, $alpnum, $srtdir, @tobesorted) = @_;
740 my @tmparray;
741 my @srtedarray;
742 my $line;
743 my $newline;
744 my $ctr;
745 my $ttlitems = scalar @tobesorted; # want to know the number of rows in the passed array
746 if ($ttlitems < 1){ # if no items, don't waste our time lets leave
747 return (@tobesorted);
748 }
749 my @tmp = split(/\,/,$tobesorted[0]);
750 $ttlitems = scalar @tmp; # this should be the number of elements in each row of the passed in array
751
752 # Darren Critchley - validate parameters
753 if ($colno > $ttlitems){$colno = '1';}
754 $colno--; # remove one from colno to deal with arrays starting at 0
755 if($colno < 0){$colno = '0';}
756 if ($alpnum ne '') { $alpnum = lc($alpnum); } else { $alpnum = 'a'; }
757 if ($srtdir ne '') { $srtdir = lc($srtdir); } else { $srtdir = 'src'; }
758
759 foreach $line (@tobesorted)
760 {
761 chomp($line);
762 if ($line ne '') {
763 my @temp = split(/\,/,$line);
764 # Darren Critchley - juggle the fields so that the one we want to sort on is first
765 my $tmpholder = $temp[0];
766 $temp[0] = $temp[$colno];
767 $temp[$colno] = $tmpholder;
768 $newline = "";
769 for ($ctr=0; $ctr < $ttlitems ; $ctr++) {
770 $newline=$newline . $temp[$ctr] . ",";
771 }
772 chop($newline);
773 push(@tmparray,$newline);
774 }
775 }
776 if ($alpnum eq 'n') {
777 @tmparray = sort {$a <=> $b} @tmparray;
778 } else {
779 @tmparray = (sort @tmparray);
780 }
781 foreach $line (@tmparray)
782 {
783 chomp($line);
784 if ($line ne '') {
785 my @temp = split(/\,/,$line);
786 my $tmpholder = $temp[0];
787 $temp[0] = $temp[$colno];
788 $temp[$colno] = $tmpholder;
789 $newline = "";
790 for ($ctr=0; $ctr < $ttlitems ; $ctr++){
791 $newline=$newline . $temp[$ctr] . ",";
792 }
793 chop($newline);
794 push(@srtedarray,$newline);
795 }
796 }
797
798 if ($srtdir eq 'dsc') {
799 @tmparray = reverse(@srtedarray);
800 return (@tmparray);
801 } else {
802 return (@srtedarray);
803 }
804}
805
806sub FetchPublicIp {
807 my %proxysettings;
808 &General::readhash("${General::swroot}/proxy/settings", \%proxysettings);
809 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
810 my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
811 Net::SSLeay::set_proxy($peer,$peerport,$proxysettings{'UPSTREAM_USER'},$proxysettings{'UPSTREAM_PASSWORD'} );
812 }
813 my ($out, $response) = Net::SSLeay::get_http( 'checkip.dyndns.org',
814 80,
815 "/",
39a7cc11 816 Net::SSLeay::make_headers('User-Agent' => 'IPFire' )
ac1cfefa
MT		 817 );
818 if ($response =~ m%HTTP/1\.. 200 OK%) {
819 $out =~ /Current IP Address: (\d+.\d+.\d+.\d+)/;
820 return $1;
821 }
822 return '';
823}
824
825#
826# Check if hostname.domain provided have IP provided
827# use gethostbyname to verify that
828# Params:
829# IP
830# hostname
831# domain
832# Output
833# 1 IP matches host.domain
834# 0 not in sync
835#
836sub DyndnsServiceSync ($;$;$) {
837
838 my ($ip,$hostName,$domain) = @_;
839 my @addresses;
840
841 #fix me no ip GROUP, what is the name ?
842 $hostName =~ s/$General::noipprefix//;
843 if ($hostName) { #may be empty
844 $hostName = "$hostName.$domain";
845 @addresses = gethostbyname($hostName);
846 }
847
848 if ($addresses[0] eq '') { # nothing returned ?
849 $hostName = $domain; # try resolving with domain only
850 @addresses = gethostbyname($hostName);
851 }
852
853 if ($addresses[0] ne '') { # got something ?
854 #&General::log("name:$addresses[0], alias:$addresses[1]");
855 # Build clear text list of IP
856 @addresses = map ( &Socket::inet_ntoa($_), @addresses[4..$#addresses]);
857 if (grep (/$ip/, @addresses)) {
858 return 1;
859 }
860 }
861 return 0;
862}
863#
864# This sub returns the red IP used to compare in DyndnsServiceSync
865#
866sub GetDyndnsRedIP {
867 my %settings;
868 &General::readhash("${General::swroot}/ddns/settings", \%settings);
869
870 open(IP, "${General::swroot}/red/local-ipaddress") or return 'unavailable';
871 my $ip = <IP>;
872 close(IP);
873 chomp $ip;
874
875 if (&General::IpInSubnet ($ip,'10.0.0.0','255.0.0.0') ||
876 &General::IpInSubnet ($ip,'172.16.0.0.','255.240.0.0') ||
877 &General::IpInSubnet ($ip,'192.168.0.0','255.255.0.0'))
878 {
879 if ($settings{'BEHINDROUTER'} eq 'FETCH_IP') {
880 my $RealIP = &General::FetchPublicIp;
881 $ip = (&General::validip ($RealIP) ? $RealIP : 'unavailable');
882 }
883 }
884 return $ip;
885}
c545beb1
MT		 886
887# Translate ICMP code to text
888# ref: http://www.iana.org/assignments/icmp-parameters
889sub GetIcmpDescription ($) {
890 my $index = shift;
891 my @icmp_description = (
892 'Echo Reply', #0
893 'Unassigned',
894 'Unassigned',
895 'Destination Unreachable',
896 'Source Quench',
897 'Redirect',
898 'Alternate Host Address',
899 'Unassigned',
900 'Echo',
901 'Router Advertisement',
902 'Router Solicitation', #10
903 'Time Exceeded',
904 'Parameter Problem',
905 'Timestamp',
906 'Timestamp Reply',
907 'Information Request',
908 'Information Reply',
909 'Address Mask Request',
910 'Address Mask Reply',
911 'Reserved (for Security)',
912 'Reserved (for Robustness Experiment)', #20
913 'Reserved',
914 'Reserved',
915 'Reserved',
916 'Reserved',
917 'Reserved',
918 'Reserved',
919 'Reserved',
920 'Reserved',
921 'Reserved',
922 'Traceroute', #30
923 'Datagram Conversion Error',
924 'Mobile Host Redirect',
925 'IPv6 Where-Are-You',
926 'IPv6 I-Am-Here',
927 'Mobile Registration Request',
928 'Mobile Registration Reply',
929 'Domain Name Request',
930 'Domain Name Reply',
931 'SKIP',
932 'Photur', #40
933 'Experimental');
934 if ($index>41) {return 'unknown'} else {return @icmp_description[$index]};
935}
ac1cfefa 9361;
Timo's tree of IPFire 2.x