[bug#63802] [mumi PATCH 2/3] client: Add git-send-email-headers subcommand.

[Arun Isaac]

* mumi/client.scm: Import (rnrs exceptions).
(git-send-email-headers): New public function.
* scripts/mumi.in: Add git-send-email-headers subcommand.
---
 mumi/client.scm | 42 +++++++++++++++++++++++++++++++++++++++++-
 scripts/mumi.in |  2 ++
 2 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index 5befd42..c70fe61 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -17,6 +17,7 @@
 ;;; along with mumi.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (mumi client)
+  #:use-module (rnrs exceptions)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
@@ -38,7 +39,9 @@
             print-current-issue
             set-current-issue!
             clear-current-issue!
-            send-email))
+            send-email
+            git-send-email-headers
+            compose))
 
 (define (git-top-level)
   "Return the top-level directory of the current git repository."
@@ -306,3 +309,40 @@ ISSUE-NUMBER."
                          "@"
                          (client-config 'debbugs-host))
           other-patches)))))
+
+(define (git-send-email-headers patch)
+  "Print send-email headers for PATCH."
+  (let* (;; Compute headers if configured in git config.
+         (header-command
+          (guard (ex (#t #f))
+            (call-with-input-pipe* (list "git" "config" "sendemail.headerCmd")
+              get-line)))
+         (headers
+          (if header-command
+              (call-with-input-pipe (string-append header-command " " patch)
+                get-string-all)
+              ""))
+         (external-x-debbugs-cc
+          (assq-ref (parse-email-headers
+                     (string-append (string-trim-right headers #\newline)
+                                    "\n"))
+                    'x-debbugs-cc))
+         ;; Fetch Cc addresses for current issue.
+         (x-debbugs-cc
+          (assq-ref (reply-email-headers (current-issue-number))
+                    'cc)))
+    ;; Print X-Debbugs-Cc header.
+    (when (or x-debbugs-cc external-x-debbugs-cc)
+      (display "X-Debbugs-Cc: ")
+      (display (if (and x-debbugs-cc external-x-debbugs-cc)
+                   (string-append x-debbugs-cc ", " external-x-debbugs-cc)
+                   (or x-debbugs-cc external-x-debbugs-cc)))
+      (newline))
+    ;; Print headers other than X-Debbugs-Cc.
+    ;; TODO: RFC5322 headers are not restricted to a single
+    ;; line. "Folded" multi-line headers are allowed. Support them.
+    (for-each (lambda (line)
+                (unless (string-prefix-ci? "X-Debbugs-Cc:" line)
+                  (display line)
+                  (newline)))
+              (string-split headers #\newline))))
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 2295328..8fb7cd4 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -163,6 +163,8 @@
    (client:clear-current-issue!))
   (("send-email" . patches)
    (client:send-email patches))
+  (("git-send-email-headers" patch)
+   (client:git-send-email-headers patch))
   (("mailer" . rest)
    (let* ((opts (parse-options rest))
           (sender (assoc-ref opts 'sender))
-- 
2.39.2