in lib/Mail/SpamAssassin/NetSet.pm [73:225]
sub add_cidr {
my ($self, @nets) = @_;
$self->{nets} ||= [ ];
my $numadded = 0;
delete $self->{cache}; # invalidate cache (in case of late additions)
# Pre-parse x.x.x.x-x.x.x.x range notation into CIDR blocks
# requires Net::CIDR::Lite
my @nets2;
foreach my $cidr_orig (@nets) {
next if index($cidr_orig, '-') == -1; # Triage
my $cidr = $cidr_orig;
my $exclude = ($cidr =~ s/^!\s*//) ? 1 : 0;
local($1);
$cidr =~ s/\b0+(\d+)/$1/; # Strip leading zeroes
eval { require Net::CIDR::Lite; }; # Only try to load now when it's necessary
if ($@) {
warn "netset: IP range notation '$cidr_orig' requires Net::CIDR::Lite module, ignoring\n";
$cidr_orig = undef;
next;
}
my $cidrs = Net::CIDR::Lite->new;
eval { $cidrs->add_range($cidr); };
if ($@) {
my $err = $@; $err =~ s/ at .*//s;
warn "netset: illegal IP range '$cidr_orig': $err\n";
$cidr_orig = undef;
next;
}
my @arr = $cidrs->list;
if (!@arr) {
my $err = $@; $err =~ s/ at .*//s;
warn "netset: failed to parse IP range '$cidr_orig': $err\n";
$cidr_orig = undef;
next;
}
# Save exclude flag
if ($exclude) { $_ = "!$_" foreach (@arr); }
# Rewrite this @nets value directly, add any rest to @nets2
$cidr_orig = shift @arr;
push @nets2, @arr if @arr;
}
foreach my $cidr_orig (@nets, @nets2) {
next unless defined $cidr_orig;
my $cidr = $cidr_orig; # leave original unchanged, useful for logging
# recognizes syntax:
# [IPaddr%scope]/len or IPaddr%scope/len or IPv4addr/mask
# optionally prefixed by a '!' to indicate negation (exclusion);
# the %scope (i.e. interface), /len or /mask are optional
local($1,$2,$3,$4);
$cidr =~ s/^\s+//;
my $exclude = ($cidr =~ s/^!\s*//) ? 1 : 0;
my $masklen; # netmask or a prefix length
$masklen = $1 if $cidr =~ s{ / (.*) \z }{}xs;
# discard optional brackets
$cidr = $1 if $cidr =~ /^ \[ ( [^\]]* ) \] \z/xs;
my $scope;
# IPv6 Scoped Address (RFC 4007, RFC 6874, RFC 3986 "unreserved" charset)
if ($cidr =~ s/ % ( [A-Z0-9._~-]* ) \z //xsi) { # scope <zone_id> ?
$scope = $1; # interface specification
# discard interface specification, currently just ignored
info("netset: ignoring interface scope '%%%s' in IP address %s",
$scope, $cidr_orig);
}
my $is_ip4 = 0;
if ($cidr =~ /^ \d+ (\. | \z) /x) { # looks like an IPv4 address
if ($cidr =~ /^ (\d+) \. (\d+) \. (\d+) \. (\d+) \z/x) {
# also strips leading zeroes, not liked by inet_pton
$cidr = sprintf('%d.%d.%d.%d', $1,$2,$3,$4);
$masklen = 32 if !defined $masklen;
} elsif ($cidr =~ /^ (\d+) \. (\d+) \. (\d+) \.? \z/x) {
$cidr = sprintf('%d.%d.%d.0', $1,$2,$3);
$masklen = 24 if !defined $masklen;
} elsif ($cidr =~ /^ (\d+) \. (\d+) \.? \z/x) {
$cidr = sprintf('%d.%d.0.0', $1,$2);
$masklen = 16 if !defined $masklen;
} elsif ($cidr =~ /^ (\d+) \.? \z/x) {
$cidr = sprintf('%d.0.0.0', $1);
$masklen = 8 if !defined $masklen;
} else {
warn "netset: illegal IPv4 address given: '$cidr_orig'\n";
next;
}
$is_ip4 = 1;
}
if ($self->{pt}) {
if (defined $masklen) {
$masklen =~ /^\d{1,3}\z/
or die "Network mask not supported, use a CIDR syntax: '$cidr_orig'";
}
my $key = $cidr;
my $prefix_len = $masklen;
if ($is_ip4) {
$key = '::ffff:' . $key; # turn it into an IPv4-mapped IPv6 addresses
$prefix_len += 96 if defined $prefix_len;
}
$prefix_len = 128 if !defined $prefix_len;
$key .= '/' . $prefix_len;
# dbg("netset: add_cidr (patricia trie) %s => %s",
# $cidr_orig, $exclude ? '!'.$key : $key);
defined eval {
$self->{pt}->add_string($key, $exclude ? '!'.$key : $key)
} or warn "netset: illegal IP address given (patricia trie): ".
"'$key': $@\n";
}
$cidr .= '/' . $masklen if defined $masklen;
my $ip = NetAddr::IP->new($cidr);
if (!defined $ip) {
warn "netset: illegal IP address given: '$cidr_orig'\n";
next;
}
# dbg("netset: add_cidr %s => %s => %s", $cidr_orig, $cidr, $ip);
# if this is an IPv4 address, create an IPv6 representation, too
my ($ip4, $ip6);
if ($is_ip4) {
$ip4 = $ip;
$ip6 = $self->_convert_ipv4_cidr_to_ipv6($cidr);
} else {
$ip6 = $ip;
}
# bug 5931: this is O(n^2). bad if there are lots of nets. There are good
# reasons to keep it for linting purposes, though, so don't start skipping
# it until we have over 200 nets in our list
if (scalar @{$self->{nets}} < 200) {
next if ($self->is_net_declared($ip4, $ip6, $exclude, 0));
}
# note: it appears a NetAddr::IP object takes up about 279 bytes
push @{$self->{nets}}, {
exclude => $exclude,
ip4 => $ip4,
ip6 => $ip6,
as_string => $cidr_orig,
};
$numadded++;
}
$self->{num_nets} += $numadded;
$numadded;
}