pullimap: replace non RFC 5321-compliant envelope sender addresses by <>.

1 files changed, 11 insertions, 12 deletions

diff --git a/pullimap b/pullimap
index d176464..dca8c49 100755
--- a/pullimap
+++ b/pullimap
@@ -269,27 +269,26 @@ sub purge() {
 my $ATTRS = "ENVELOPE INTERNALDATE";
 $ATTRS .= " BODY.PEEK[]" unless $CONFIG{'no-delivery'};
 
-my $RE_ATOM = qr/[A-Za-z0-9\x21\x23-\x27\x2A\x2B\x2D\x2F\x3D\x3F\x5E-\x60\x7B-\x7E]+/;
+my $RE_ATOM = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2F-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]+/;
 sub pull_callback($$) {
     my ($uids, $mail) = @_;
     return unless exists $mail->{RFC822} or $CONFIG{'no-delivery'}; # not for us
 
     my $uid = $mail->{UID};
-    my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
-    if (defined $from and @$from) {
-        my ($l, $d) = @{$from->[0]}[2,3];
-        unless ($l =~ /\A$RE_ATOM(?:\.$RE_ATOM)*\z/o) { # quote the local part if not Dot-string (RFC 5321)
+    my $e = $mail->{ENVELOPE}->[3];
+    my $sender = '';
+    if (defined $e and defined (my $l = $e->[0]->[2]) and defined (my $d = $e->[0]->[3])) {
+        if ($l =~ /\A$RE_ATOM(?:\.$RE_ATOM)*\z/o) {
+            $sender = $l.'@'.$d;
+        } elsif ($l =~ /\A[\x20-\x7E]*\z/) {
+            # quote the local part if not Dot-string (RFC 5321)
             $l =~ s/([\x22\x5C])/\\$1/g; # escape double-quote and backslash
-            $l = '"' .$l. '"';
+            $sender = '"'.$l.'"@'.$d;
         }
-        $from = $l .'@'. $d;
-        $IMAP->fail("Invalid character in MAIL FROM: <$from>") unless $l =~ /\A[\x20-\x7E]*\z/;
-    } else {
-        $from = '';
     }
-    $IMAP->log("UID $uid from <$from> ($mail->{INTERNALDATE})") unless $CONFIG{quiet};
+    $IMAP->log("UID $uid from <$sender> ($mail->{INTERNALDATE})") unless $CONFIG{quiet};
 
-    sendmail($from, $mail->{RFC822}) unless $CONFIG{'no-delivery'};
+    sendmail($sender, $mail->{RFC822}) unless $CONFIG{'no-delivery'};
 
     push @$uids, $uid;
     writeUID($uid);