blob: 8a651b04029fa3a94962774edee59ac826895185 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
package local::netmask;
require Exporter;
use strict;
use local::db;
use base "Exporter";
sub new
{
my $invocant = shift;
my $class = ref($invocant) || $invocant;
# my $self = $class->SUPER::new(@_);
my $self=bless {}, $class;
return $self;
}
sub check_ip_in_subnet
{
my $self=shift;
my ($ip,$subnet_ip,$netmask) = @_; # example 192.168.1.1, 192.168.1.0, 24 -> returns true (1)
if ($ip =~ /\./ and $subnet_ip =~ /\./)
{
#ipv4
my $ip_int = $self->v4_array_to_int(split(/\./,$ip));
my $subnet_ip_int = $self->v4_array_to_int(split(/\./,$subnet_ip));
my @netmask_ary;
for my $i (0..3)
{
my $bits = $netmask - $i*8;
$bits = 8 if $bits >8;
$bits = 0 if $bits <0;
my $unset = 8-$bits;
push @netmask_ary,256- (2** $unset ) ;
}
my $netmask_int = $self->v4_array_to_int(@netmask_ary);
return 1 if ( ($ip_int & $netmask_int) == ($subnet_ip_int & $netmask_int));
return 0;
} elsif ($ip =~ /\:/ and $subnet_ip =~ /\:/) {
#ipv6
die "Only Subnet lengths of a multiple of 16 are currently supported" if $netmask % 16;
my @ip = split(/\:/,$ip);
my @netmask = split(/\:/,$subnet_ip);
for my $i (1..$netmask /16)
{
my $ip_part = shift @ip;
$ip_part = 0 if not $ip_part;
my $netmask_part = shift @netmask;
$netmask_part = 0 if not $netmask_part;
return 0 if $netmask_part != $ip_part;
}
return 1;
} else {
return; # not matching or unknown
}
}
sub v4_array_to_int
{
my $self=shift;
my @array=@_;
return unpack( "N", pack( "C4",@array ) );
}
|