perl/genTLD.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 require Mail::SpamAssassin::Util::RegistrarBoundaries;
   6
   7 # import data from RegistrarBoundaries
   8 my @VALID_TLD = keys( %Mail::SpamAssassin::Util::RegistrarBoundaries::VALID_TLDS );
   9 my @TWO_LEVEL_DOMAINS = keys( %Mail::SpamAssassin::Util::RegistrarBoundaries::TWO_LEVEL_DOMAINS );
  10 my @US_STATES = keys( %Mail::SpamAssassin::Util::RegistrarBoundaries::US_STATES );
  11
  12 # assemble the array of possiblities
  13 my $state_regex = '.(?:' . join( '|', @US_STATES ) . ')';
  14 my @all_domains = ( 'demon.co.uk',
  15                     'esc.edu.ar',
  16                     # .us domains are a pain ...
  17                     '(?:c[oi].)?[^.]' . $state_regex . '.us',
  18                     '[^.].(?:(?:pvt.)?k12|cc|tec|lib|state|gen)' . $state_regex . '.us',
  19                     '[^.].' . join( '|', @US_STATES ) . 'us' );
  20 push( @all_domains, @VALID_TLD, @TWO_LEVEL_DOMAINS );
  21 # Escape '.' a lot. Remember that we have to escape \ because it's in a JS string
  22 # So, '.' becomes '\\.'
  23 foreach( @all_domains ) {
  24     $_ =~ s/\./\\\\\./g;
  25 }
  26
  27 print( '"\\.(?:'. join( '|', @all_domains ) . ')"' . "\n" )