diff options
| -rw-r--r-- | Makefile.am | 4 | ||||
| -rw-r--r-- | mumi/debbugs.scm | 110 |
2 files changed, 113 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 47343ab..aeeffee 100644 --- a/Makefile.am +++ b/Makefile.am @@ -48,4 +48,6 @@ SOURCES = \ mumi/messages.scm \ mumi/jobs.scm \ mumi/send-email.scm \ - mumi/config.scm + mumi/config.scm \ + mumi/debbugs.scm + diff --git a/mumi/debbugs.scm b/mumi/debbugs.scm new file mode 100644 index 0000000..405d020 --- /dev/null +++ b/mumi/debbugs.scm @@ -0,0 +1,110 @@ +;;; mumi -- Mediocre, uh, mail interface +;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero 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 +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (mumi debbugs) + #:use-module (email email) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:export (read-emails-from-bug-log)) + +(define* (read-emails-from-bug-log port + #:optional (keep '(incoming-recv))) + "Read the Debbugs bug log from PORT and return a list of parsed +email objects. According to the documentation of the Perl module +Debbugs::Log there are four record types that are separated with +single control characters on a line of their own. + +* autocheck + +This is for auto-forwarded messages. The mail is recorded between a +leading ^A and a trailing ^C. + +* recips + +This is for emails with an additional list of recipients. The +recipients list may be just the string \"-t\", which represents the +same sendmail option, indicating that the recipients are taken from +the message headers. This record starts with ^B, uses ^D as an inline +separator for recipients, and uses ^E to mark the beginning of the +email. The email ends with ^C. + +* html + +This is for raw HTML snippets. They are recorded between ^F and ^C. +They are only used for the Debbugs web interface. + +* incoming-recv + +This is for received emails. The raw email is introduced by ^G and +ends with ^C. +" + (let loop ((mails '()) + (lines '()) + (type 'init) + (skip? #f)) + (let ((line (read-line port))) + (if (eof-object? line) (reverse mails) + (match (and (not (string-null? line)) + (string-ref line 0)) + ;; Ctrl-A, autocheck + (#\soh + (loop mails lines 'autocheck #f)) + ;; Ctrl-B, recips: skip until beginning of email + (#\stx + (loop mails lines 'recips #t)) + ;; Ctrl-C, end of record + (#\etx + (loop (if (member type keep) + ;; TODO: This is very ugly. The first few + ;; lines of the raw messages stored in Debbugs + ;; logs seem to confuse the email parser, so we + ;; try to strip them off. + (let* ((content (string-join + (drop-while (lambda (line) + (or (string-prefix? "From" line) + (string-prefix? "Received" line) + (string-prefix? "\t" line) + (string-prefix? " " line))) + (reverse lines)) "\n")) + (mail (catch #t + (lambda () + (parse-email content)) + (lambda args + (format (current-error-port) + "failed to process email~%") + #f)))) + (if mail + (cons mail mails) + mails)) + mails) + '() + 'init #f)) + ;; Ctrl-E, beginning of email in recips + (#\enq + (loop mails lines 'recips #f)) + ;; Ctrl-F, raw HTML snippet: skip + (#\ack + (loop mails lines 'html #t)) + ;; Ctrl-G, incoming-recv + (#\bel + (loop mails lines 'incoming-recv #f)) + (_ + (if skip? + (loop mails lines type skip?) + (loop mails (cons line lines) type skip?)))))))) |