notmuch-mutt: support for messages that lack Message-ID headers

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 accumulate header lines,
parse them to check for Message-ID, and fallback to SHA1 computation
if it is not present.

Thanks to:
- Jan N. Klug for preliminary versions of this patch
- Tomi Ollila for suggesting an elegant implementation
This commit is contained in:
Stefano Zacchiroli 2015-02-15 13:39:08 +01:00 committed by David Bremner
parent 02b554c896
commit 1722ea2c95
2 changed files with 28 additions and 6 deletions

View file

@ -33,9 +33,11 @@ Requirements
To *run* notmuch-mutt you will need Perl with the following libraries: 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> - Mail::Box <https://metacpan.org/pod/Mail::Box>
(Debian package: libmail-box-perl) (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) (Debian package: libmailtools-perl)
- String::ShellQuote <https://metacpan.org/pod/String::ShellQuote> - String::ShellQuote <https://metacpan.org/pod/String::ShellQuote>
(Debian package: libstring-shellquote-perl) (Debian package: libstring-shellquote-perl)

View file

@ -13,11 +13,12 @@ use warnings;
use File::Path; use File::Path;
use Getopt::Long qw(:config no_getopt_compat); use Getopt::Long qw(:config no_getopt_compat);
use Mail::Internet; use Mail::Header;
use Mail::Box::Maildir; use Mail::Box::Maildir;
use Pod::Usage; use Pod::Usage;
use String::ShellQuote; use String::ShellQuote;
use Term::ReadLine; use Term::ReadLine;
use Digest::SHA;
my $xdg_cache_dir = "$ENV{HOME}/.cache"; my $xdg_cache_dir = "$ENV{HOME}/.cache";
@ -75,10 +76,29 @@ sub prompt($$) {
} }
sub get_message_id() { sub get_message_id() {
my $mail = Mail::Internet->new(\*STDIN); my $mid = undef;
my $mid = $mail->head->get("message-id") or return undef; my @headers = ();
$mid =~ /^<(.*)>$/; # get message-id value
return $1; while (<STDIN>) { # collect header lines in @headers
push(@headers, $_);
last if $_ =~ /^$/;
}
my $head = Mail::Header->new(\@headers);
$mid = $head->get("message-id") or undef;
if ($mid) { # Message-ID header found
$mid =~ /^<(.*)>$/; # extract message id
$mid = $1;
} else { # Message-ID header not found, synthesize a message id
# based on SHA1, as notmuch would do. See:
# http://git.notmuchmail.org/git/notmuch/blob/HEAD:/lib/sha1.c
my $sha = Digest::SHA->new(1);
$sha->add($_) foreach(@headers);
$sha->addfile(\*STDIN);
$mid = 'notmuch-sha1-' . $sha->hexdigest;
}
return $mid;
} }
sub search_action($$$@) { sub search_action($$$@) {