diff options
-rw-r--r-- | Changelog | 8 | ||||
-rwxr-xr-x | interimap | 3 | ||||
-rwxr-xr-x | pullimap | 23 |
3 files changed, 21 insertions, 13 deletions
@@ -1,3 +1,11 @@ +interimap (0.4) UNRELEASED + + * pullimap: replace non RFC 5321-compliant envelope sender addresses + (received by the IMAP FETCH ENVELOPE command) by the null sender address + <>. + + -- Guilhem Moulin <guilhem@guilhem.org> Tue, 06 Dec 2016 17:37:01 +0100 + interimap (0.3) upstream; + New script 'pullimap', to pull mails from an IMAP mailbox and @@ -577,7 +577,8 @@ sub download_missing($$$@) { my $uid = $mail->{UID}; my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; - $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; + $from = (defined $from and defined $from->[0]->[2] and defined $from->[0]->[3]) + ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; msg(undef, "$source($mailbox): UID $uid from <$from> ($mail->{INTERNALDATE})") unless $CONFIG{quiet}; callback_new_message($idx, $mailbox, $source, $mail, \@uids, $buff, \$bufflen) @@ -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); |