summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile5
-rw-r--r--README51
-rw-r--r--debian/changelog87
-rw-r--r--debian/control27
-rw-r--r--debian/copyright3
-rw-r--r--debian/elpa-mailscripts.docs1
-rw-r--r--debian/mailscripts.docs1
-rw-r--r--debian/mailscripts.install3
-rw-r--r--debian/mailscripts.manpages3
-rwxr-xr-xgmi2email346
-rw-r--r--gmi2email.1.pod130
-rw-r--r--mailscripts.el388
-rwxr-xr-xmdmv2
-rw-r--r--notmuch-extract-patch.1.pod2
-rwxr-xr-xnotmuch-slurp-debbug6
-rwxr-xr-xsendmail-reinject73
-rw-r--r--sendmail-reinject.1.pod45
17 files changed, 1110 insertions, 63 deletions
diff --git a/Makefile b/Makefile
index e2ae233..2450249 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,8 @@ MANPAGES=mdmv.1 mbox2maildir.1 \
imap-dl.1 \
email-extract-openpgp-certs.1 \
email-print-mime-structure.1 \
- notmuch-import-patch.1
+ notmuch-import-patch.1 \
+ gmi2email.1
COMPLETIONS=completions/bash/email-print-mime-structure completions/bash/imap-dl
all: $(MANPAGES) $(COMPLETIONS)
@@ -26,5 +27,5 @@ clean:
completions/bash/%:
mkdir -p completions/bash
- register-python-argcomplete3 $(notdir $@) >$@.tmp
+ register-python-argcomplete $(notdir $@) >$@.tmp
mv $@.tmp $@
diff --git a/README b/README
new file mode 100644
index 0000000..d9ecdab
--- /dev/null
+++ b/README
@@ -0,0 +1,51 @@
+mailscripts -- collection of scripts for manipulating e-mail on Unixes
+======================================================================
+
+This package is a place to collect together, and distribute, small scripts for
+manipulating e-mail on Unixes. The idea is that those of us handling our
+e-mail using tools like offlineimap, mbsync, notmuch, mu, mairix etc. often
+end up writing small helper scripts, and some of the scripts are worth tidying
+up, documenting and sharing with others, but they're small enough not to
+deserve packages of their own. This is a place for them.
+
+mailscripts is primarily developed as part of the Debian project. In July
+2018 some notmuch-using Debian Developers arrived at the DebCamp preceding
+DebConf18, and started discussing useful mail-handling scripts, actual and
+envisioned. We decided it would be a good idea to create a package like this.
+If you have written a useful mail-handling script, please consider submitting
+it to this collection.
+
+Some highlights:
+
+* mdmv -- safely move messages between maildirs
+
+* mbox2maildir -- convert an mbox to a maildir using Python's libraries
+
+* notmuch-extract-patch -- extract a git patch series from notmuch
+
+* email-print-mime-structure -- tree view of a message's MIME structure
+
+* imap-dl -- download messages from an IMAP mailbox to a maildir
+
+mailscripts.el -- Emacs utilities for handling mail on Unixes
+=============================================================
+
+mailscripts.el is an Emacs Lisp library. It's original purpose was to make it
+easy to use scripts shipped in Debian's mailscripts package from within Emacs.
+It now also contains additional, thematically-related utilities which don't
+invoke any of those scripts.
+
+Some highlights:
+
+* notmuch-extract-{thread,message}-patches{,-to-project}
+ -- extract & apply git patch(es) from Gnus+notmuch or notmuch-show
+
+* mailscripts-git-format-patch-drafts
+ -- import patches generated by git-format-patch(1) to Gnus or notmuch drafts
+
+* mailscripts-git-format-patch-attach
+ -- compose mail with patches generated by git-format-patch(1) attached
+ (Git-specific alternative to the built-in vc-prepare-patches)
+
+* mailscripts-git-format-patch-append
+ -- append an inline "-- >8 --" patch to an unsent message
diff --git a/debian/changelog b/debian/changelog
index 050458b..5fac014 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,87 @@
-mailscripts (0.22-1) UNRELEASED; urgency=medium
+mailscripts (28-1) unstable; urgency=medium
+
+ * mailscripts.el:
+ - new commands: mailscripts-git-format-patch-{attach,drafts,append}
+ - new DWIM wrapper command: mailscripts-prepare-patch
+
+ - notmuch-extract-{thread,message}-patches: add Gnus support
+ notmuch-extract-message-patches{,-to-project} are now aliases for
+ mailscripts-extract-message-patches{,-to-project}.
+ - if mailscripts-extract-message-patches identifies no attachments,
+ it now offers to pipe the whole message to 'git am'
+
+ - don't offer to detach a HEAD that's already detached
+ - rewrite short description and add a brief commentary
+ - load the notmuch library only when code that requires it is called
+ - move the mailscripts customisation group into the mail group
+ - add declarations to fix byte compilation warnings
+ - fix usage of cl-case in an internal function.
+ * debian/control: update Description: for elpa-mailscripts.
+ Use the new short description and commentary from mailscripts.el.
+ * Add & install a README, to both binary packages.
+ * Tighten build-dep on python3-pgpy to require >= 0.5.4-4.1.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sat, 24 Dec 2022 12:09:07 -0700
+
+mailscripts (27-1) unstable; urgency=medium
+
+ * Update Makefile register-python-argcomplete3 -> register-python-argcomplete
+ (Closes: #1013622).
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Fri, 24 Jun 2022 14:51:22 -0700
+
+mailscripts (26-1) unstable; urgency=medium
+
+ * New script: sendmail-reinject (Closes: #1009617)
+ - add default-mta | mail-transport-agent, python3-notmuch to Suggests
+ - add Jameson Graef Rollins to d/copyright
+ - add an entry to the package description.
+ Thanks to Jameson Graef Rollins for the new script.
+ * Run wrap-and-sort -abst.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Mon, 16 May 2022 17:01:00 -0700
+
+mailscripts (25-1) unstable; urgency=medium
+
+ * notmuch-slurp-debbug:
+ - Exit immediately if Mail::Box::Manager::open fails.
+ - Support tilde expansion in 'maildir' configuration key.
+ * mdmv: ensure destination path ends with ':2,' when message has no flags.
+ Previously we were writing some messages with no flags into cur/
+ directories without this suffix, which is invalid (see maildir(5)).
+ * mailscripts.el: change mailscripts-project-library default to `project'.
+ Now that Emacs 28.1 is out, the latest stable release of Emacs
+ contains a more fully-featured version of project.el, so change the
+ default as we said we would.
+ * Drop the '0.' prefix to mailscripts version numbers.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Mon, 04 Apr 2022 18:07:45 -0700
+
+mailscripts (0.24-1) unstable; urgency=medium
+
+ * mailscripts.el:
+ - Enable lexical binding.
+ - notmuch-slurp-debbug: at end, call notmuch-search not notmuch-show.
+ This should avoid leaving the user viewing a thread containing only
+ control messages, with no easy way to get to the bug correspondence.
+ - mailscripts-detach-head-from-existing-branch can now have value `ask'.
+ * gmi2email:
+ - Support commenting out subscriptions.
+ - Cope with XML feeds sent with text/gemini MIME type.
+ * notmuch-extract-patch(1): add link to the piem project.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Fri, 07 Jan 2022 14:48:01 -0700
+
+mailscripts (0.23-1) unstable; urgency=medium
+
+ * New script: gmi2email
+ - add libdbd-sqlite3-perl, libio-socket-ssl-perl, libmime-lite-perl,
+ libemail-date-format-perl, libtry-tiny-perl, libmailtools-perl and
+ libxml-feed-perl to Suggests.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Thu, 28 Jan 2021 16:34:40 -0700
+
+mailscripts (0.22-1) unstable; urgency=medium
* mailscripts.el:
- drop hard dependency on Projectile
@@ -8,7 +91,7 @@ mailscripts (0.22-1) UNRELEASED; urgency=medium
projects
- Use 'cl-case' not 'case' and require cl-lib.
- -- Sean Whitton <spwhitton@spwhitton.name> Tue, 21 Jul 2020 21:22:39 -0700
+ -- Sean Whitton <spwhitton@spwhitton.name> Tue, 19 Jan 2021 16:14:45 -0700
mailscripts (0.21-1) unstable; urgency=medium
diff --git a/debian/control b/debian/control
index 3a549a3..a85a1b6 100644
--- a/debian/control
+++ b/debian/control
@@ -16,7 +16,7 @@ Build-Depends:
perl,
python3 <!nocheck>,
python3-argcomplete,
- python3-pgpy <!nocheck>,
+ python3-pgpy (>= 0.5.4-4.1) <!nocheck>,
Vcs-Git: https://git.spwhitton.name/mailscripts
Vcs-Browser: https://git.spwhitton.name/mailscripts
Homepage: https://git.spwhitton.name/mailscripts
@@ -33,9 +33,15 @@ Recommends:
Enhances:
emacs,
emacs25,
-Description: Emacs functions for accessing tools in the mailscripts package
- This package adds to Emacs functions to access tools in the
- mailscripts package from Emacs.
+Description: Emacs utilities for handling mail on Unixes
+ The original purpose of this package was to make it easy to use the small
+ mail-handling utilities shipped in the 'mailscripts' package from within
+ Emacs. It now also contains some additional, thematically-related utilities
+ which don't invoke any of those scripts.
+ .
+ Entry points you might like to look at if you're new to this package:
+ mailscripts-prepare-patch, notmuch-slurp-debbug,
+ notmuch-extract-{thread,message}-patches{,-to-project}.
Package: mailscripts
Depends:
@@ -60,7 +66,16 @@ Suggests:
gpg,
gpg-agent,
gpgsm,
+ libdbd-sqlite3-perl,
+ libemail-date-format-perl,
+ libio-socket-ssl-perl,
+ libmailtools-perl,
+ libmime-lite-perl,
+ libtry-tiny-perl,
+ libxml-feed-perl,
+ default-mta | mail-transport-agent,
openssl,
+ python3-notmuch,
Architecture: all
Description: collection of scripts for manipulating e-mail on Debian
This package provides a collection of scripts for manipulating e-mail
@@ -85,3 +100,7 @@ Description: collection of scripts for manipulating e-mail on Debian
email-extract-openpgp-certs -- extract OpenPGP certificates from a message
.
imap-dl -- download messages from an IMAP mailbox to a maildir
+ .
+ gmi2email -- subscribe to gemlogs and read individual Gemini pages by e-mail
+ .
+ sendmail-reinject -- reinject an e-mail message via sendmail(1)
diff --git a/debian/copyright b/debian/copyright
index db97f3d..f4fee59 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,9 +1,10 @@
mailscripts
Collection of scripts for manipulating e-mail on Debian
-Copyright (C)2017-2020 Sean Whitton
+Copyright (C)2017-2021 Sean Whitton
Copyright (C)2019-2020 Daniel Kahn Gillmor
Copyright (C)2020 Red Hat, Inc.
+Copyright (C)2022 Jameson Graef Rollins
These programs are free software: you can redistribute it and/or
modify it under the terms of the GNU General Public License as
diff --git a/debian/elpa-mailscripts.docs b/debian/elpa-mailscripts.docs
new file mode 100644
index 0000000..e845566
--- /dev/null
+++ b/debian/elpa-mailscripts.docs
@@ -0,0 +1 @@
+README
diff --git a/debian/mailscripts.docs b/debian/mailscripts.docs
new file mode 100644
index 0000000..e845566
--- /dev/null
+++ b/debian/mailscripts.docs
@@ -0,0 +1 @@
+README
diff --git a/debian/mailscripts.install b/debian/mailscripts.install
index df220b3..f097f49 100644
--- a/debian/mailscripts.install
+++ b/debian/mailscripts.install
@@ -1,10 +1,11 @@
email-extract-openpgp-certs /usr/bin
email-print-mime-structure /usr/bin
+gmi2email /usr/bin
imap-dl /usr/bin
maildir-import-patch /usr/bin
+mbox-extract-patch /usr/bin
mbox2maildir /usr/bin
mdmv /usr/bin
-mbox-extract-patch /usr/bin
notmuch-extract-patch /usr/bin
notmuch-import-patch /usr/bin
notmuch-slurp-debbug /usr/bin
diff --git a/debian/mailscripts.manpages b/debian/mailscripts.manpages
index 345053a..7b5bc43 100644
--- a/debian/mailscripts.manpages
+++ b/debian/mailscripts.manpages
@@ -1,10 +1,11 @@
email-extract-openpgp-certs.1
email-print-mime-structure.1
+gmi2email.1
imap-dl.1
maildir-import-patch.1
+mbox-extract-patch.1
mbox2maildir.1
mdmv.1
-mbox-extract-patch.1
notmuch-extract-patch.1
notmuch-import-patch.1
notmuch-slurp-debbug.1
diff --git a/gmi2email b/gmi2email
new file mode 100755
index 0000000..5dc819c
--- /dev/null
+++ b/gmi2email
@@ -0,0 +1,346 @@
+#!/usr/bin/perl
+
+# gmi2email -- subscribe to gemlogs and read individual Gemini pages by e-mail
+
+# Copyright (C) 2021 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/>.
+
+# TESTING/DEVEL
+#
+# To forget about seen entries of a feed:
+#
+# % perl -MDBI
+# -we'DBI->connect("dbi:SQLite:dbname=$ENV{HOME}/.cache/mailscripts/gmi2email.db",
+# "", "")->do("DELETE FROM seen WHERE uri LIKE \"gemini://example.com/%\"")'
+
+use 5.028;
+use strict;
+use warnings;
+
+use DBI;
+use File::Spec::Functions "catfile";
+use IO::Socket::SSL;
+use MIME::Lite;
+use Config::Tiny;
+use Text::Wrap;
+use Try::Tiny;
+use Getopt::Long;
+use Email::Date::Format "email_date";
+use Time::Local;
+use Mail::Field::AddrList;
+use XML::Feed;
+
+my ($from, $to, $subs, $inline_images, $no_mail);
+GetOptions
+ "from=s" => \$from,
+ "to=s" => \$to,
+ "subscriptions:s" => \$subs,
+ "inline-images!" => \$inline_images,
+ "no-send!" => \$no_mail;
+
+my $conf_r = $ENV{XDG_CONFIG_HOME} || catfile $ENV{HOME}, ".config";
+my $conf_f = catfile $conf_r, "mailscripts", "gmi2email.config";
+-e $conf_f
+ or (defined $to and defined $from)
+ or die
+ "no config file nor sufficient command line options: don't know who to mail";
+my $conf = Config::Tiny->new->read($conf_f);
+$subs ||= catfile $conf_r, "mailscripts", "gmi2email.subscriptions"
+ if defined $subs;
+
+my %to_mail_opts = (
+ from => (
+ $from
+ or $conf->{_}->{from}
+ or die "no From: address set in config or on command line"
+ ),
+ to => (
+ $to
+ or $conf->{_}->{to}
+ or die "no To: address set in config or on command line"
+ ),
+ inline_images => $inline_images // $conf->{_}->{inline_images} // 0
+);
+
+@ARGV or $subs or die "nothing to do\n";
+
+for (@ARGV) {
+ my $data;
+ if (-f) {
+ open my $fh, "<", $_;
+ $data = [<$fh>];
+ } else {
+ my $type;
+ ($type, $data) = gemini_fetch($_, abs_links => 1);
+ $type =~ m{^text/gemini} or die "$_ is not gemtext";
+ }
+ $no_mail or gemtext_to_mail($data, %to_mail_opts)->send;
+}
+
+exit unless $subs;
+-r $subs or die "file $subs not readable";
+open my $subs_fh, "<", $subs;
+
+my $db_r = $ENV{XDG_CACHE_HOME} || catfile $ENV{HOME}, ".cache";
+my $db_d = catfile $db_r, "mailscripts";
+-d $db_d or mkdir $db_d;
+my $db_f = catfile $db_d, "gmi2email.db";
+my $dbh = DBI->connect("dbi:SQLite:dbname=$db_f", "", "");
+$dbh->do("CREATE TABLE IF NOT EXISTS seen (uri TEXT PRIMARY KEY)")
+ or die "failed to initialise database";
+
+foreach my $sub (<$subs_fh>) {
+ chomp $sub;
+ next if $sub =~ /^#/;
+ my ($gemlog, $type, $data, $next);
+ #<<<
+ try {
+ ($type, $data) = gemini_fetch($sub, abs_links => 1);
+ } catch {
+ my ($code) = /"gemini error: ([1-6])/;
+ if ( defined $code and $code == 4
+ or /missing or invalid gemini response/
+ or /failed to establish SSL connection/) {
+ warn "temporary failure retrieving $sub; will try again later:\n $_";
+ $next = 1, return; # try again next run
+ } else {
+ die "while retrieving $sub $_";
+ }
+ };
+ #>>>
+ next if $next;
+ # some XML feeds out there are published using the text/gemini MIME type,
+ # so also look at the file extension
+ if ($type =~ m{^(?:text|application)/(?:(?:atom|rss)\+)?xml}
+ or $sub =~ /\.xml$/) {
+ my $feed;
+ #<<<
+ try {
+ $feed = XML::Feed->parse(\$data);
+ } catch {
+ die "While parsing $sub, XML::Feed exception:\n$_";
+ };
+ #>>>
+ for ($feed->entries) {
+ my $date = $_->issued // $_->modified;
+ $date = $date->epoch if $date;
+
+ my $link;
+ if ($_->link =~ m{^//}) {
+ $link = "gemini:" . $_->link;
+ } elsif ($_->link !~ m{^[a-z]+://}) {
+ $link = "gemini://" . $_->link;
+ } else {
+ $link = $_->link;
+ }
+
+ send_subscribed_gemtext($link, $feed->title, $_->title, $date);
+ }
+ } elsif ($type =~ m{^text/gemini}) {
+ for (@$data) {
+ if (/^#\s*/ and not $gemlog) {
+ $gemlog = $';
+ } elsif (my ($uri, $y, $m, $d, $title)
+ = /^=>\s*(\S+)\s+([0-9]{4})-([0-9]{2})-([0-9]{2})[\s-]*(.*)/) {
+ send_subscribed_gemtext($uri, $gemlog // "unknown gemlog",
+ $title, timelocal 0, 0, 12, $d, $m - 1, $y);
+ }
+ }
+ } else {
+ die "$sub is not gemtext nor an Atom feed, so far as I can tell";
+ }
+}
+
+sub send_subscribed_gemtext {
+ my ($uri, $gemlog, $link_title, $feed_date) = @_;
+ my ($rows)
+ = $dbh->selectrow_array(
+ "SELECT COUNT(*) FROM seen WHERE uri = \"$uri\"");
+ return unless $rows == 0;
+ my $mail = 1;
+ my ($type, $data);
+ #<<<
+ try {
+ ($type, $data) = gemini_fetch($uri, abs_links => 1);
+ } catch {
+ warn "when fetching $uri, $_";
+ my ($code) = /"gemini error: ([1-6])/;
+ if ($code and $code == 4) {
+ return; # try again next run
+ } else {
+ $mail = 0; # don't try this one again
+ }
+ };
+ #>>>
+ if ($type and $type =~ m{^text/gemini}) {
+ gemtext_to_mail(
+ $data, %to_mail_opts,
+ gemlog => $gemlog // "unknown gemlog",
+ link_title => $link_title,
+ date => email_date $feed_date // time
+ )->send
+ if $mail and !$no_mail;
+ } else {
+ warn "$uri is not gemtext";
+ }
+ $dbh->do("INSERT INTO seen VALUES (\"$uri\")");
+}
+
+sub gemini_fetch {
+ my ($uri, %opts) = @_;
+
+ # regexp from Alex Schroeder's moku-pona program
+ my ($scheme, $authority, $path, $query, $fragment)
+ = $uri
+ =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
+ $scheme and $scheme eq "gemini"
+ or die "'$uri' does not use the gemini scheme";
+ $authority or die "'$uri' lacks an authority";
+ my ($host, $port) = split ":", $authority;
+ my $cl = IO::Socket::SSL->new(
+ PeerHost => $host,
+ PeerPort => $port // 1965,
+ SSL_verify_mode => SSL_VERIFY_NONE
+ ) or die "while fetching $uri: failed to establish SSL connection\n";
+ print $cl "$uri\r\n";
+
+ my ($status, $meta) = <$cl> =~ /^([0-9]+) (\V+)/;
+ defined $status and defined $meta
+ or die "while fetching $uri: missing or invalid gemini response\n";
+ if (30 <= $status and $status < 40) {
+ $opts{orig_uri} = $uri unless $opts{redirects};
+ die "too many redirects while fetching $opts{orig_uri}"
+ if $opts{redirects} and $opts{redirects} > 5;
+ $opts{redirects}++;
+ return gemini_fetch($meta, %opts);
+ } elsif ($status < 20 or $status >= 40) {
+ die "while fetching $uri: gemini error: $status $meta";
+ }
+
+ # don't rely only on MIME type server sends us when URI ends in .xml, as
+ # some feeds out there are published with the text/gemini MIME type
+ if ($meta =~ "^text/gemini" and not $uri =~ /\.xml\z/) {
+ my @lines;
+ if ($opts{abs_links}) {
+ my $dir = $path =~ s{[^/]*$}{}r =~ s{^/}{}r;
+ $authority =~ m{/$} or $authority .= "/";
+ while (local $_ = <$cl>) {
+ s/\r?\n\z//;
+ if (m{^=>\s*\./} || m{^=>\s*(?!/)} and not m{^=> [a-z]+://}) {
+ my $link = "$dir$'";
+ # attempt to resolve any use of '..' notation
+ 1 while $link =~ s{/[^/]+/../}{/};
+ push @lines, "=> gemini://$authority$link";
+ } elsif (m{^=>\s*/}) {
+ push @lines, "=> gemini://$authority$'";
+ } else {
+ push @lines, $_;
+ }
+ }
+ } else {
+ @lines = <$cl>;
+ }
+ push @lines, "" unless !@lines or $lines[$#lines] eq "";
+ push @lines, "Retrieved from $uri\n at " . localtime;
+ return $meta, \@lines;
+ } else {
+ return $meta, do { local $/; <$cl> };
+ }
+}
+
+sub gemtext_to_mail {
+ my ($gemtext, %opts) = @_;
+ $opts{from} or die "no From: address specified";
+ $opts{to} or die "no To: address specified";
+
+ my $subject = $opts{link_title} // "";
+ if ($gemtext->[0] =~ m{^#(?!#)\s*}) {
+ $subject = $';
+ shift @$gemtext;
+ shift @$gemtext while $gemtext->[0] =~ /^$/;
+ }
+
+ if ($opts{gemlog}) {
+ $opts{from}
+ = Mail::Field->new("From")->create($opts{from}, $opts{gemlog})
+ ->stringify;
+ $subject = "$opts{gemlog}: $subject" if $subject;
+ }
+
+ my $msg = MIME::Lite->new(
+ From => $opts{from},
+ To => $opts{to},
+ Subject => $subject,
+ Type => "multipart/mixed"
+ );
+ $msg->add(Date => $opts{date}) if $opts{date};
+
+ my ($pre, @buffer);
+ my $flush = sub {
+ return unless @buffer;
+ $msg->attach(Type => "TEXT", Data => join "\r\n", @buffer);
+ undef @buffer;
+ };
+ my $pad
+ = sub { push @buffer, "" unless !@buffer or $buffer[$#buffer] eq "" };
+ for (@$gemtext) {
+ if ($pre) {
+ if (/^```/) {
+ $pre = 0;
+ } else {
+ push @buffer, " $_";
+ }
+ } elsif (/^```/) {
+ &$pad;
+ $pre = 1;
+ } elsif (/^>\s*/) {
+ &$pad;
+ push @buffer, split "\n", wrap "> ", "> ", $';
+ } elsif (/^\*\s*/) {
+ &$pad;
+ push @buffer, split "\n", wrap "• ", " ", $';
+ } elsif ($opts{inline_images}
+ and my ($uri) = m{^=>\s*(gemini://\S+\.(?:jpg|jpeg|png|gif))}) {
+ &$flush;
+ my ($type, $data, $failed);
+ #<<<
+ try {
+ ($type, $data) = gemini_fetch($uri);
+ } catch {
+ push @buffer, "when fetching $uri, $_";
+ $failed = 1;
+ };
+ #>>>
+ $msg->attach(
+ Type => $type,
+ Data => $data,
+ Filename => (split "/", $uri)[-1],
+ Disposition => "inline"
+ ) unless $failed;
+ } elsif (/^=>/) {
+ &$pad unless @buffer and $buffer[$#buffer] =~ /^=>/;
+ push @buffer, $_;
+ } elsif (/^#+/) {
+ &$pad;
+ push @buffer, $_;
+ } else {
+ &$pad;
+ push @buffer, split "\n", wrap "", "", $_;
+ }
+ }
+
+ &$flush;
+ return $msg;
+}
diff --git a/gmi2email.1.pod b/gmi2email.1.pod
new file mode 100644
index 0000000..d5623f9
--- /dev/null
+++ b/gmi2email.1.pod
@@ -0,0 +1,130 @@
+=head1 NAME
+
+gmi2email - subscribe to gemlogs and read individual Gemini pages by e-mail
+
+=head1 SYNOPSIS
+
+B<gmi2email> [I<OPTIONS>] [I<URI or FILE>] ...
+
+=head1 DESCRIPTION
+
+B<gmi2email> fetches pages served using the Gemini protocol, converts them to
+e-mail messages, and then sends those messages. It is mainly useful for
+subscribing to Gemini logs ("gemlogs") by e-mail, like rss2email(1).
+B<gmi2email> fetches, converts and sends all URIs and files containing
+text/gemini content specified on the command line.
+
+=head2 TYPICAL USAGE
+
+1. Ensure you have a working MTA: B<gmi2email> will use the sendmail(1)
+command to send mail.
+
+2. Create B<~/.config/mailscripts/gmi2email.config> with content like this:
+
+=over 4
+
+ from = rss@example.com
+ to = your_email@example.com
+ inline_images = 1
+
+=back
+
+3. Create B<~/.config/mailscripts/gmi2email.subscriptions> with some feed
+URIs, e.g.
+
+=over 4
+
+ gemini://example.com/my_cool_gemlog/
+ gemini://example.com/other_cool_gemlog/feed.xml
+
+=back
+
+4. Just once, execute
+
+=over 4
+
+ % gmi2email --subscriptions --no-send
+
+=back
+
+5. Periodically, execute
+
+=over 4
+
+ % gmi2email --subscriptions
+
+=back
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--subscriptions>[=I<FILE>]
+
+In addition to mailing any URIs/files specified on the command line, check
+subscribed gemlogs for new posts and send those too. Useful in a crontab.
+
+We support the subscription mechanism described at
+<gemini://gemini.circumlunar.space/docs/companion/subscription.gmi> as well as
+Atom feeds.
+
+B<gmi2email> looks for a file with a list of gemini:// URIs to check for new
+posts, one per line, in I<FILE>, or if that is not set, in
+B<$XDG_CONFIG_HOME/mailscripts/gmi2email.subscriptions>, or if XDG_CONFIG_HOME
+is not set, it falls back to trying to read
+B<~/.config/mailscripts/gmi2email.subscriptions>. Lines beginning with '#'
+are treated as comments and ignored.
+
+=item B<--inline-images>
+
+Download and inline any images included in the post.
+
+=item B<--no-send>
+
+Don't actually send any mail. Intended when you just added some new
+subscriptions and want to avoid receiving all the old posts you've already
+read.
+
+=item B<--from=>I<ADDRESS>
+
+Set the From: address, overriding the configuration file.
+
+=item B<--to=>I<ADDRESS>
+
+Set the To: address, overriding the configuration file.
+
+=back
+
+=head1 CONFIGURATION
+
+B<gmi2email> tries to read configuration from the file
+B<$XDG_CONFIG_HOME/mailscripts/gmi2email.config>, or if XDG_CONFIG_HOME is not
+set, it falls back to trying to read
+B<~/.config/mailscripts/gmi2email.config>.
+
+The format is I<key = value>, one per line. The following
+configuration keys are supported:
+
+=over 4
+
+=item B<from>
+
+Set the From: address.
+
+=item B<to>
+
+Set the To: address.
+
+=item inline_images
+
+Set to 1 to implicitly pass B<--inline-images>.
+
+=back
+
+=head1 SEE ALSO
+
+<https://gemini.circumlunar.space/>
+
+=head1 AUTHOR
+
+B<gmi2email> was written by Sean Whitton <spwhitton@spwhitton.name>.
diff --git a/mailscripts.el b/mailscripts.el
index aafcf15..15c135f 100644
--- a/mailscripts.el
+++ b/mailscripts.el
@@ -1,10 +1,10 @@
-;;; mailscripts.el --- functions to access tools in the mailscripts package
+;;; mailscripts.el --- utilities for handling mail on Unixes -*- lexical-binding: t; -*-
;; Author: Sean Whitton <spwhitton@spwhitton.name>
-;; Version: 0.21
+;; Version: 28
;; Package-Requires: (notmuch)
-;; Copyright (C) 2018, 2019, 2020 Sean Whitton
+;; Copyright (C) 2018, 2019, 2020, 2022 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
@@ -19,14 +19,29 @@
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; The original purpose of this package was to make it easy to use the small
+;; mail-handling utilities shipped in Debian's 'mailscripts' package from
+;; within Emacs. It now also contains some additional, thematically-related
+;; utilities which don't invoke any of those scripts.
+;;
+;; Entry points you might like to look at if you're new to this package:
+;; mailscripts-prepare-patch, notmuch-slurp-debbug,
+;; notmuch-extract-{thread,message}-patches{,-to-project}.
+
;;; Code:
(require 'cl-lib)
-(require 'notmuch)
(require 'thingatpt)
+(require 'vc)
+(require 'message)
+
+(eval-when-compile (require 'notmuch))
(defgroup mailscripts nil
- "Customisation of functions in the mailscripts package.")
+ "Customisation of functions in the mailscripts package."
+ :group 'mail)
(defcustom mailscripts-extract-patches-branch-prefix nil
"Prefix for git branches created by functions which extract patch series.
@@ -43,22 +58,19 @@ applying patches before updating any of your existing branches,
or for quick, ad hoc testing of a patch series.
Note that this does not prevent the creation of new branches."
- :type 'boolean
+ :type '(choice (const :tag "Always detach" t)
+ (const :tag "Never detach" nil)
+ (const :tag "Ask whether to detach" ask))
:group 'mailscripts)
-(defcustom mailscripts-project-library 'projectile
+(defcustom mailscripts-project-library 'project
"Which project management library to use to choose from known projects.
Some mailscripts functions allow selecting the repository to
which patches will be applied from the list of projects already
known to Emacs. There is more than one popular library for
maintaining a list of known projects, however, so this variable
-must be set to the one you use.
-
-Once there is a more fully-featured version of project.el
-included in the latest stable release of GNU Emacs, the default
-value of this variable may change, so if you wish to continue
-using Projectile, you should explicitly customize this."
+must be set to the one you use."
:type '(choice (const :tag "project.el" project)
(const :tag "Projectile" projectile))
:group 'mailscripts)
@@ -69,6 +81,7 @@ using Projectile, you should explicitly customize this."
If NO-OPEN, don't open the thread."
(interactive "sBug number: ")
+ (require 'notmuch)
(call-process-shell-command (concat "notmuch-slurp-debbug " bug))
(unless no-open
(let* ((search (concat "Bug#" bug))
@@ -78,8 +91,7 @@ If NO-OPEN, don't open the thread."
"--limit=1"
"--format=text"
"--format-version=4" search))))
- (notmuch-show thread-id nil nil nil
- (concat "*notmuch-show-" search "*")))))
+ (notmuch-search search t thread-id))))
;;;###autoload
(defun notmuch-slurp-debbug-at-point ()
@@ -91,10 +103,14 @@ If NO-OPEN, don't open the thread."
(skip-chars-forward "#bBug" (+ 4 (point)))
(notmuch-slurp-debbug (number-to-string (number-at-point)))))
+(declare-function notmuch-show-get-subject "notmuch-show")
+(declare-function notmuch-refresh-this-buffer "notmuch-lib")
+
;;;###autoload
(defun notmuch-slurp-this-debbug ()
"When viewing a Debian bug in notmuch, download any missing messages."
(interactive)
+ (require 'notmuch)
(let ((subject (notmuch-show-get-subject)))
(notmuch-slurp-debbug
(if (string-match "Bug#\\([0-9]+\\):" subject)
@@ -115,28 +131,36 @@ option detailed in mbox-extract-patch(1).
See notmuch-extract-patch(1) manpage for limitations: in
particular, this Emacs Lisp function supports passing only entire
threads to the notmuch-extract-patch(1) command."
+ ;; We could obtain a list of message IDs for a subthread, say, and disjoin
+ ;; them to produce a more specific query to pass to the script. This could
+ ;; help in large threads where the script fails to extract the right thing.
(interactive
"Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): \nP")
- (let ((thread-id
- ;; If `notmuch-show' was called with a notmuch query rather
- ;; than a thread ID, as `org-notmuch-follow-link' in
- ;; org-notmuch.el does, then `notmuch-show-thread-id' might
- ;; be an arbitrary notmuch query instead of a thread ID. We
- ;; need to wrap such a query in thread:{} before passing it
- ;; to notmuch-extract-patch(1), or we might not get a whole
- ;; thread extracted (e.g. if the query is just id:foo)
- (if (string= (substring notmuch-show-thread-id 0 7) "thread:")
- notmuch-show-thread-id
- (concat "thread:{" notmuch-show-thread-id "}")))
+ (let ((search
+ (cond
+ ((derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
+ (mailscripts--gnus-message-id-search t))
+ ((derived-mode-p 'notmuch-show-mode)
+ ;; If `notmuch-show' was called with a notmuch query rather
+ ;; than a thread ID, as `org-notmuch-follow-link' in
+ ;; org-notmuch.el does, then `notmuch-show-thread-id' might
+ ;; be an arbitrary notmuch query instead of a thread ID. We
+ ;; need to wrap such a query in thread:{} before passing it
+ ;; to notmuch-extract-patch(1), or we might not get a whole
+ ;; thread extracted (e.g. if the query is just id:foo)
+ (if (string= (substring notmuch-show-thread-id 0 7) "thread:")
+ notmuch-show-thread-id
+ (concat "thread:{" notmuch-show-thread-id "}")))
+ (t (user-error "Unsupported major mode"))))
(default-directory (expand-file-name repo)))
(mailscripts--check-out-branch branch)
(shell-command
(if reroll-count
(format "notmuch-extract-patch -v%d %s | git am"
(prefix-numeric-value reroll-count)
- (shell-quote-argument thread-id))
+ (shell-quote-argument search))
(format "notmuch-extract-patch %s | git am"
- (shell-quote-argument thread-id)))
+ (shell-quote-argument search)))
"*notmuch-apply-thread-series*")))
;;;###autoload
@@ -154,30 +178,84 @@ threads to the notmuch-extract-patch(1) command."
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))
+(declare-function notmuch-foreach-mime-part "notmuch")
+(declare-function notmuch--call-process "notmuch-lib")
+(declare-function notmuch-show-get-message-id "notmuch-show")
+(declare-function notmuch-show-pipe-message "notmuch-show")
+(defvar gnus-article-buffer)
+(declare-function article-decode-charset "gnus-art")
+(declare-function gnus-article-mime-handles "gnus-art")
+(declare-function gnus-summary-show-article "gnus-sum")
+
+;;;###autoload
+(defalias 'notmuch-extract-message-patches
+ #'mailscripts-extract-message-patches)
+
;;;###autoload
-(defun notmuch-extract-message-patches (repo branch)
+(defun mailscripts-extract-message-patches (repo branch)
"Extract patches attached to current message to branch BRANCH in repo REPO.
+If there are no attachments that look like patches, offer to try piping the
+whole message.
The target branch may or may not already exist.
Patches are applied using git-am(1), so we only consider
attachments with filenames which look like they were generated by
git-format-patch(1)."
+ ;; See `debbugs-gnu-apply-patch' in debbugs-gnu.el for other ideas about
+ ;; identifying which attachments are the patches to be applied.
+ ;; We could make it a defcustom, so that users can supply their own filters.
(interactive
"Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): ")
- (with-current-notmuch-show-message
- (let ((default-directory (expand-file-name repo))
- (mm-handle (mm-dissect-buffer t)))
- (mailscripts--check-out-branch branch)
- (notmuch-foreach-mime-part
- (lambda (p)
- (let* ((disposition (mm-handle-disposition p))
- (filename (cdr (assq 'filename disposition))))
- (and filename
- (string-match "^\\(v?[0-9]+\\)-.+\\.\\(patch\\|diff\\|txt\\)$"
- filename)
- (mm-pipe-part p "git am"))))
- mm-handle))))
+ (let ((default-directory (expand-file-name repo))
+ handles raw)
+ (cond ((derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
+ (with-current-buffer gnus-article-buffer
+ (setq handles (mapcar #'cdr (gnus-article-mime-handles))
+ raw (lambda ()
+ (gnus-summary-show-article 'raw)
+ (with-current-buffer gnus-article-buffer
+ (article-decode-charset)
+ (buffer-string))))))
+ ((derived-mode-p 'notmuch-show-mode)
+ (with-current-notmuch-show-message
+ (notmuch-foreach-mime-part (lambda (handle) (push handle handles))
+ (mm-dissect-buffer t)))
+ (setq raw (lambda ()
+ (let (ret)
+ (with-current-notmuch-show-message
+ (setq ret (buffer-string)))
+ ret))))
+ (t (user-error "Unsupported major mode")))
+ (cl-callf2 cl-remove-if-not
+ (lambda (h)
+ (and-let*
+ ((filename (cdr (assq 'filename (mm-handle-disposition h)))))
+ (string-match "\\`v?[0-9]+-.+\\.\\(?:patch\\|diff\\|txt\\)\\'"
+ filename)))
+ handles)
+ (if handles
+ (cl-loop initially (mailscripts--check-out-branch branch)
+ for handle in handles do (mm-pipe-part handle "git am"))
+ ;; We ask for confirmation because our code for identifying attached
+ ;; patches, and for finding scissors, is very simple.
+ (setq raw (funcall raw))
+ (with-temp-buffer
+ (insert raw)
+ (goto-char (point-min))
+ (let ((scissors (re-search-forward "^-- >8 --\\s-*$" nil t)))
+ (cl-case (or (and scissors
+ (yes-or-no-p
+ (substitute-quotes
+ "Pipe whole message to `git am --scissors'?"))
+ 'scissors)
+ (yes-or-no-p
+ (substitute-quotes
+ (if scissors "Pipe whole message to `git am'?"
+"Could not identify attached patches; pipe whole message to `git am'?"))))
+ (scissors
+ (call-process-region nil nil "git" nil nil nil "am" "-c"))
+ ((t) (call-process-region nil nil "git" nil nil nil "am"))))))))
;;;###autoload
(define-obsolete-function-alias
@@ -186,14 +264,220 @@ git-format-patch(1)."
"mailscripts 0.22")
;;;###autoload
-(defun notmuch-extract-message-patches-to-project ()
- "Like `notmuch-extract-message-patches', but choose repo from known projects."
+(defalias 'notmuch-extract-message-patches-to-project
+ #'mailscripts-extract-message-patches-to-project)
+
+;;;###autoload
+(defun mailscripts-extract-message-patches-to-project ()
+ "Like `mailscripts-extract-message-patches', but choose repo from known projects."
(interactive)
(mailscripts--project-repo-and-branch 'notmuch-extract-message-patches))
+;;;###autoload
+(defun mailscripts-prepare-patch ()
+ "Prepare patches for mailing out in a project- and MUA-specific way.
+This is a convenience wrapper command for interactive use only.
+Its behaviour is subject to change as we add support for more MUAs, ways to
+generate patches, etc.."
+ (interactive)
+ (call-interactively
+ (if (eq (vc-deduce-backend) 'Git)
+ ;; For Git, default to one message per patch, like git-send-email(1).
+ ;; Only use attachments when configured for this project.
+ ;;
+ ;; We presently assume that if patches-as-attachments has been
+ ;; configured for this project, it's unlikely that you'll want to send
+ ;; any messages with --scissors patches. That may not be correct.
+ (cond
+ ((and (local-variable-p 'vc-prepare-patches-separately)
+ (not vc-prepare-patches-separately))
+ #'mailscripts-git-format-patch-attach)
+ ((and (catch 'found
+ (dolist (buffer (buffer-list))
+ (when (and (string-search "unsent " (buffer-name buffer))
+ (with-current-buffer buffer
+ (derived-mode-p 'mail-mode 'message-mode)))
+ (throw 'found t))))
+ (yes-or-no-p "Append -- >8 -- patch to unsent message?"))
+ #'mailscripts-git-format-patch-append)
+ (t #'mailscripts-git-format-patch-drafts))
+ #'vc-prepare-patch)))
+
+;;;###autoload
+(defun mailscripts-git-format-patch-attach (args &optional new)
+ "Compose mail with patches generated by git-format-patch(1) attached.
+ARGS is a single string of arguments to git-format-patch(1). If NEW is
+non-nil (interactively, with a prefix argument), always start composing a
+new message. Otherwise, attach patches to an existing mail composition
+buffer. This is useful for sending patches in reply to bug reports, etc..
+
+This command is a Git-specific alternative to `vc-prepare-patch' with nil
+`vc-prepare-patches-separately'. It makes it easier to take advantage of
+various features of git-format-patch(1), such as reroll counts.
+For a command for non-nil `vc-prepare-patches-separately', see
+`mailscripts-git-format-patch-drafts'.
+See also the interactive wrapper command `mailscripts-prepare-patch'."
+ (interactive "sgit format-patch \nP")
+ (let ((temp (make-temp-file "patches" t))
+ (mml-attach-file-at-the-end t)
+ patches subject)
+ (condition-case err
+ (setq patches (apply #'process-lines "git" "format-patch" "-o" temp
+ (split-string-and-unquote args))
+ subject
+ (if (file-exists-p (car patches))
+ (with-temp-buffer
+ (insert-file-contents (car patches))
+ (message-narrow-to-headers-or-head)
+ (and-let* ((subject (message-fetch-field "subject")))
+ (if (cdr patches)
+ (and (string-match
+ "^\\[\\(.*PATCH.*?\\)\\(?:\\s-+[0-9]+/[0-9]+\\)?\\]\\s-"
+ subject)
+ (format "[%s] " (match-string 1 subject)))
+ subject)))
+ (user-error "git-format-patch(1) created no patch files")))
+ (error (delete-directory temp t)
+ (signal (car err) (cdr err))))
+ (compose-mail (mailscripts--gfp-addressee) subject nil (not new) nil nil
+ `((delete-directory ,temp t)))
+ (mapc #'mml-attach-file patches)
+ (when (or (not subject) (cdr patches))
+ (message-goto-subject))))
+
+;;;###autoload
+(defun mailscripts-git-format-patch-drafts (args)
+ "Import patches generated by git-format-patch(1) to your drafts folder.
+ARGS is a single string of arguments to git-format-patch(1).
+
+This command is a Git-specific alternative to `vc-prepare-patch' with non-nil
+`vc-prepare-patches-separately'. It makes it easier to take advantage of
+various features of git-format-patch(1), such as reroll counts.
+For a command for nil `vc-prepare-patches-separately', see
+`mailscripts-git-format-patch-attach'.
+See also the interactive wrapper command `mailscripts-prepare-patch'."
+ (interactive "sgit format-patch ")
+ (let ((args (cons "--thread" (split-string-and-unquote args))))
+ (when-let ((addressee (mailscripts--gfp-addressee)))
+ (push (format "--to=%s" addressee) args))
+ (cl-case mail-user-agent
+ (gnus-user-agent (mailscripts--gfp-drafts-gnus args))
+ (notmuch-user-agent (mailscripts--gfp-drafts-notmuch args))
+ (t (user-error "Unsupported mail-user-agent `%s'" mail-user-agent)))))
+
+(declare-function gnus-summary-header "gnus-score")
+(declare-function gnus-summary-goto-article "gnus-sum")
+(declare-function gnus-summary-copy-article "gnus-sum")
+(declare-function gnus-summary-exit-no-update "gnus-sum")
+(declare-function gnus-uu-mark-buffer "gnus-uu")
+(declare-function gnus-group-read-group "gnus-group")
+(declare-function gnus-group-read-ephemeral-group "gnus-group")
+
+(defun mailscripts--gfp-drafts-gnus (args)
+ (require 'gnus)
+ (let* ((temp (make-temp-file "patches"))
+ (group (concat "nndoc+ephemeral:" temp))
+ (method `(nndoc ,temp (nndoc-article-type mbox)))
+ (summary (format "*Summary %s*" group))
+ message-id)
+ (unwind-protect
+ (progn (with-temp-file temp
+ (unless (zerop (apply #'call-process "git" nil t nil
+ "format-patch" "--stdout" args))
+ (user-error "git-format-patch(1) exited non-zero")))
+ (unless (gnus-alive-p) (gnus-no-server))
+ (gnus-group-read-ephemeral-group group method)
+ (setq message-id (gnus-summary-header "message-id"))
+ (gnus-uu-mark-buffer)
+ (gnus-summary-copy-article nil "nndraft:drafts"))
+ (when-let ((buffer (get-buffer summary)))
+ (with-current-buffer buffer
+ (gnus-summary-exit-no-update t)))
+ (delete-file temp))
+ (gnus-group-read-group t t "nndraft:drafts")
+ (gnus-summary-goto-article message-id)))
+
+(defun mailscripts--gfp-drafts-notmuch (args)
+ (require 'notmuch)
+ (let ((temp (make-temp-file "patches" t))
+ (insert (cl-list* "insert" (format "--folder=%s" notmuch-draft-folder)
+ "--create-folder" notmuch-draft-tags)))
+ (unwind-protect
+ (mapc (lambda (patch)
+ (unless (zerop (apply #'call-process "notmuch" patch
+ "*notmuch-insert output*" nil insert))
+ (display-buffer "*notmuch-insert output*")
+ (user-error "notmuch-insert(1) exited non-zero")))
+ (apply #'process-lines "git" "format-patch" "-o" temp args))
+ (delete-directory temp t)))
+ (notmuch-search (format "folder:%s" notmuch-draft-folder)))
+
+(defun mailscripts-git-format-patch-append (args)
+ "Append a patch generated by git-format-patch(1) to an unsent message.
+ARGS is a single string of arguments to git-format-patch(1).
+The patch is formatted such that a recipient can use the --scissors option to
+git-am(1) to apply the patch; see \"DISCUSSION\" in git-format-patch(1)."
+ (interactive (list (read-string "git format-patch " "-1 ")))
+ (let ((dir default-directory))
+ (compose-mail nil nil nil t)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (let ((unsent-buffer (current-buffer))
+ (default-directory dir)
+ (args (split-string-and-unquote args))
+ (unsent-from (message-fetch-field "from")))
+ (widen)
+ (if (re-search-forward message-signature-separator nil t)
+ (progn (goto-char (pos-bol))
+ (push "--no-signature" args))
+ (goto-char (point-max)))
+ (if (fboundp 'ensure-empty-lines)
+ (ensure-empty-lines 1)
+ ;; This is only some of what (ensure-empty-lines 1) does.
+ (if (bolp)
+ (unless (save-excursion (goto-char (pos-bol 0)) (eolp))
+ (newline))
+ (newline 2)))
+ (insert "-- >8 --\n")
+ (with-temp-buffer
+ (apply #'call-process "git" nil t nil "format-patch" "--stdout"
+ args)
+ (when (bobp)
+ (user-error "git-format-patch(1) produced no output"))
+ (goto-char (point-min))
+ (delete-line) ; drop "From $SHA1 $magic_timestamp"
+ (message-narrow-to-headers-or-head)
+ (when-let* ((unsent
+ (and unsent-from
+ (mail-header-parse-address-lax unsent-from)))
+ (patch-from (message-fetch-field "from"))
+ (patch (mail-header-parse-address-lax patch-from)))
+ (when (equal unsent patch)
+ (message-remove-header "^From:\\|^Date:" t)))
+ (widen)
+ (goto-char (point-max))
+ (delete-blank-lines)
+ (append-to-buffer unsent-buffer 1 (point-max))))))))
+
+(defun mailscripts--gfp-addressee ()
+ "Try to find a recipient for the --to argument to git-format-patch(1)."
+ (or (and (local-variable-p 'vc-default-patch-addressee)
+ vc-default-patch-addressee)
+ (car (process-lines-ignore-status
+ "git" "config" "--get" "format.to"))
+ (car (process-lines-ignore-status
+ "git" "config" "--get" "sendemail.to"))))
+
(defun mailscripts--check-out-branch (branch)
(if (string= branch "")
- (when mailscripts-detach-head-from-existing-branch
+ (when (and
+ ;; Don't proceed if HEAD is already detached.
+ (zerop (call-process "git" nil nil nil
+ "symbolic-ref" "--quiet" "HEAD"))
+ (or (eq mailscripts-detach-head-from-existing-branch t)
+ (and (eq mailscripts-detach-head-from-existing-branch 'ask)
+ (yes-or-no-p "Detach HEAD before applying patches?"))))
(call-process-shell-command "git checkout --detach"))
(call-process-shell-command
(format "git checkout -b %s"
@@ -202,16 +486,24 @@ git-format-patch(1)."
(concat mailscripts-extract-patches-branch-prefix branch)
branch))))))
+(defun mailscripts--gnus-message-id-search (&optional thread)
+ (format (if thread "thread:{id:%s}" "id:%s")
+ (string-trim (gnus-summary-header "message-id") "<" ">")))
+
+(defvar projectile-known-projects)
+(declare-function project-prompt-project-dir "project")
+(declare-function projectile-completing-read "projectile")
+
(defun mailscripts--project-repo-and-branch (f &rest args)
(let ((repo (cl-case mailscripts-project-library
- ('project
+ (project
(require 'project)
(project-prompt-project-dir))
- ('projectile
+ (projectile
(require 'projectile)
(projectile-completing-read
"Select Projectile project: " projectile-known-projects))
- (nil
+ (t
(user-error
"Please customize variable `mailscripts-project-library'."))))
(branch (read-from-minibuffer
diff --git a/mdmv b/mdmv
index fa1533f..78a9222 100755
--- a/mdmv
+++ b/mdmv
@@ -59,7 +59,7 @@ for msg in sys.argv[1:-1]:
if flags:
msg_dest = os.path.join(os.path.join(dest, 'cur'), name_prefix + ':' + flags)
else:
- msg_dest = os.path.join(os.path.join(dest, 'cur'), name_prefix)
+ msg_dest = os.path.join(os.path.join(dest, 'cur'), name_prefix + ':2,')
if os.path.exists(msg_dest):
eprint(us + ": somehow, dest " + msg_dest + " already exists")
diff --git a/notmuch-extract-patch.1.pod b/notmuch-extract-patch.1.pod
index 242a704..65bf51c 100644
--- a/notmuch-extract-patch.1.pod
+++ b/notmuch-extract-patch.1.pod
@@ -42,6 +42,8 @@ notmuch(1), git-send-email(1), mbox-extract-patch(1)
Emacs functions 'notmuch-extract-thread-patches' and
'notmuch-extract-message-patches', provided by mailscripts.el
+The piem project: <https://docs.kyleam.com/piem/>
+
=head1 AUTHOR
Sean Whitton <spwhitton@spwhitton.name>
diff --git a/notmuch-slurp-debbug b/notmuch-slurp-debbug
index ad0db47..f5ae3fc 100755
--- a/notmuch-slurp-debbug
+++ b/notmuch-slurp-debbug
@@ -43,7 +43,7 @@ my $maildir;
my $conf_r = $ENV{XDG_CONFIG_HOME} || catfile $ENV{HOME}, ".config";
my $conf_f = catfile $conf_r, "mailscripts", "notmuch-slurp-debbug";
if (-f $conf_f) {
- $maildir = Config::Tiny->new->read($conf_f)->{_}->{maildir};
+ $maildir = glob Config::Tiny->new->read($conf_f)->{_}->{maildir};
} else {
# default to where a lot of people have their inbox
chomp(my $database_path = `notmuch config get database.path`);
@@ -54,7 +54,7 @@ $maildir = $mgr->open(
access => "a",
keep_dups => 1,
type => "maildir"
-);
+) or die "failed to open target maildir: $!\n";
# we use bts(1) to download the mbox because it has some logic to find
# the right URI and the user might have enabled its caching features.
@@ -72,7 +72,7 @@ my $mbox = $mgr->open(
access => "r",
keep_dups => 1,
type => "mbox"
-);
+) or die "failed to open $bug.mbox: $!\n";
foreach my $message ($mbox->messages) {
my $mid = $message->messageId;
diff --git a/sendmail-reinject b/sendmail-reinject
new file mode 100755
index 0000000..e50c484
--- /dev/null
+++ b/sendmail-reinject
@@ -0,0 +1,73 @@
+#!/usr/bin/env python3
+
+# SPDX-License-Identifier: GPL-2.0-or-later
+# Copyright 2022 Jameson Graef Rollins
+
+import sys
+import argparse
+import subprocess
+
+import email
+from email.policy import default
+from email.utils import parseaddr, getaddresses
+
+
+def sendmail(recipients, message, sender):
+ """send message via sendmail"""
+ cmd = [
+ 'sendmail',
+ '-f', sender,
+ ] + recipients
+ print(' '.join(cmd), file=sys.stderr)
+ subprocess.run(
+ cmd,
+ input=message.as_bytes(),
+ check=True,
+ )
+
+
+def main():
+ parser = argparse.ArgumentParser(
+ description="Reinject an email message via sendmail.",
+ )
+ pgroup = parser.add_mutually_exclusive_group(required=True)
+ pgroup.add_argument(
+ 'message', nargs='?', type=argparse.FileType('rb'),
+ help="email message path or '-' for stdin",
+ )
+ pgroup.add_argument(
+ '-i', '--notmuch-id',
+ help="message ID for notmuch extraction",
+ )
+
+ args = parser.parse_args()
+
+ if args.id:
+ import notmuch2 as notmuch
+ db = notmuch.Database()
+ query = f'id:{args.id}'
+ assert db.count_messages(query) == 1, "Message ID does not match exactly one message??"
+ for msg in db.messages(query):
+ path = msg.path
+ break
+ f = open(path, 'rb')
+ else:
+ f = args.message
+
+ # parse the email message
+ msg = email.message_from_binary_file(f, policy=default)
+
+ sender = parseaddr(msg['from'])[1]
+
+ # extract all recipients
+ tos = msg.get_all('to', [])
+ ccs = msg.get_all('cc', [])
+ resent_tos = msg.get_all('resent-to', [])
+ resent_ccs = msg.get_all('resent-cc', [])
+ recipients = [r[1] for r in getaddresses(tos + ccs + resent_tos + resent_ccs)]
+
+ sendmail(recipients, msg, sender)
+
+
+if __name__ == '__main__':
+ main()
diff --git a/sendmail-reinject.1.pod b/sendmail-reinject.1.pod
new file mode 100644
index 0000000..f89d0f1
--- /dev/null
+++ b/sendmail-reinject.1.pod
@@ -0,0 +1,45 @@
+=encoding utf8
+
+=head1 NAME
+
+sendmail-reinject - reinject an e-mail via sendmail
+
+=head1 SYNOPSIS
+
+B<sendmail-reinject> B<message.eml>
+
+B<sendmail-reinject> B<-> <B<message.eml>
+
+B<sendmail-reinject> B<-i> B<messageID>
+
+
+=head1 DESCRIPTION
+
+B<sendmail-reinject> reinjects a message to your MTA via sendmail.
+The message is read in (via path, stdin, or from notmuch via message
+ID), the sender and recipients are extracted, and the appropriate
+senmdail command is contructed to resent the message.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--notmuch-id>,B<-i> B<messageID>
+
+Message ID of message to reinject as know to a local notmuch database.
+Assumes the python3-notmuch package is available.
+
+=item B<--help>, B<-h>
+
+Show usage instructions.
+
+=back
+
+=head1 SEE ALSO
+
+sendmail(1), notmuch(1)
+
+=head1 AUTHOR
+
+B<sendmail-reinject> and this manpage were written by Jameson Graef
+Rollins <jrollins@finestructure.net>.