From cadc010b147760a227d9cfcf18b68dc85e55824a Mon Sep 17 00:00:00 2001
From: Rik <rik@iwg.nl>
Date: Fri, 12 May 2017 11:35:56 +0200
Subject: [PATCH] Allow blacklisting and whitelisting an entire TLD

New TLD's emerge continuously and are being abused for spam.
This patch enables a user to blacklist or whitelist an entire TLD, for instance *.info
---
 MailScanner_perl_scripts/SQLBlackWhiteList.pm | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/MailScanner_perl_scripts/SQLBlackWhiteList.pm b/MailScanner_perl_scripts/SQLBlackWhiteList.pm
index 92b46f89d..51952bf1a 100644
--- a/MailScanner_perl_scripts/SQLBlackWhiteList.pm
+++ b/MailScanner_perl_scripts/SQLBlackWhiteList.pm
@@ -206,12 +206,11 @@ sub LookupList {
     my ($from, $fromdomain, @todomain, $todomain, @to, $to, $ip, $ip1, $ip1c, $ip2, $ip2c, $ip3, $ip3c, $subdom, $i, @keys, @subdomains);
     $from = $message->{from};
     $fromdomain = $message->{fromdomain};
-    # Create a array of subdomains for subdomain wildcard matching
-    #   e.g. me@this.that.example.com generates subdomain list of ('that.example.com', 'example.com')
-    #   wildcards of *.com, *.uk, *.gov, etc will never be matched for safety's sake (though *.gov.uk could be)
+    # Create a array of subdomains for subdomain and tld wildcard matching
+    #   e.g. me@this.that.example.com generates subdomain/tld list of ('that.example.com', 'example.com', 'com')
     $subdom = $fromdomain;
     @subdomains = ();
-    while ($subdom =~ /.*?\.(.*\..*)/) {
+    while ($subdom =~ /.*?\.(.*)/) {
         $subdom = $1;
         push (@subdomains, "*.".$subdom);
     }