summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-01-23 17:18:10 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-01-23 17:18:10 -0700
commitbd274a20b46202f3a7d53a51a117cfd4110c3a67 (patch)
treea106aff6dcba7f9114142298ca8524aa9d2c068c
parent5793c537ec8897ae84b9c9e9c733a47042388225 (diff)
downloadmailscripts-bd274a20b46202f3a7d53a51a117cfd4110c3a67.tar.gz
new script: gmi2email
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r--Makefile3
-rw-r--r--debian/changelog9
-rw-r--r--debian/control8
-rw-r--r--debian/copyright2
-rw-r--r--debian/mailscripts.install1
-rw-r--r--debian/mailscripts.manpages1
-rwxr-xr-xgmi2email272
-rw-r--r--gmi2email.1.pod81
-rw-r--r--mailscripts.el2
9 files changed, 376 insertions, 3 deletions
diff --git a/Makefile b/Makefile
index e2ae233..6f52483 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)
diff --git a/debian/changelog b/debian/changelog
index 5767aa8..bbb3bf5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,12 @@
+mailscripts (0.23-1) UNRELEASED; urgency=medium
+
+ * New script: gmi2email
+ - add libdbd-sqlite3-perl, libio-socket-ssl-perl, libmime-lite-perl,
+ libemail-date-format-perl, libtry-tiny-perl and libmailtools-perl to
+ Recommends.
+
+ -- Sean Whitton <spwhitton@spwhitton.name> Sat, 23 Jan 2021 16:36:25 -0700
+
mailscripts (0.22-1) unstable; urgency=medium
* mailscripts.el:
diff --git a/debian/control b/debian/control
index 3a549a3..a47be4c 100644
--- a/debian/control
+++ b/debian/control
@@ -51,6 +51,12 @@ Recommends:
devscripts,
git,
libgit-wrapper-perl,
+ libdbd-sqlite3-perl,
+ libio-socket-ssl-perl,
+ libmime-lite-perl,
+ libemail-date-format-perl,
+ libtry-tiny-perl,
+ libmailtools-perl,
notmuch,
python3-argcomplete,
python3-gssapi,
@@ -85,3 +91,5 @@ 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
diff --git a/debian/copyright b/debian/copyright
index db97f3d..1d246a9 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,7 +1,7 @@
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.
diff --git a/debian/mailscripts.install b/debian/mailscripts.install
index df220b3..53665b3 100644
--- a/debian/mailscripts.install
+++ b/debian/mailscripts.install
@@ -8,3 +8,4 @@ mbox-extract-patch /usr/bin
notmuch-extract-patch /usr/bin
notmuch-import-patch /usr/bin
notmuch-slurp-debbug /usr/bin
+gmi2email /usr/bin
diff --git a/debian/mailscripts.manpages b/debian/mailscripts.manpages
index 345053a..d704a87 100644
--- a/debian/mailscripts.manpages
+++ b/debian/mailscripts.manpages
@@ -8,3 +8,4 @@ mbox-extract-patch.1
notmuch-extract-patch.1
notmuch-import-patch.1
notmuch-slurp-debbug.1
+gmi2email.1
diff --git a/gmi2email b/gmi2email
new file mode 100755
index 0000000..c85728b
--- /dev/null
+++ b/gmi2email
@@ -0,0 +1,272 @@
+#!/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/>.
+
+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;
+
+my ($from, $to, $do_subs, $inline_images);
+GetOptions
+ "from=s" => \$from,
+ "to=s" => \$to,
+ "subscriptions!" => \$do_subs,
+ "inline-images!" => \$inline_images;
+
+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 or sufficient command line options: don't know who to mail";
+my $conf = Config::Tiny->new->read($conf_f);
+
+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 $do_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";
+ }
+ gemtext_to_mail($data, %to_mail_opts)->send;
+}
+
+exit unless $do_subs;
+
+my $subs_f = catfile $conf_r, "mailscripts", "gmi2email.subscriptions";
+-e $subs_f or die "no list of subscriptions";
+open my $subs_fh, "<", $subs_f;
+
+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;
+ my ($gemlog, $type, $data);
+ #<<<
+ try {
+ ($type, $data) = gemini_fetch($sub, abs_links => 1);
+ } catch {
+ my ($code) = /"gemini error: ([1-6])/;
+ if ($code == 4) {
+ warn "temporary failure retrieving $sub";
+ next; # try again next run
+ } else {
+ die "while retrieving $sub $_";
+ }
+ };
+ #>>>
+ $type =~ m{^text/gemini} or die "$sub is not gemtext";
+ for (@$data) {
+ if (/^#\s*/ and not $gemlog) {
+ chomp($gemlog = $');
+ } elsif (my ($uri, $y, $m, $d, $title)
+ = /^=>\s*(\S+)\s+([0-9]{4})-([0-9]{2})-([0-9]{2})[\s-]*(.*)/) {
+ my ($rows)
+ = $dbh->selectrow_array(
+ "SELECT COUNT(*) FROM seen WHERE uri = \"$uri\"");
+ if ($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 == 4) {
+ next; # try again next run
+ } else {
+ $mail = 0; # don't try this one again
+ }
+ };
+ #>>>
+ $dbh->do("INSERT INTO seen VALUES (\"$uri\")");
+ $mail or next;
+ if ($type =~ m{^text/gemini}) {
+ gemtext_to_mail(
+ $data, %to_mail_opts,
+ gemlog => $gemlog // "unknown gemlog",
+ link_title => $title,
+ date => email_date timelocal 0,
+ 0, 12, $d, $m - 1, $y
+ )->send;
+ } else {
+ warn "$uri is not gemtext";
+ }
+ }
+ }
+ }
+}
+
+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
+ );
+ print $cl "$uri\r\n";
+
+ my ($status, $meta) = <$cl> =~ /^([0-9]+) (.+)/;
+ 20 <= $status and $status < 30 or die "gemini error: $status $meta";
+
+ if ($meta =~ "^text/gemini") {
+ my @lines;
+ if ($opts{abs_links}) {
+ $authority =~ m{/$} or $authority .= "/";
+ $path =~ m{/$} or $path .= "/";
+ for (<$cl>) {
+ s/\r?\n\z//;
+ if (m{^=> (?!/)} and not m{^=> [a-z]+://}) {
+ push @lines, "=> gemini://$authority$path$'";
+ } elsif (m{^=> /}) {
+ push @lines, "=> gemini://$authority$'";
+ } else {
+ push @lines, $_;
+ }
+ }
+ } else {
+ @lines = <$cl>;
+ }
+ push @lines, "" unless $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) = /^=>\s(\S+\.(?:jpg|jpeg|png|gif))\s/) {
+ &$flush;
+ my ($type, $data) = gemini_fetch($uri);
+ $msg->attach(
+ Type => $type,
+ Data => $data,
+ Filename => (split "/", $uri)[-1],
+ Disposition => "inline"
+ );
+ } 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..5fa6d20
--- /dev/null
+++ b/gmi2email.1.pod
@@ -0,0 +1,81 @@
+=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.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--subscriptions>
+
+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.
+
+Currently we only support the subscription mechanism described at
+<gemini://gemini.circumlunar.space/docs/companion/subscription.gmi>.
+
+B<gmi2email> looks for a file with a list of gemini:// URIs to check for new
+posts, one per line, 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>.
+
+=item B<--inline-images>
+
+Download and inline any images included in the post.
+
+=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 08947b5..8dc5875 100644
--- a/mailscripts.el
+++ b/mailscripts.el
@@ -1,7 +1,7 @@
;;; mailscripts.el --- functions to access tools in the mailscripts package
;; Author: Sean Whitton <spwhitton@spwhitton.name>
-;; Version: 0.22
+;; Version: 0.23
;; Package-Requires: (notmuch)
;; Copyright (C) 2018, 2019, 2020 Sean Whitton