contrib/sendmail/contrib/cidrexpand

   1 #!/usr/bin/perl -w
   2 #
   3 # usage:
   4 #  cidrexpand < /etc/mail/access | makemap -r hash /etc/mail/access
   5 #
   6 # v 0.4
   7 #
   8 # 17 July 2000 Derek J. Balling (dredd@megacity.org)
   9 #
  10 # Acts as a preparser on /etc/mail/access_db to allow you to use address/bit
  11 # notation.
  12 #
  13 # If you have two overlapping CIDR blocks with conflicting actions
  14 # e.g.   10.2.3.128/25 REJECT and 10.2.3.143 ACCEPT
  15 # make sure that the exceptions to the more general block are specified
  16 # later in the access_db.
  17 #
  18 # the -r flag to makemap will make it "do the right thing"
  19 #
  20 # Modifications
  21 # -------------
  22 # 26 Jul 2001 Derek Balling (dredd@megacity.org)
  23 #     Now uses Net::CIDR because it makes life a lot easier.
  24 #
  25 #  5 Nov 2002 Richard Rognlie (richard@sendmail.com)
  26 #     Added code to deal with the prefix tags that may now be included in
  27 #     the access_db
  28 #
  29 #     Added clarification in the notes for what to do if you have
  30 #     exceptions to a larger CIDR block.
  31 #
  32 #  26 Jul 2006 Richard Rognlie (richard@sendmail.com)
  33 #     Added code to strip "comments" (anything after a non-escaped #)
  34 #     # characters after a \ or within quotes (single and double) are
  35 #     left intact.
  36 #
  37 #     e.g.
  38 #       From:1.2.3.4    550 Die spammer # spammed us 2006.07.26
  39 #     becomes
  40 #       From:1.2.3.4    550 Die spammer
  41 #
  42 #  3 August 2006
  43 #     Corrected a bug to have it handle the special case of "0.0.0.0/0"
  44 #     since Net::CIDR doesn't handle it properly.
  45 #
  46 #  27 April 2016
  47 #     Corrected IPv6 handling.  Note that UseCompressedIPv6Addresses must
  48 #     be turned off for this to work; there are three reasons for this:
  49 #       1) if the MTA uses compressed IPv6 addresses then CIDR 'cuts'
  50 #          in the compressed range *cannot* be matched, as the MTA simply
  51 #          won't look for them.  E.g., there's no way to accurately
  52 #          match "IPv6:fe80::/64" when for the address "IPv6:fe80::54ad"
  53 #          the MTA doesn't lookup up "IPv6:fe80:0:0:0"
  54 #       2) cidrexpand only generates uncompressed addresses, so CIDR
  55 #          'cuts' to the right of the compressed range won't be matched
  56 #          either.  Why doesn't it generate compressed address output?
  57 #          Oh, because:
  58 #       3) compressed addresses are ambiguous when colon-groups are
  59 #          chopped off!  You want an access map entry for
  60 #               IPv6:fe80::0:5420
  61 #          but not for
  62 #               IPv6:fe80::5420:1234
  63 #          ?  Sorry, the former is really
  64 #               IPv6:fe80::5420
  65 #          which will also match the latter!
  66 #
  67 #  25 July 2016
  68 #     Since cidrexpand already requires UseCompressedIPv6Addresses to be
  69 #     turned off, it can also canonicalize non-CIDR IPv6 addresses to the
  70 #     format that sendmail looks up, expanding compressed addresses and
  71 #     trimming superfluous leading zeros.
  72 #
  73 # Report bugs to: <dredd@megacity.org>
  74 #
  75
  76
  77 use strict;
  78 use Net::CIDR qw(cidr2octets cidrvalidate);
  79 use Getopt::Std;
  80
  81 sub print_expanded_v4network;
  82 sub print_expanded_v6network;
  83
  84 our %opts;
  85 getopts('ct:', \%opts);
  86
  87 # Delimiter between the key and value
  88 my $space_re = exists $opts{t} ? $opts{t} : '\s+';
  89
  90 # Regexp that matches IPv4 address literals
  91 my $ipv4_re = qr"(?:\d+\.){3}\d+";
  92
  93 # Regexp that matches IPv6 address literals, plus a lot more.
  94 # Further checks are required for verifying that it's really one
  95 my $ipv6_re = qr"[0-9A-Fa-f:]{2,39}(?:\.\d+\.\d+\.\d+)?";
  96
  97 while (<>)
  98 {
  99     chomp;
 100     my ($prefix, $network, $len, $right);
 101
 102     if ( (/\#/) && $opts{c} )
 103     {
 104         # print "checking...\n";
 105         my $i;
 106         my $qtype='';
 107         for ($i=0 ; $i<length($_) ; $i++)
 108         {
 109             my $ch = substr($_,$i,1);
 110             if ($ch eq '\\')
 111             {
 112                 $i++;
 113                 next;
 114             }
 115             elsif ($qtype eq '' && $ch eq '#')
 116             {
 117                 substr($_,$i) = '';
 118                 last;
 119             }
 120             elsif ($qtype ne '' && $ch eq $qtype)
 121             {
 122                 $qtype = '';
 123             }
 124             elsif ($qtype eq '' && $ch =~ /[\'\"]/)
 125             {
 126                 $qtype = $ch;
 127             }
 128         }
 129     }
 130
 131     if (($prefix, $network, $len, $right) =
 132             m!^(|\S+:)(${ipv4_re})/(\d+)(${space_re}.*)$!)
 133     {
 134         print_expanded_v4network($network, $len, $prefix, $right);
 135     }
 136     elsif ((($prefix, $network, $len, $right) =
 137             m!^((?:\S+:)?[Ii][Pp][Vv]6:)(${ipv6_re})(?:/(\d+))?(${space_re}.*)$!) &&
 138             (!defined($len) || $len <= 128) &&
 139             defined(cidrvalidate($network)))
 140     {
 141         print_expanded_v6network($network, $len // 128, $prefix, $right);
 142     }
 143     else
 144     {
 145         print "$_\n";
 146     }
 147 }
 148
 149 sub print_expanded_v4network
 150 {
 151     my ($network, $len, $prefix, $suffix) = @_;
 152
 153     # cidr2octets() doesn't handle a prefix-length of zero, so do
 154     # that ourselves
 155     foreach my $nl ($len == 0 ? (0..255) : cidr2octets("$network/$len"))
 156     {
 157         print "$prefix$nl$suffix\n";
 158     }
 159 }
 160
 161 sub print_expanded_v6network
 162 {
 163     my ($network, $len, $prefix, $suffix) = @_;
 164
 165     # cidr2octets() doesn't handle a prefix-length of zero, so do
 166     # that ourselves.  Easiest is to just recurse on bottom and top
 167     # halves with a length of 1
 168     if ($len == 0) {
 169         print_expanded_v6network("::", 1, $prefix, $suffix);
 170         print_expanded_v6network("8000::", 1, $prefix, $suffix);
 171     }
 172     else
 173     {
 174         foreach my $nl (cidr2octets("$network/$len"))
 175         {
 176             # trim leading zeros from each group
 177             $nl =~ s/(^|:)0+(?=[^:])/$1/g;
 178             print "$prefix$nl$suffix\n";
 179         }
 180     }
 181 }