summaryrefslogtreecommitdiff
path: root/notmuch-slurp-debbug
blob: ff5a54f720371f6807ebe23a420615bfd58efb09 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#!/usr/bin/perl

# notmuch-slurp-debbug -- add messages from a Debian bug to notmuch

# Copyright (C) 2018-2019 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 <https://www.gnu.org/licenses/>.

use strict;
use warnings;

use Config::Tiny;
use File::Spec::Functions qw(catfile);
use File::Which;
use File::Temp;
use Getopt::Long;
use IPC::System::Simple qw(systemx capturex);
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_args = defined $bts_server
  ? ("--bts-server", $bts_server)
  : undef;

# see #904182 for why we have to do it like this
my @bts_args = grep defined, @bts_server_args,
  qw(--mbox --mailreader), "true %s", "show", $bug;
systemx("bts", @bts_args);

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
systemx("mbox2maildir", $mbox, $dir);

foreach my $message (glob "$dir/*/*") {
    my $message_head = MIME::Head->from_file($message);
    my $mid = $message_head->get('Message-ID');
    # if this message does not have a message-id, do not import it;
    # that is asking for trouble
    next unless defined $mid;
    $mid =~ s/(<|>)//g;
    my $match = capturex(qw(notmuch search), "id:$mid");
    my $match_lines = $match =~ tr/\n//;
    systemx("mdmv", $message, $maildir) if ($match_lines == 0);
}

systemx(qw(notmuch new));