margin-right: 0.2em;
}
+.download-message,
.download-part {
float: right;
font-size: 0.8em;
}
}
+.message .from {
+ display: inline-block;
+}
+
.message .from .address {
font-weight: bold;
}
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
(#\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
(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")
;;; 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
#: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
(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))))
(@ (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."
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))))
#:use-module (web uri)
#:export (prettify
avatar-color
+ download-icon
display-message-body
time->string))