From ee8eec119f224725ab5022240ebd21407a86aa21 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 21 Jul 2020 21:25:04 -0700 Subject: mailscripts.el: drop hard dep on Projectile, add project.el support Signed-off-by: Sean Whitton --- mailscripts.el | 59 +++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 11 deletions(-) (limited to 'mailscripts.el') diff --git a/mailscripts.el b/mailscripts.el index 50e3b89..d31223a 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -2,7 +2,7 @@ ;; Author: Sean Whitton ;; Version: 0.21 -;; Package-Requires: (notmuch projectile) +;; Package-Requires: (notmuch) ;; Copyright (C) 2018, 2019, 2020 Sean Whitton @@ -22,7 +22,6 @@ ;;; Code: (require 'notmuch) -(require 'projectile) (require 'thingatpt) (defgroup mailscripts nil @@ -46,6 +45,23 @@ Note that this does not prevent the creation of new branches." :type 'boolean :group 'mailscripts) +(defcustom mailscripts-project-library 'projectile + "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." + :type '(choice (const :tag "project.el" project) + (const :tag "Projectile" projectile)) + :group 'mailscripts) + ;;;###autoload (defun notmuch-slurp-debbug (bug &optional no-open) "Slurp Debian bug with bug number BUG and open the thread in notmuch. @@ -123,10 +139,16 @@ threads to the notmuch-extract-patch(1) command." "*notmuch-apply-thread-series*"))) ;;;###autoload -(defun notmuch-extract-thread-patches-projectile () - "Like `notmuch-extract-thread-patches', but use projectile to choose the repo." +(define-obsolete-function-alias + 'notmuch-extract-thread-patches-projectile + 'notmuch-extract-thread-patches-to-project + "mailscripts 0.22") + +;;;###autoload +(defun notmuch-extract-thread-patches-to-project () + "Like `notmuch-extract-thread-patches', but choose repo from known projects." (interactive) - (mailscripts--projectile-repo-and-branch + (mailscripts--project-repo-and-branch 'notmuch-extract-thread-patches (when current-prefix-arg (prefix-numeric-value current-prefix-arg)))) @@ -157,10 +179,16 @@ git-format-patch(1)." mm-handle)))) ;;;###autoload -(defun notmuch-extract-message-patches-projectile () - "Like `notmuch-extract-message-patches', but use projectile to choose the repo." +(define-obsolete-function-alias + 'notmuch-extract-message-patches-projectile + 'notmuch-extract-message-patches-to-project + "mailscripts 0.22") + +;;;###autoload +(defun notmuch-extract-message-patches-to-project () + "Like `notmuch-extract-message-patches', but choose repo from known projects." (interactive) - (mailscripts--projectile-repo-and-branch 'notmuch-extract-message-patches)) + (mailscripts--project-repo-and-branch 'notmuch-extract-message-patches)) (defun mailscripts--check-out-branch (branch) (if (string= branch "") @@ -173,9 +201,18 @@ git-format-patch(1)." (concat mailscripts-extract-patches-branch-prefix branch) branch)))))) -(defun mailscripts--projectile-repo-and-branch (f &rest args) - (let ((repo (projectile-completing-read - "Select projectile project: " projectile-known-projects)) +(defun mailscripts--project-repo-and-branch (f &rest args) + (let ((repo (case mailscripts-project-library + ('project + (require 'project) + (project-prompt-project-dir)) + ('projectile + (require 'projectile) + (projectile-completing-read + "Select Projectile project: " projectile-known-projects)) + (nil + (user-error + "Please customize variable `mailscripts-project-library'.")))) (branch (completing-read "Branch name (or leave blank to apply to current HEAD): " nil))) -- cgit v1.2.3 From bcae92b442ab909e633a838d5f83bcf8185b2784 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 22 Jul 2020 07:17:09 -0700 Subject: don't call completing-read when there are no completions Signed-off-by: Sean Whitton --- mailscripts.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'mailscripts.el') diff --git a/mailscripts.el b/mailscripts.el index d31223a..703f86e 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -213,9 +213,8 @@ git-format-patch(1)." (nil (user-error "Please customize variable `mailscripts-project-library'.")))) - (branch (completing-read - "Branch name (or leave blank to apply to current HEAD): " - nil))) + (branch (read-from-minibuffer + "Branch name (or leave blank to apply to current HEAD): "))) (apply f repo branch args))) (provide 'mailscripts) -- cgit v1.2.3 From d402aaa1e1a507e6145ef9c1a7c1957496e3cdc3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 19 Jan 2021 16:13:00 -0700 Subject: Use 'cl-case' not 'case' and require cl-lib Signed-off-by: Sean Whitton --- debian/changelog | 3 ++- mailscripts.el | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'mailscripts.el') diff --git a/debian/changelog b/debian/changelog index 294857a..050458b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,7 +5,8 @@ mailscripts (0.22-1) UNRELEASED; urgency=medium - add new defcustom, mailscripts-project-library - replace *-projectile commands with new *-to-project commands, which support both Projectile and project.el for choosing from known - projects. + projects + - Use 'cl-case' not 'case' and require cl-lib. -- Sean Whitton Tue, 21 Jul 2020 21:22:39 -0700 diff --git a/mailscripts.el b/mailscripts.el index 703f86e..aafcf15 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -21,6 +21,7 @@ ;;; Code: +(require 'cl-lib) (require 'notmuch) (require 'thingatpt) @@ -202,7 +203,7 @@ git-format-patch(1)." branch)))))) (defun mailscripts--project-repo-and-branch (f &rest args) - (let ((repo (case mailscripts-project-library + (let ((repo (cl-case mailscripts-project-library ('project (require 'project) (project-prompt-project-dir)) -- cgit v1.2.3 From 5793c537ec8897ae84b9c9e9c733a47042388225 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 19 Jan 2021 16:14:51 -0700 Subject: release mailscripts 0.22 (-1 to Debian unstable) Signed-off-by: Sean Whitton --- debian/changelog | 4 ++-- mailscripts.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'mailscripts.el') diff --git a/debian/changelog b/debian/changelog index 050458b..5767aa8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -mailscripts (0.22-1) UNRELEASED; urgency=medium +mailscripts (0.22-1) unstable; urgency=medium * mailscripts.el: - drop hard dependency on Projectile @@ -8,7 +8,7 @@ mailscripts (0.22-1) UNRELEASED; urgency=medium projects - Use 'cl-case' not 'case' and require cl-lib. - -- Sean Whitton Tue, 21 Jul 2020 21:22:39 -0700 + -- Sean Whitton Tue, 19 Jan 2021 16:14:45 -0700 mailscripts (0.21-1) unstable; urgency=medium diff --git a/mailscripts.el b/mailscripts.el index aafcf15..08947b5 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -1,7 +1,7 @@ ;;; mailscripts.el --- functions to access tools in the mailscripts package ;; Author: Sean Whitton -;; Version: 0.21 +;; Version: 0.22 ;; Package-Requires: (notmuch) ;; Copyright (C) 2018, 2019, 2020 Sean Whitton -- cgit v1.2.3 From bd274a20b46202f3a7d53a51a117cfd4110c3a67 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 23 Jan 2021 17:18:10 -0700 Subject: new script: gmi2email Signed-off-by: Sean Whitton --- Makefile | 3 +- debian/changelog | 9 ++ debian/control | 8 ++ debian/copyright | 2 +- debian/mailscripts.install | 1 + debian/mailscripts.manpages | 1 + gmi2email | 272 ++++++++++++++++++++++++++++++++++++++++++++ gmi2email.1.pod | 81 +++++++++++++ mailscripts.el | 2 +- 9 files changed, 376 insertions(+), 3 deletions(-) create mode 100755 gmi2email create mode 100644 gmi2email.1.pod (limited to 'mailscripts.el') 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 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 . + +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 [I] [I] ... + +=head1 DESCRIPTION + +B 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 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 +. + +B 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
+ +Set the From: address, overriding the configuration file. + +=item B<--to=>I
+ +Set the To: address, overriding the configuration file. + +=back + +=head1 CONFIGURATION + +B 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, one per line. The following +configuration keys are supported: + +=over 4 + +=item B + +Set the From: address. + +=item B + +Set the To: address. + +=item inline_images + +Set to 1 to implicitly pass B<--inline-images>. + +=back + +=head1 SEE ALSO + + + +=head1 AUTHOR + +B was written by Sean Whitton . 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 -;; Version: 0.22 +;; Version: 0.23 ;; Package-Requires: (notmuch) ;; Copyright (C) 2018, 2019, 2020 Sean Whitton -- cgit v1.2.3