PATCH: allow regular expressions for address matching to be easily overridden

[Jared Johnson]

Hi,

I recently asked this list about 'u...@[ip]' syntax and reversed myself 
shortly afterward, realizing that this syntax is RFC-valid and, as 
another list member pointed out, necessary for backward compatibility. 
However, after finding that most of our clients' MTA's were 
(incorrectly) rejecting these messages, we decided to modify our copy of 
Qpsmtpd to reject the syntax as well.  Now I would like to revert this 
fork.  I've attached a patch to allow easy overriding of the various 
expressions used to parse addresses in Qpsmtpd::Address::canonify(). 
This makes it so that one can do, for instance:

$Qpsmtpd::Address::domain_expr = 
'(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?)(?:.(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?))*';

from hook_pre_connection in order to override the $domain regular 
expression that was previously local to canonify() and prevent [IP] 
syntax from being accepted.  I actually special-cased $domain_expr and 
$address_literal so that:

undef $Qpsmtpd::Address::address_literal;

could act as a bit of a shortcut to the exact same override.  Changing 
$domain alone would have been enough, but it seemed appropriate to lend 
the same flexibility to the rest of the regexp's used in canonify()

Hope this is useful!

-Jared
Index: lib/Qpsmtpd/Address.pm
===================================================================
--- lib/Qpsmtpd/Address.pm	(revision 961)
+++ lib/Qpsmtpd/Address.pm	(working copy)
@@ -178,21 +178,24 @@
 
 =cut
 
+our $atom_expr = '[a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~]+';
+our $address_literal_expr = 
+  '(?:\[(?:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}|IPv6:[0-9A-Fa-f:.]+)\])';
+our $subdomain_expr = '(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?)';
+our $domain_expr;
+our $qtext_expr = '[\x01-\x08\x0B\x0C\x0E-\x1F\x21\x23-\x5B\x5D-\x7F]';
+our $text_expr = '[\x01-\x09\x0B\x0C\x0E-\x7F]';
+
 sub canonify {
     my ($dummy, $path) = @_;
-    my $atom = '[a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~]+';
-    my $address_literal = 
-'(?:\[(?:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}|IPv6:[0-9A-Fa-f:.]+)\])';
-    my $subdomain = '(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?)';
-    my $domain = "(?:$address_literal|$subdomain(?:\.$subdomain)*)";
-    my $qtext = '[\x01-\x08\x0B\x0C\x0E-\x1F\x21\x23-\x5B\x5D-\x7F]';
-    my $text = '[\x01-\x09\x0B\x0C\x0E-\x7F]';
 
 
     # strip delimiters
     return undef unless ($path =~ /^<(.*)>$/);
     $path = $1;
 
+    my $domain = $domain_expr ? $domain_expr : "$subdomain_expr(?:\.$subdomain_expr)*";
+    $domain = "(?:$address_literal_expr|$domain)" if !$domain_expr and $address_literal_expr;
     # strip source route
     $path =~ s/^...@$domain(?:,\...@$domain)*://;
 
@@ -202,16 +205,16 @@
     # bare postmaster is permissible, perl RFC-2821 (4.5.1)
     return ("postmaster", undef) if $path eq "postmaster";
     
-    my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
+    my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain_expr)$/);
     return (undef) unless defined $localpart;
 
-    if ($localpart =~ /^$atom(\.$atom)*/) {
+    if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) {
         # simple case, we are done
         return ($localpart, $domainpart);
       }
-    if ($localpart =~ /^"(($qtext|\\$text)*)"$/) {
+    if ($localpart =~ /^"(($qtext_expr|\\$text_expr)*)"$/) {
         $localpart = $1;
-        $localpart =~ s/\\($text)/$1/g;
+        $localpart =~ s/\\($text_expr)/$1/g;
         return ($localpart, $domainpart);
       }
     return (undef);