From 9f070bd90adc67064cd8aff4e40f303d5957ef4a Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 31 Mar 2021 16:18:16 +0200 Subject: Add handler for downloading patch sets. --- mumi/messages.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++- mumi/web/controller.scm | 19 ++++++++++++++++-- 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 +;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus ;;; Copyright © 2018, 2019 Arun Isaac ;;; ;;; 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 +;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus ;;; ;;; 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) @@ -167,6 +167,21 @@ (handle-download (string->number id) (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) -- cgit v1.2.3