diff options
| -rw-r--r-- | assets/css/screen.css | 5 | ||||
| -rw-r--r-- | mumi/debbugs.scm | 62 | ||||
| -rw-r--r-- | mumi/web/controller.scm | 4 | ||||
| -rw-r--r-- | mumi/web/download.scm | 27 | ||||
| -rw-r--r-- | mumi/web/view/html.scm | 6 | ||||
| -rw-r--r-- | mumi/web/view/utils.scm | 1 |
6 files changed, 74 insertions, 31 deletions
diff --git a/assets/css/screen.css b/assets/css/screen.css index 841944c..e8447d0 100644 --- a/assets/css/screen.css +++ b/assets/css/screen.css @@ -296,6 +296,7 @@ details { margin-right: 0.2em; } +.download-message, .download-part { float: right; font-size: 0.8em; @@ -333,6 +334,10 @@ details { } } +.message .from { + display: inline-block; +} + .message .from .address { font-weight: bold; } diff --git a/mumi/debbugs.scm b/mumi/debbugs.scm index 943930a..75e55b4 100644 --- a/mumi/debbugs.scm +++ b/mumi/debbugs.scm @@ -52,11 +52,14 @@ bug-tags)) (define* (read-emails-from-bug-log port - #:optional (keep '(incoming-recv))) + #:key + (keep '(incoming-recv)) + raw?) "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. +email objects. Return the raw emails as a list when RAW? is #T. +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 @@ -101,30 +104,33 @@ ends with ^C. (#\etx (let ((mails* (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)))) - (let ((id (and mail (assoc-ref (email-headers mail) 'message-id)))) - (if (and id (not (hash-ref msgids id))) - (begin - (hash-set! msgids id #t) - (cons mail mails)) - mails))) + (if raw? + (cons (string-join (reverse lines) "\n") + mails) + ;; 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)))) + (let ((id (and mail (assoc-ref (email-headers mail) 'message-id)))) + (if (and id (not (hash-ref msgids id))) + (begin + (hash-set! msgids id #t) + (cons mail mails)) + mails)))) mails))) (loop msgids mails* '() 'init #f))) ;; Ctrl-E, beginning of email in recips diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm index 346f469..9761b48 100644 --- a/mumi/web/controller.scm +++ b/mumi/web/controller.scm @@ -166,6 +166,10 @@ (handle-download (string->number id) (string->number msg-num) (map string->number path))) + (('GET "issue" (? string->number id) + "raw" (? string->number msg-num)) + (download-raw (string->number id) + (string->number msg-num))) (('GET "issue" not-an-id) (render-html (unknown not-an-id))) (('GET "help") diff --git a/mumi/web/download.scm b/mumi/web/download.scm index 91a8bc3..03812a9 100644 --- a/mumi/web/download.scm +++ b/mumi/web/download.scm @@ -1,5 +1,5 @@ ;;; mumi -- Mediocre, uh, mail interface -;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2018, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This program is free software: you can redistribute it and/or @@ -23,10 +23,12 @@ #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (mumi debbugs) #:use-module (mumi messages) #:use-module (mumi web render) #:use-module (mumi web view html) - #:export (handle-download)) + #:export (handle-download + download-raw)) (define (handle-download id msg-num path) "Handle download of an attachment for bug ID, message number @@ -54,3 +56,24 @@ PATH." (html-response (email-headers entry) (email-body entry))) (_ #f))) (apply render-html (unknown id)))) + +(define (download-raw id msg-num) + "Handle download of an attachment for bug ID, message number +MSG-NUM, in the possibly nested message part identified by the list +PATH." + (define (get-emails file) + (call-with-input-file file + (cut read-emails-from-bug-log <> #:raw? #t))) + (define emails + (let* ((candidate (lambda (archived?) + (bug-id->log-file id #:archived? archived?))) + (file (find file-exists? + (list (candidate #f) + (candidate #t))))) + (and file (get-emails file)))) + (if (and emails (> (length emails) msg-num)) + (list `((content-type text) + (content-disposition text/plain + (filename . ,(format #f "~a-~a.mbox" id msg-num)))) + (list-ref emails msg-num)) + (apply render-html (unknown id)))) diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm index 3ce0a12..11fab72 100644 --- a/mumi/web/view/html.scm +++ b/mumi/web/view/html.scm @@ -72,7 +72,7 @@ (@ (rel "stylesheet") (media "screen") (type "text/css") - (href "/css/screen.css?202005120000")))) + (href "/css/screen.css?202005130000")))) (body ,@body (footer (@ (class "text-center")) (p "Copyright © 2016—2020 by the GNU Guix community." @@ -565,6 +565,10 @@ currently disabled.")) message-number))) (title ,(date->string (date message)))) ,(time->string (date message))))) + (div (@ (class "download-message")) + (a (@ (href ,(format #f "issue/~a/raw/~a" + id message-number))) + ,download-icon)) ,@(if (string-suffix? previous-subject (subject message)) '() `((div (@ (class "subject")) ,(subject message)))) diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm index 46dcf65..bda6cbe 100644 --- a/mumi/web/view/utils.scm +++ b/mumi/web/view/utils.scm @@ -34,6 +34,7 @@ #:use-module (web uri) #:export (prettify avatar-color + download-icon display-message-body time->string)) |