aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2016-12-06 16:40:40 +0100
committerGuilhem Moulin <guilhem@fripost.org>2016-12-06 17:46:57 +0100
commitcd2d2df77b5a58043217eed15841c216002b65a2 (patch)
tree84af7ffffad8cdd795fed6c16a6d1ae619018159
parentd5b28183b91b0931db1d185ea04cbeae4a70a677 (diff)
pullimap: replace non RFC 5321-compliant envelope sender addresses by <>.
-rw-r--r--Changelog8
-rwxr-xr-xinterimap3
-rwxr-xr-xpullimap23
3 files changed, 21 insertions, 13 deletions
diff --git a/Changelog b/Changelog
index f9ca699..755c8cb 100644
--- a/Changelog
+++ b/Changelog
@@ -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
diff --git a/interimap b/interimap
index 7a36c4e..049b564 100755
--- a/interimap
+++ b/interimap
@@ -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)
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);