Server IP : 85.214.239.14 / Your IP : 3.139.93.168 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Amavis/Lookup/ |
Upload File : |
# SPDX-License-Identifier: GPL-2.0-or-later package Amavis::Lookup::IP; use strict; use re 'taint'; BEGIN { require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $have_patricia); $VERSION = '2.412'; @ISA = qw(Exporter); @EXPORT_OK = qw(&lookup_ip_acl &ip_to_vec &normalize_ip_addr); } use subs @EXPORT_OK; use Amavis::Util qw(ll do_log); BEGIN { eval { require Net::Patricia; Net::Patricia->VERSION(1.015); # need AF_INET6 support import Net::Patricia; $have_patricia = 1; } or do { undef $have_patricia; }; } # ip_to_vec() takes an IPv6 or IPv4 address with optional prefix length # (or an IPv4 mask), parses and validates it, and returns it as a 128-bit # vector string that can be used as operand to Perl bitwise string operators. # Syntax and other errors in the argument throw exception (die). # If the second argument $allow_mask is 0, the prefix length or mask # specification is not allowed as part of the IP address. # # The IPv6 syntax parsing and validation adheres to RFC 4291 (ex RFC 3513). # All the following IPv6 address forms are supported: # x:x:x:x:x:x:x:x preferred form # x:x:x:x:x:x:d.d.d.d alternative form # ...::... zero-compressed form # addr/prefix-length prefix length may be specified (defaults to 128) # Optionally an "IPv6:" prefix may be prepended to an IPv6 address # as specified by RFC 5321 (ex RFC 2821). Brackets enclosing the address # are optional, e.g. [::1]/128 . # # The following IPv4 forms are allowed: # d.d.d.d # d.d.d.d/prefix-length CIDR mask length is allowed (defaults to 32) # d.d.d.d/m.m.m.m network mask (gets converted to prefix-length) # If prefix-length or a mask is specified with an IPv4 address, the address # may be shortened to d.d.d/n or d.d/n or d/n. Such truncation is allowed # for compatibility with earlier version, but is deprecated and is not # allowed for IPv6 addresses. # # IPv4 addresses and masks are converted to IPv4-mapped IPv6 addresses # of the form ::FFFF:d.d.d.d, The CIDR mask length (0..32) is converted # to an IPv6 prefix-length (96..128). The returned vector strings resulting # from IPv4 and IPv6 forms are indistinguishable. # # NOTE: # d.d.d.d is equivalent to ::FFFF:d.d.d.d (IPv4-mapped IPv6 address) # which is not the same as ::d.d.d.d (IPv4-compatible IPv6 address) # # A quadruple is returned: # - an IP address represented as a 128-bit vector (a string) # - network mask derived from prefix length, a 128-bit vector (string) # - prefix length as an integer (0..128) # - zone_id, e.g. an interface scope for link-local addresses, # undef if not specified (implies a default zone_id 0, RFC 4007 sect. 11) # sub ip_to_vec($;$) { my($ip,$allow_mask) = @_; my($ip_len, @ip_fields, $scope); local($1,$2,$3,$4,$5,$6); $ip =~ s/^[ \t]+//; $ip =~ s/[ \t\r\n]+\z//s; # trim my $ipa = $ip; ($ipa,$ip_len) = ($1,$2) if $allow_mask && $ip =~ m{^ ([^/]*) / (.*) \z}xs; $ipa = $1 if $ipa =~ m{^ \[ (.*) \] \z}xs; # discard optional brackets my $have_ipv6; if ($ipa =~ s/^IPv6://i) { $have_ipv6 = 1 } elsif ($ipa =~ /:[0-9a-f]*:/i) { $have_ipv6 = 1 } # RFC 4007: IPv6 Scoped Address Architecture, sect 11: textual representation # RFC 6874 A <zone_id> SHOULD contain only ASCII characters # classified as "unreserved" for use in URIs [RFC 3986] # RFC 3986: unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" $scope = $1 if $ipa =~ s/ ( % [A-Z0-9._~-]* ) \z//xsi; # scoped address if ($have_ipv6 && $ipa =~ m{^(.*:) (\d{1,3}) \. (\d{1,3}) \. (\d{1,3}) \. (\d{1,3})\z}xsi){ # IPv6 alternative form x:x:x:x:x:x:d.d.d.d my(@d) = ($2,$3,$4,$5); !grep($_ > 255, @d) or die "Invalid decimal field value in IPv6 address: [$ip]\n"; $ipa = $1 . sprintf('%02x%02x:%02x%02x', @d); } elsif (!$have_ipv6 && $ipa =~ m{^ \d{1,3} (?: \. \d{1,3}){0,3} \z}xs) { # IPv4 my(@d) = split(/\./,$ipa,-1); !grep($_ > 255, @d) or die "Invalid field value in IPv4 address: [$ip]\n"; defined($ip_len) || @d==4 or die "IPv4 address [$ip] contains fewer than 4 fields\n"; $ipa = '::ffff:' . sprintf('%02x%02x:%02x%02x', @d); # IPv4-mapped IPv6 if (!defined($ip_len)) { $ip_len = 32; # no length, defaults to /32 } elsif ($ip_len =~ /^\d{1,9}\z/) { # /n, IPv4 CIDR notation } elsif ($ip_len =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) { my(@d) = ($1,$2,$3,$4); !grep($_ > 255, @d) or die "Illegal field value in IPv4 mask: [$ip]\n"; my $mask1 = pack('C4', @d); # /m.m.m.m my $len = unpack('%b*', $mask1); # count ones my $mask2 = pack('B32', '1' x $len); # reconstruct mask from count $mask1 eq $mask2 or die "IPv4 mask not representing a valid CIDR mask: [$ip]\n"; $ip_len = $len; } else { die "Invalid IPv4 network mask or CIDR prefix length: [$ip]\n"; } $ip_len<=32 or die "IPv4 network prefix length greater than 32: [$ip]\n"; $ip_len += 128-32; # convert IPv4 net mask length to IPv6 prefix length } # now we presumably have an IPv6 compressed or preferred form x:x:x:x:x:x:x:x if ($ipa !~ /^(.*?)::(.*)\z/s) { # zero-compressing form used? @ip_fields = split(/:/,$ipa,-1); # no, have preferred form } else { # expand zero-compressing form my($before,$after) = ($1,$2); my(@bfr) = split(/:/,$before,-1); my(@aft) = split(/:/,$after,-1); my $missing_cnt = 8-(@bfr+@aft); $missing_cnt = 1 if $missing_cnt<1; @ip_fields = (@bfr, ('0') x $missing_cnt, @aft); } @ip_fields >= 8 or die "IPv6 address [$ip] contains fewer than 8 fields\n"; @ip_fields <= 8 or die "IPv6 address [$ip] contains more than 8 fields\n"; !grep(!/^[0-9a-fA-F]{1,4}\z/, @ip_fields) # this is quite slow or die "Invalid syntax of IPv6 address: [$ip]\n"; my $vec = pack('n8', map(hex($_),@ip_fields)); if (!defined($ip_len)) { $ip_len = 128; } elsif ($ip_len !~ /^\d{1,3}\z/) { die "Invalid prefix length syntax in IP address: [$ip]\n"; } elsif ($ip_len > 128) { die "IPv6 network prefix length greater than 128: [$ip]\n"; } my $mask = pack('B128', '1' x $ip_len); # do_log(5, "ip_to_vec: %s => %s/%d\n", # unpack('B*',$vec) # $ip, join(':',unpack('(H4)*',$vec)), $ip_len); ($vec, $mask, $ip_len, $scope); } use vars qw($ip_mapd_vec $ip_mapd_mask $ip_xlat_vec $ip_xlat_mask $ip_6to4_vec $ip_6to4_mask $ip_nat64_vec $ip_nat64_mask); BEGIN { # RFC 4291: IPv4-mapped ($ip_mapd_vec, $ip_mapd_mask) = ip_to_vec('::ffff:0:0/96',1); # IPv4-mapped # RFC 2765 (SIIT): IPv4-translated ($ip_xlat_vec, $ip_xlat_mask) = ip_to_vec('::ffff:0:0:0/96',1); # IPv4-xlat # RFC 3056 (6to4) ($ip_6to4_vec, $ip_6to4_mask) = ip_to_vec('2002::/16',1); # 6to4 # RFC 6052, RFC 6146 (NAT64) ($ip_nat64_vec, $ip_nat64_mask) = ip_to_vec('64:ff9b::/96',1); # NAT64 # check, just in case $ip_mapd_vec = $ip_mapd_vec & $ip_mapd_mask; $ip_xlat_vec = $ip_xlat_vec & $ip_xlat_mask; $ip_6to4_vec = $ip_6to4_vec & $ip_6to4_mask; $ip_nat64_vec = $ip_nat64_vec & $ip_nat64_mask; } # strip an optional 'IPv6:' prefix, lowercase hex digits, # convert an IPv4-mapped IPv6 address into a plain IPv4 dot-quad form; # leave unchanged if syntactically incorrect # sub normalize_ip_addr($) { my $ip = $_[0]; my($have_ipv6, $scope); if ($ip =~ s/^IPv6://i) { $have_ipv6 = 1 } elsif ($ip =~ /:[0-9a-f]*:/i) { $have_ipv6 = 1 } if ($have_ipv6) { local($1); $scope = $1 if $ip =~ s/ % ( [A-Z0-9._~-]* ) \z//xsi; # scoped address if ($ip !~ /^[0:]+:ffff:/i) { # triage for IPv4-mapped $ip = lc $ip; # lowercase: RFC 5952 } else { # looks like an IPv4-mapped address my($ip_vec,$ip_mask); if (!eval { ($ip_vec,$ip_mask) = ip_to_vec($ip,0); 1 }) { do_log(3, "normalize_ip_addr: bad IP address: %s", $_[0]); } elsif (($ip_vec & $ip_mapd_mask) ne $ip_mapd_vec) { $ip = lc $ip; # lowercase: RFC 5952 # RFC 5952 - Recommendation for IPv6 Text Representation # TODO: apply suppression of leading zeroes, zero compression } else { # IPv4-mapped address my $ip_dq = join('.', unpack('C4',substr($ip_vec,12,4))); # 32 bits do_log(5, "IPv4-mapped: %s -> %s", $ip, $ip_dq); $ip = $ip_dq; } } } $ip .= '%'.$scope if $scope; # defined, nonempty and nonzero $ip; } # lookup_ip_acl() performs a lookup for an IPv4 or IPv6 address against a list # of lookup tables, each may be a constant, or a ref to an access control # list or a ref to an associative array (hash) of network or host addresses. # Interface zone_id (e.g. scope for link-local addresses) is ignored. # # IP address is compared to each member of an access list in turn, # the first match wins (terminates the search), and its value decides # whether the result is true (yes, permit, pass) or false (no, deny, drop). # Falling through without a match produces a false (undef). # # For lookup tables which are a ref to a an array (a traditional ACL), # the presence of a character '!' prepended to a list member decides # whether the result will be true (without a '!') or false (with a '!') # in case this list member matches and terminates the search. # # Because search stops at the first match, it only makes sense # to place more specific patterns before the more general ones. # # For IPv4 a network address can be specified in classless notation # n.n.n.n/k, or using a mask n.n.n.n/m.m.m.m . Missing mask implies /32, # i.e. a host address. For IPv6 addresses all RFC 4291 forms are allowed # and the /k specifies a prefix length. See also comments at ip_to_vec(). # # Although not a special case, it is good to remember that '::/0' # always matches any IPv4 or IPv6 address (even syntactically invalid address). # # The '0/0' is equivalent to '::ffff:0:0/96' and matches any syntactically # valid IPv4 address (including IPv4-mapped IPv6 addresses), but not other # IPv6 addresses! # # Example # given: @acl = qw( !192.168.1.12 172.16.3.3 !172.16.3.0/255.255.255.0 # 10.0.0.0/8 172.16.0.0/12 192.168.0.0/16 # !0.0.0.0/8 !:: 127.0.0.0/8 ::1 ); # matches RFC 1918 private address space except host 192.168.1.12 # and net 172.16.3/24 (but host 172.16.3.3 within 172.16.3/24 still matches). # In addition, the 'unspecified' (null, i.e. all zeros) IPv4 and IPv6 # addresses return false, and IPv4 and IPv6 loopback addresses match # and return true. # # If the supplied lookup table is a hash reference, match a canonical # IP address: dot-quad IPv4, or a preferred IPv6 form, against hash keys. # For IPv4 addresses a simple classful subnet specification is allowed in # hash keys by truncating trailing bytes from the looked up IPv4 address. # A syntactically invalid IP address cannot match any hash entry. # sub lookup_ip_acl($@) { my($ip, @nets_ref) = @_; my($ip_vec,$ip_mask); my $eval_stat; eval { ($ip_vec,$ip_mask) = ip_to_vec($ip,0); 1 } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" }; my($label,$fullkey,$result,$lookup_type); my $found = 0; for my $tb (@nets_ref) { my $t = ref($tb) eq 'REF' ? $$tb : $tb; # allow one level of indirection if (!ref($t) || ref($t) eq 'SCALAR') { # a scalar always matches my $r = ref($t) ? $$t : $t; # allow direct or indirect reference $result = $r; $fullkey = "(constant:$r)"; $lookup_type = 'const'; $found=1 if defined $result; } elsif (ref($t) eq 'HASH') { $lookup_type = 'hash'; if (!defined $ip_vec) { # syntactically invalid IP address $fullkey = undef; $result = $t->{$fullkey}; # only matches undef key $found=1 if defined $result; } else { # valid IP address # match a canonical IP address: dot-quad IPv4, or preferred IPv6 form my $ip_c; # IP address in a canonical form: x:x:x:x:x:x:x:x $ip_c = join(':', map(sprintf('%04x',$_), unpack('n8',$ip_vec))); if (($ip_vec & $ip_mapd_mask) ne $ip_mapd_vec) { do_log(5, 'lookup_ip_acl keys: "%s"', $ip_c); } else { # is an IPv4-mapped addr my $ip_dq; # IPv4 in dotted-quad form $ip_dq = join('.', unpack('C4',substr($ip_vec,12,4))); # 32 bits # try dot-quad, stripping off trailing bytes repeatedly do_log(5, 'lookup_ip_acl keys: "%s", "%s"', $ip_dq, $ip_c); for (my(@f)=split(/\./,$ip_dq); @f && !$found; $#f--) { $fullkey = join('.',@f); $result = $t->{$fullkey}; $found=1 if defined $result; } } # test for 6to4 too? not now # if ($ip_vec & $ip_6to4_mask) eq $ip_6to4_vec) { # # yields an IPv4 address of a client's 6to4 router # $ip_dq = join('.', unpack('C4',substr($ip_vec,2,4))); # } if (!$found) { # try the 'preferred IPv6 form', lowercase hex letters $fullkey = lc $ip_c; $result = $t->{$fullkey}; $found=1 if defined $result; } } } elsif (ref($t) eq 'ARRAY') { $lookup_type = 'array'; my($key,$acl_ip_vec,$acl_mask,$acl_mask_len); local($1,$2); for my $net (@$t) { $fullkey = $key = $net; $result = 1; if ($key =~ /^(!+)(.*)\z/s) { # starts with exclamation mark(s) $key = $2; $result = 1 - $result if (length($1) & 1); # negate if odd } ($acl_ip_vec, $acl_mask, $acl_mask_len) = ip_to_vec($key,1); if ($acl_mask_len == 0) { $found=1 } #even an invalid addr matches ::/0 elsif (!defined($ip_vec)) {} # no other matches for invalid address elsif (($ip_vec & $acl_mask) eq ($acl_ip_vec & $acl_mask)) { $found=1 } last if $found; } } elsif ($t->isa('Net::Patricia::AF_INET6')) { # Patricia Trie $lookup_type = 'patricia'; local($1,$2,$3,$4); local($_) = $ip; $_ = $1 if /^ \[ ( [^\]]* ) \] \z/xs; # discard optional brackets s/%[A-Z0-9:._-]+\z//si; # discard interface specification if (m{^ (\d+) \. (\d+) \. (\d+) \. (\d+) \z}x) { $_ = sprintf('::ffff:%d.%d.%d.%d', $1,$2,$3,$4); } else { s/^IPv6://i; # discard optional 'IPv6:' prefix } eval { $result = $t->match_string($_); 1 } or $result=undef; if (defined $result) { $fullkey = $result; if ($fullkey =~ s/^!//) { $result = 0 } else { $result = 1; $found = 1 } } } elsif ($t->isa('Amavis::Lookup::IP')) { # pre-parsed IP lookup array obj $lookup_type = 'arr.obj'; my($acl_ip_vec, $acl_mask, $acl_mask_len); for my $e (@$t) { ($fullkey, $acl_ip_vec, $acl_mask, $acl_mask_len, $result) = @$e; if ($acl_mask_len == 0) { $found=1 } #even an invalid addr matches ::/0 elsif (!defined($ip_vec)) {} # no other matches for invalid address elsif (($ip_vec & $acl_mask) eq ($acl_ip_vec & $acl_mask)) { $found=1 } last if $found; } } elsif ($t->isa('Amavis::Lookup::DNSxL')) { # DNSxL lookup obj, RFC 5782 $lookup_type = 'dns'; ($result, $fullkey) = $t->lookup_ip($ip); $found = $result; } elsif ($t->isa('Amavis::Lookup::Label')) { # logging label # just a convenience for logging purposes, not a real lookup method $label = $t->display; # grab the name, and proceed with the next table } else { die "TROUBLE: lookup table is an unknown object: " . ref($t); } last if $found; } $fullkey = $result = undef if !$found; if ($label ne '') { $label = " ($label)" } ll(4) && do_log(4, 'lookup_ip_acl%s %s: key="%s"%s', $label, $lookup_type, $ip, !$found ? ", no match" : " matches \"$fullkey\", result=$result"); if (defined $eval_stat) { chomp $eval_stat; die $eval_stat if $eval_stat =~ /^timed out\b/; # resignal timeout $eval_stat = "lookup_ip_acl$label: $eval_stat"; do_log(2, "%s", $eval_stat); } !wantarray ? $result : ($result, $fullkey, $eval_stat); } # Create a pre-parsed object from a list of IP networks, which # may be used as an argument to lookup_ip_acl to speed up its searches. # Interface zone_id (e.g. scope for link-local addresses) is ignored. # sub new($@) { my($class,@nets) = @_; my $build_patricia_trie = $have_patricia && (@nets > 20); if (!$build_patricia_trie) { # build a traditional pre-parsed search list for a small number of entries my(@list); local($1,$2); for my $net (@nets) { my $key = $net; my $result = 1; if ($key =~ /^(!+)(.*)\z/s) { # starts with exclamation mark(s) $key = $2; $result = 1 - $result if (length($1) & 1); # negate if odd } my($ip_vec, $ip_mask, $ip_mask_len) = ip_to_vec($key,1); push(@list, [$net, $ip_vec, $ip_mask, $ip_mask_len, $result]); } return bless(\@list, $class); } else { # build a patricia trie, it offers more efficient searching in large sets my $pt = Net::Patricia->new(&AF_INET6); do_log(5, "building a patricia trie out of %d nets", scalar(@nets)); for my $net (@nets) { local $_ = $net; local($1,$2,$3,$4); my $masklen; if (s{ / ([0-9.]+) \z }{}x) { $masklen = $1; $masklen =~ /^\d{1,3}\z/ or die "Network mask not supported, use a CIDR syntax: $net"; } s/^!//; # strip a negation from a key, it will be retained in data $_ = $1 if /^ \[ ( [^\]]* ) \] \z/xs; # discard optional brackets s/%[A-Z0-9:._-]+\z//si; # discard interface specification if (/^ \d+ (?: \. | \z) /x) { # triage for an IPv4 network address if (/^ (\d+) \. (\d+) \. (\d+) \. (\d+) \z/x) { $_ = sprintf('::ffff:%d.%d.%d.%d', $1,$2,$3,$4); $masklen = 32 if !defined $masklen; } elsif (/^ (\d+) \. (\d+) \. (\d+) \.? \z/x) { $_ = sprintf('::ffff:%d.%d.%d.0', $1,$2,$3); $masklen = 24 if !defined $masklen; } elsif (/^ (\d+) \. (\d+) \.? \z/x) { $_ = sprintf('::ffff:%d.%d.0.0', $1,$2); $masklen = 16 if !defined $masklen; } elsif (/^ (\d+) \.? \z/x) { $_ = sprintf('::ffff:%d.0.0.0', $1); $masklen = 8 if !defined $masklen; } $masklen += 96 if defined $masklen; } else { # looks like an IPv6 network s/^IPv6://i; # discard optional 'IPv6:' prefix } $masklen = 128 if !defined $masklen; $_ .= '/' . $masklen; eval { $pt->add_string($_, $net); 1 } or die "Adding a network $net to a patricia trie failed: $@"; } # ll(5) && $pt->climb(sub { do_log(5,"patricia trie, node $_[0]") }); return $pt; # a Net::Patricia::AF_INET6 object } } 1;