[PATCH 2/2] notmuch-mutt: support for messages that lack Message-ID headers

Stefano Zacchiroli zack at upsilon.cc
Mon Feb 9 01:41:30 PST 2015


From: "Jan N. Klug" <jan.n.klug at rub.de>

For those messages, compute a synthetic Message-ID based on the SHA1
of the whole message, in the same way that notmuch would do. See:
http://git.notmuchmail.org/git/notmuch/blob/HEAD:/lib/sha1.c

To do the above, rewrite get_message_id() to scan the current message
line by line, incrementally computing a SHA1. If a Message-ID is found
the SHA1 computation will be aborted; otherwise used for the synthetic
Message-ID.

Signed-off-by: Stefano Zacchiroli <zack at upsilon.cc>
---
 contrib/notmuch-mutt/README       |  4 +++-
 contrib/notmuch-mutt/notmuch-mutt | 33 ++++++++++++++++++++++++++++-----
 2 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/contrib/notmuch-mutt/README b/contrib/notmuch-mutt/README
index c661447..9c3379e 100644
--- a/contrib/notmuch-mutt/README
+++ b/contrib/notmuch-mutt/README
@@ -33,9 +33,11 @@ Requirements
 
 To *run* notmuch-mutt you will need Perl with the following libraries:
 
+- Digest::SHA <https://metacpan.org/release/Digest-SHA>
+  (Debian package: libdigest-sha-perl)
 - Mail::Box <https://metacpan.org/pod/Mail::Box>
   (Debian package: libmail-box-perl)
-- Mail::Internet <https://metacpan.org/pod/Mail::Internet>
+- Mail::Header <https://metacpan.org/pod/Mail::Header>
   (Debian package: libmailtools-perl)
 - String::ShellQuote <https://metacpan.org/pod/String::ShellQuote>
   (Debian package: libstring-shellquote-perl)
diff --git a/contrib/notmuch-mutt/notmuch-mutt b/contrib/notmuch-mutt/notmuch-mutt
index 4969e4b..84af140 100755
--- a/contrib/notmuch-mutt/notmuch-mutt
+++ b/contrib/notmuch-mutt/notmuch-mutt
@@ -13,11 +13,12 @@ use warnings;
 
 use File::Path;
 use Getopt::Long qw(:config no_getopt_compat);
-use Mail::Internet;
+use Mail::Header;
 use Mail::Box::Maildir;
 use Pod::Usage;
 use String::ShellQuote;
 use Term::ReadLine;
+use Digest::SHA;
 
 
 my $xdg_cache_dir = "$ENV{HOME}/.cache";
@@ -75,10 +76,32 @@ sub prompt($$) {
 }
 
 sub get_message_id() {
-    my $mail = Mail::Internet->new(\*STDIN);
-    my $mid = $mail->head->get("message-id") or return undef;
-    $mid =~ /^<(.*)>$/;	# get message-id value
-    return $1;
+    my $mid = undef;
+    my $in_header = 1;
+    my @raw_header = ();
+    my $sha = Digest::SHA->new(1);  # SHA1 hash of the whole mail
+
+    while (<STDIN>) {  # compute SHA1 as we go
+	push(@raw_header, $_) if $in_header;  # cache header lines
+        if ($_ =~ /^$/) {  # end of header, parse it and look for Message-ID
+	    $in_header = 0;
+	    my $head = Mail::Header->new(\@raw_header);
+	    $mid = $head->get("message-id") or undef;
+	    if ($mid) {
+		$mid =~ /^<(.*)>$/;  # get message-id value
+		$mid = $1;
+		last;  # stop hashing
+	    }
+        }
+	$sha->add($_);  # update hash
+    }
+
+    # If no message-id was found, generate one-id in the same way that
+    # notmuch would do.
+    # See: http://git.notmuchmail.org/git/notmuch/blob/HEAD:/lib/sha1.c
+    $mid ||= "notmuch-sha1-".$sha->hexdigest;
+
+    return $mid;
 }
 
 sub search_action($$$@) {
-- 
2.1.4



More information about the notmuch mailing list