sub add_cidr()

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;
}