diff options
Diffstat (limited to 'notmuch-slurp-debbug')
-rwxr-xr-x | notmuch-slurp-debbug | 98 |
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"; |