Add handler for downloading patch sets.

2 files changed, 68 insertions, 3 deletions

diff --git a/mumi/messages.scm b/mumi/messages.scm
index 25425a3..4a63673 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -1,5 +1,5 @@
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
@@ -23,6 +23,7 @@
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 threads)
@@ -54,7 +55,9 @@
             closing?
             bot?
             internal-message?
+            patch-message?
 
+            patch-messages
             issue-messages
             process-query))
 
@@ -142,6 +145,12 @@ yet.  Return new results alongside cached results."
 (define (internal-message? message)
   (bot? (sender-email message)))
 
+(define* (patch-message? message #:optional patch-set-number)
+  (let ((prefix (if patch-set-number
+                    (format #false "[PATCH v~a" patch-set-number)
+                    "[PATCH")))
+    (string-prefix? prefix (subject message))))
+
 
 (define (multipart-message? message)
   (eq? (assoc-ref (header message 'content-type)
@@ -200,6 +209,47 @@ result for a while."
                       read-emails-from-bug-log))))
       '()))
 
+(define* (patch-messages id #:optional patch-set)
+  "Return a string corresponding to the patch messages in the provided
+PATCH-SET.  If PATCH-SET is not provided, return all patches."
+  (define (get-emails file)
+    (call-with-input-file file
+      (cut read-emails-from-bug-log <> #:raw? #true)))
+  (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))))
+  (define pat (make-regexp "^From" regexp/newline))
+  (let* ((messages (issue-messages id))
+         (total (length messages))
+         (messages-with-numbers
+          (zip (iota total) messages))
+         (message-numbers
+          (map first
+               (sort (filter (match-lambda
+                               ((number message)
+                                (patch-message? message patch-set)))
+                             messages-with-numbers)
+                     ;; Sort by subject to ensure that patches are in
+                     ;; order even if they were received out of order.
+                     (lambda (a b)
+                       (match (list a b)
+                         (((a-number a-message)
+                           (b-number b-message))
+                          (string< (subject a-message)
+                                   (subject b-message)))))))))
+    (string-join (map (lambda (message-number)
+                        (let ((text (list-ref emails message-number)))
+                          (match (regexp-exec pat text)
+                            (#false text)
+                            (m
+                             (string-drop text (match:start m 0))))))
+                      message-numbers)
+                 "\n")))
+
 (define* (search-bugs query #:key (sets '()) (max 400))
   "Return a list of all bugs matching the given QUERY string.
 Intersect the result with the id sets in the list SETS."
diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm
index efa5c74..bffc26c 100644
--- a/mumi/web/controller.scm
+++ b/mumi/web/controller.scm
@@ -1,5 +1,5 @@
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 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
@@ -17,7 +17,7 @@
 
 (define-module (mumi web controller)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (web request)
@@ -168,6 +168,21 @@
                       (string->number msg-num)
                       (map string->number path)))
     (('GET "issue" (? string->number id)
+           "patch-set" . patch-set-num)
+     (let* ((patch-set-num* (match patch-set-num
+                              (() #false)
+                              ((f . rest) f)))
+            (content (patch-messages id patch-set-num*)))
+       (if content
+           (list `((content-type text)
+                   (content-disposition
+                    text/plain
+                    (filename
+                     . ,(format #f "~a-patch-set~:[-~a~;~].mbox"
+                                id patch-set-num* patch-set-num*))))
+                 content)
+           (not-found (request-uri request)))))
+    (('GET "issue" (? string->number id)
            "raw" (? string->number msg-num))
      (download-raw (string->number id)
                    (string->number msg-num)))