1 files changed, 98 insertions, 0 deletions
diff --git a/notmuch-slurp-debbug b/notmuch-slurp-debbug
new file mode 100755
index 0000000..226a095
--- /dev/null
+++ b/notmuch-slurp-debbug
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+
+# notmuch-slurp-debbug -- add messages from a Debian bug to notmuch
+
+# Copyright (C) 2018 Sean Whitton
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+use Config::Tiny;
+use File::Spec::Functions 'catfile';
+use File::Which;
+use File::Temp;
+use Getopt::Long;
+use MIME::Head;
+
+my $Config = Config::Tiny->new;
+
+my $bts_server = undef;
+GetOptions('bts-server=s' => \$bts_server);
+die "notmuch-slurp-debbug: usage: notmuch-slurp-debbug [--bts-server=SERVER] BUG"
+  if (scalar @ARGV != 1);
+
+die "notmuch-slurp-debbug: this script requires notmuch to be installed"
+  unless defined which "notmuch";
+die "notmuch-slurp-debbug: this script requires the 'devscripts' apt package"
+  unless defined which "bts";
+
+my $maildir;
+my $bug = pop @ARGV;
+
+my $mailscripts_conf_dir = defined $ENV{'XDG_CONFIG_HOME'}
+  ? catfile $ENV{'XDG_CONFIG_HOME'}, "/mailscripts"
+  : catfile $ENV{'HOME'}, "/.config/mailscripts";
+
+my $notmuch_slurp_debbug_conf = "$mailscripts_conf_dir/notmuch-slurp-debbug";
+if (-f $notmuch_slurp_debbug_conf) {
+    $Config = Config::Tiny->read($notmuch_slurp_debbug_conf);
+    $maildir = $Config->{_}->{maildir};
+} else {
+    # default to where a lot of people have their inbox
+    my $database_path = `notmuch config get database.path`;
+    chomp $database_path;
+    $maildir = catfile $database_path, "inbox";
+}
+
+die "notmuch-slurp-debbug: $maildir does not look to be a maildir"
+  unless (-d catfile($maildir, "cur")
+          && -d catfile($maildir, "new")
+          && -d catfile($maildir, "tmp"));
+
+my $bts_server_arg = defined $bts_server
+  ? "--bts-server $bts_server"
+  : "";
+
+# see #904182 (try using this script ;))
+system("bts $bts_server_arg --mbox --mailreader 'true %s' show $bug") == 0
+  or die "notmuch-slurp-debbug: bts failed";
+
+my $dir = File::Temp->newdir();
+mkdir catfile($dir, "cur");
+mkdir catfile($dir, "new");
+mkdir catfile($dir, "tmp");
+
+my $devscripts_cache = defined $ENV{'XDG_CACHE_HOME'}
+  ? catfile $ENV{'XDG_CACHE_HOME'}, "devscripts", "bts"
+  : catfile $ENV{'HOME'}, ".cache", "devscripts", "bts";
+
+my $mbox = catfile $devscripts_cache, "$bug.mbox";
+
+# note that mb2md won't work; it thinks Debian BTS mboxes contain just
+# a single message
+system("mbox2maildir $mbox $dir") == 0
+  or die "notmuch-slurp-debbug: mbox2maildir failed";
+
+foreach my $message (glob "$dir/*/*") {
+    my $message_head = MIME::Head->from_file($message);
+    my $mid = $message_head->get('Message-ID');
+    $mid =~ s/(<|>)//g;
+    my $match = `notmuch search id:$mid`;
+    my $match_lines = $match =~ tr/\n//;
+    system "mdmv $message $maildir" if ($match_lines == 0);
+}
+
+system "notmuch new";