[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Arun Isaac]

Hi,

With this patchset, mumi invokes teams.scm and combines its
X-Debbugs-Cc with that produced by teams.scm. Thus, there is only a
single consolidated X-Debbugs-Cc header in the outgoing email. This is
achieved by providing a new `mumi git-send-email-headers' subcommand
that is passed to `git send-email` via --header-cmd.

I'm Ccing Maxim as this is related to
https://issues.guix.gnu.org/63378

Regards,
Arun

Arun Isaac (3):
  client: Do not pass --add-header to git send-email.
  client: Add git-send-email-headers subcommand.
  client: Use mumi git-send-email-headers subcommand.

 mumi/client.scm  | 52 ++++++++++++++++++++++++++++++++++++++++++------
 scripts/mumi.in  |  4 +++-
 tests/client.scm | 19 ++++++++++++------
 3 files changed, 62 insertions(+), 13 deletions(-)

-- 
2.39.2

[bug#63802] [mumi PATCH 1/3] client: Do not pass --add-header to git send-email.

[Arun Isaac]

git send-email accepts --add-header only when passed a git
format-patch style revision list.

* mumi/client.scm (send-email): Do not pass --add-header to
git-send-email.
* tests/client.scm ("send patch to existing issue and Cc other
participants"): Do not expect --add-header.
---
 mumi/client.scm  | 5 +----
 tests/client.scm | 6 +-----
 2 files changed, 2 insertions(+), 9 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index b575daa..5befd42 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -287,10 +287,7 @@ ISSUE-NUMBER."
         (git-send-email (string-append (number->string issue-number)
                                        "@"
                                        (client-config 'debbugs-host))
-                        patches
-                        (map (cut string-append "--add-header=X-Debbugs-Cc: " <>)
-                             (assq-ref (reply-email-headers issue-number)
-                                       'cc))))
+                        patches))
       (match patches
         ;; If it's a single patch, send it to the patch email address
         ;; and be done with it
diff --git a/tests/client.scm b/tests/client.scm
index 5729521..5352b08 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -126,11 +126,7 @@ called with."
                   (list "foo.patch")))))))
 
 (test-equal "send patch to existing issue and Cc other participants"
-  '(("git" "send-email"
-     "--to=12345@example.com"
-     "--add-header=X-Debbugs-Cc: John Doe <jdoe@machine.example>"
-     "--add-header=X-Debbugs-Cc: Mary Smith <mary@example.net>"
-     "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
-- 
2.39.2

[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

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

[Maxim Cournoyer]

Hi Arun,

Arun Isaac <arunisaac@systemreboot.net> writes:

> * 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)))

I find the or/if/and/or mix here a bit dense to parse.  I think it'd be
a cleaner and easier to follow to process external-x-debbugs-cc and
x-debbug-cc into a list of values (potentially '()), merge then,
deduplicate them, and finally string-join them back before displaying
the combined value.

What do you think?

-- 
Thanks,
Maxim

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

[Arun Isaac]

> I find the or/if/and/or mix here a bit dense to parse.  I think it'd be
> a cleaner and easier to follow to process external-x-debbugs-cc and
> x-debbug-cc into a list of values (potentially '()), merge then,
> deduplicate them, and finally string-join them back before displaying
> the combined value.

Good point! I avoided splitting and joining due to the complexity of
handling the escaping of commas in names. But, I have done it now, and
it does make the code a lot clearer. Patches follow subsequently.

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

[Arun Isaac]

Note that, last week, I pushed "client: Do not pass --add-header to git
send-email." from the previous patchset. It was urgently required for
deploying the latest mumi on berlin.

In the latest patchset I have sent today, I have added a new commit
"client: Separate serialize-email-address into a function.". So, there
are still 3 patches in total.

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

[Arun Isaac]

* mumi/client.scm (send-email): Accept mumi-arg0 argument and
use it to construct --header-cmd.
* scripts/mumi.in: Pass arg0 to send-email.
* tests/client.scm ("send patches to new issue", "send patches to
existing issue", "send single patch to new issue", "send single patch
to existing issue", "send patch to existing issue and Cc other
participants"): Adjust tests.
---
 mumi/client.scm  |  9 ++++++---
 scripts/mumi.in  |  2 +-
 tests/client.scm | 17 ++++++++++++++---
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index c70fe61..9cb2bd8 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -281,8 +281,9 @@ ISSUE-NUMBER."
           (() (list))
           (cc (list (cons 'cc (string-join cc ", "))))))))
 
-(define (send-email patches)
-  "Send PATCHES via email."
+(define (send-email mumi-arg0 patches)
+  "Send PATCHES via email. MUMI-ARG0 is the mumi program currently
+invoked."
   (if (current-issue-number)
       ;; If an issue is current, send patches to that issue's email
       ;; address.
@@ -290,7 +291,9 @@ ISSUE-NUMBER."
         (git-send-email (string-append (number->string issue-number)
                                        "@"
                                        (client-config 'debbugs-host))
-                        patches))
+                        patches
+                        (list (string-append "--header-cmd="
+                                             mumi-arg0 " git-send-email-headers"))))
       (match patches
         ;; If it's a single patch, send it to the patch email address
         ;; and be done with it
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 8fb7cd4..5b98634 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -162,7 +162,7 @@
   (("new")
    (client:clear-current-issue!))
   (("send-email" . patches)
-   (client:send-email patches))
+   (client:send-email (car (program-arguments)) patches))
   (("git-send-email-headers" patch)
    (client:git-send-email-headers patch))
   (("mailer" . rest)
diff --git a/tests/client.scm b/tests/client.scm
index 5352b08..fa80dad 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -80,10 +80,13 @@ called with."
                                        (const 12345))
                                  client-config-stub)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send patches to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch" "bar.patch" "foobar.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -95,6 +98,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send single patch to new issue"
@@ -108,10 +112,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send single patch to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -123,10 +130,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send patch to existing issue and Cc other participants"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -138,6 +148,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-end "client")
-- 
2.39.2

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

[Maxim Cournoyer]

Hi Arun,

Arun Isaac <arunisaac@systemreboot.net> writes:

> * mumi/client.scm (send-email): Accept mumi-arg0 argument and
> use it to construct --header-cmd.
> * scripts/mumi.in: Pass arg0 to send-email.
> * tests/client.scm ("send patches to new issue", "send patches to
> existing issue", "send single patch to new issue", "send single patch
> to existing issue", "send patch to existing issue and Cc other
> participants"): Adjust tests.
> ---
>  mumi/client.scm  |  9 ++++++---
>  scripts/mumi.in  |  2 +-
>  tests/client.scm | 17 ++++++++++++++---
>  3 files changed, 21 insertions(+), 7 deletions(-)
>
> diff --git a/mumi/client.scm b/mumi/client.scm
> index c70fe61..9cb2bd8 100644
> --- a/mumi/client.scm
> +++ b/mumi/client.scm
> @@ -281,8 +281,9 @@ ISSUE-NUMBER."
>            (() (list))
>            (cc (list (cons 'cc (string-join cc ", "))))))))
>  
> -(define (send-email patches)
> -  "Send PATCHES via email."
> +(define (send-email mumi-arg0 patches)
> +  "Send PATCHES via email. MUMI-ARG0 is the mumi program currently
> +invoked."
>    (if (current-issue-number)
>        ;; If an issue is current, send patches to that issue's email
>        ;; address.
> @@ -290,7 +291,9 @@ ISSUE-NUMBER."
>          (git-send-email (string-append (number->string issue-number)
>                                         "@"
>                                         (client-config 'debbugs-host))
> -                        patches))
> +                        patches
> +                        (list (string-append "--header-cmd="
> +                                             mumi-arg0 " git-send-email-headers"))))
>        (match patches
>          ;; If it's a single patch, send it to the patch email address
>          ;; and be done with it
> diff --git a/scripts/mumi.in b/scripts/mumi.in
> index 8fb7cd4..5b98634 100644
> --- a/scripts/mumi.in
> +++ b/scripts/mumi.in
> @@ -162,7 +162,7 @@
>    (("new")
>     (client:clear-current-issue!))
>    (("send-email" . patches)
> -   (client:send-email patches))
> +   (client:send-email (car (program-arguments)) patches))
>    (("git-send-email-headers" patch)
>     (client:git-send-email-headers patch))
>    (("mailer" . rest)
> diff --git a/tests/client.scm b/tests/client.scm
> index 5352b08..fa80dad 100644
> --- a/tests/client.scm
> +++ b/tests/client.scm
> @@ -80,10 +80,13 @@ called with."
>                                         (const 12345))
>                                   client-config-stub)
>               (cut (@@ (mumi client) send-email)
> +                  "mumi"
>                    (list "foo.patch" "bar.patch" "foobar.patch")))))))
>  
>  (test-equal "send patches to existing issue"
> -  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.patch"))
> +  '(("git" "send-email" "--to=12345@example.com"
> +     "--header-cmd=mumi git-send-email-headers"
> +     "foo.patch" "bar.patch" "foobar.patch"))
>    (map (match-lambda
>           ((command _) command))
>         (trace-calls (var@@ (mumi client) call-with-input-pipe*)
> @@ -95,6 +98,7 @@ called with."
>                                   client-config-stub
>                                   do-not-poll-server-for-issue-number)
>               (cut (@@ (mumi client) send-email)
> +                  "mumi"
>                    (list "foo.patch" "bar.patch" "foobar.patch")))))))
>  
>  (test-equal "send single patch to new issue"
> @@ -108,10 +112,13 @@ called with."
>                                   client-config-stub
>                                   do-not-poll-server-for-issue-number)
>               (cut (@@ (mumi client) send-email)
> +                  "mumi"
>                    (list "foo.patch")))))))
>  
>  (test-equal "send single patch to existing issue"
> -  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
> +  '(("git" "send-email" "--to=12345@example.com"
> +     "--header-cmd=mumi git-send-email-headers"
> +     "foo.patch"))
>    (map (match-lambda
>           ((command _) command))
>         (trace-calls (var@@ (mumi client) call-with-input-pipe*)
> @@ -123,10 +130,13 @@ called with."
>                                   client-config-stub
>                                   do-not-poll-server-for-issue-number)
>               (cut (@@ (mumi client) send-email)
> +                  "mumi"
>                    (list "foo.patch")))))))
>  
>  (test-equal "send patch to existing issue and Cc other participants"
> -  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
> +  '(("git" "send-email" "--to=12345@example.com"
> +     "--header-cmd=mumi git-send-email-headers"
> +     "foo.patch"))
>    (map (match-lambda
>           ((command _) command))
>         (trace-calls (var@@ (mumi client) call-with-input-pipe*)
> @@ -138,6 +148,7 @@ called with."
>                                   client-config-stub
>                                   do-not-poll-server-for-issue-number)
>               (cut (@@ (mumi client) send-email)
> +                  "mumi"
>                    (list "foo.patch")))))))
>  
>  (test-end "client")

Fun!  So mumi now implements its own git 'header command', which builds
on top of any pre-configured one such as etc/teams.scm, then overrides
said pre-configured headerCmd with itself.

LGTM.

-- 
Thanks,
Maxim

[bug#63802] [mumi PATCH 1/3] client: Do not pass --add-header to git send-email.

[Maxim Cournoyer]

Hi Arun!

Arun Isaac <arunisaac@systemreboot.net> writes:

> git send-email accepts --add-header only when passed a git
> format-patch style revision list.

LGTM.  The idea is that this is now handled by a configured git
'add-header-cmd' such as Guix' etc/teams.scm, correct?

-- 
Thanks,
Maxim

[bug#63802] [PATCH 1/3] client: Separate serialize-email-address into a function.

[Arun Isaac]

* mumi/client.scm (serialize-email-address): New function.
(reply-email-headers): Use serialize-email-address.
* tests/client.scm (serialize-email-address): New variable.
("serialize email address", "serialize email address with comma in
name"): New tests.
---
 mumi/client.scm  | 14 ++++++++++----
 tests/client.scm | 11 +++++++++++
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index 64ccbeb..c30429d 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -221,6 +221,14 @@ arguments."
            (unless (zero? (close-pipe port))
              (error "Command invocation failed" command))))))))
 
+(define (serialize-email-address name address)
+  "Combine NAME and ADDRESS into a complete email address of the form
+\"NAME <ADDRESS>\". Double quote NAME if necessary."
+  (string-append (if (string-contains name ",")
+                     (string-append "\"" name "\"")
+                     name)
+                 " <" address ">"))
+
 
 (define* (git-send-email to patches #:optional (options '()))
   "Send PATCHES using git send-email to the TO address with
@@ -269,10 +277,8 @@ ISSUE-NUMBER."
       ,@(match (delete-duplicates
                 (map (lambda (message)
                        (let ((from (assoc-ref message "from")))
-                         (string-append (if (string-contains (assoc-ref from "name") ",")
-                                            (string-append "\"" (assoc-ref from "name") "\"")
-                                            (assoc-ref from "name"))
-                                        " <" (assoc-ref from "address") ">")))
+                         (serialize-email-address (assoc-ref from "name")
+                                                  (assoc-ref from "address"))))
                      (vector->list (assoc-ref issue "messages"))))
           (() (list))
           (cc (list (cons 'cc (string-join cc ", "))))))))
diff --git a/tests/client.scm b/tests/client.scm
index 5352b08..2b2c1be 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -65,8 +65,19 @@ called with."
         (lambda _
           (error "Do not poll server for issue number"))))
 
+(define serialize-email-address
+  (@@ (mumi client) serialize-email-address))
+
 (test-begin "client")
 
+(test-equal "serialize email address"
+  "Foo <foo@example.com>"
+  (serialize-email-address "Foo" "foo@example.com"))
+
+(test-equal "serialize email address with comma in name"
+  "\"Bar, Foo\" <foobar@example.com>"
+  (serialize-email-address "Bar, Foo" "foobar@example.com"))
+
 (test-equal "send patches to new issue"
   '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
     ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
-- 
2.39.2

[bug#63802] [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.
(split-cc): New function.
* scripts/mumi.in: Add git-send-email-headers subcommand.
* tests/client.scm (split-cc): New variable.
("split Cc field"): New test.
---
 mumi/client.scm  | 52 +++++++++++++++++++++++++++++++++++++++++++++++-
 scripts/mumi.in  |  2 ++
 tests/client.scm |  8 ++++++++
 3 files changed, 61 insertions(+), 1 deletion(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index c30429d..b89e608 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."
@@ -229,6 +232,13 @@ arguments."
                      name)
                  " <" address ">"))
 
+(define (split-cc cc)
+  "Split CC into a list of email addresses."
+  (map (lambda (address)
+         (serialize-email-address (assq-ref address 'name)
+                                  (assq-ref address 'address)))
+       (assq-ref (parse-email-headers (string-append "Cc: " cc "\n"))
+                 'cc)))
 
 (define* (git-send-email to patches #:optional (options '()))
   "Send PATCHES using git send-email to the TO address with
@@ -311,3 +321,43 @@ 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
+          (cond
+           ((assq-ref (parse-email-headers (string-append headers "\n"))
+                       'x-debbugs-cc)
+            => split-cc)
+           (else '())))
+         ;; Fetch Cc addresses for current issue.
+         (x-debbugs-cc
+          (cond
+           ((assq-ref (reply-email-headers (current-issue-number))
+                       'cc)
+            => split-cc)
+           (else '()))))
+    ;; Print X-Debbugs-Cc header.
+    (display "X-Debbugs-Cc: ")
+    (display (string-join (delete-duplicates
+                           (append 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))
diff --git a/tests/client.scm b/tests/client.scm
index 2b2c1be..ced573b 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -68,6 +68,9 @@ called with."
 (define serialize-email-address
   (@@ (mumi client) serialize-email-address))
 
+(define split-cc
+  (@@ (mumi client) split-cc))
+
 (test-begin "client")
 
 (test-equal "serialize email address"
@@ -78,6 +81,11 @@ called with."
   "\"Bar, Foo\" <foobar@example.com>"
   (serialize-email-address "Bar, Foo" "foobar@example.com"))
 
+(test-equal "split Cc field"
+  (list "Foo <foo@example.com>"
+        "\"Bar, Foo\" <foobar@example.com>")
+  (split-cc "Foo <foo@example.com>, \"Bar, Foo\" <foobar@example.com>"))
+
 (test-equal "send patches to new issue"
   '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
     ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
-- 
2.39.2

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Maxim Cournoyer]

Hello,

Arun Isaac <arunisaac@systemreboot.net> writes:

> * mumi/client.scm: Import (rnrs exceptions).
> (git-send-email-headers): New public function.
> (split-cc): New function.

nitpick: I guess these should be called 'procedures', which seems to be
the preferred term in Scheme (ironically enough for a functional
language?  eh!).  CC'ing Ludovic in case they have some thoughts on the
matter, as I think they were the one originally teaching me that.

If that was just me, intuitively I'd use 'procedure' for something
involving side effects while 'function' as something taking an input and
always returning the same output, without side effects (pure function),
but that doesn't seem to be the prevalent style in the Scheme community.

> * scripts/mumi.in: Add git-send-email-headers subcommand.
> * tests/client.scm (split-cc): New variable.
> ("split Cc field"): New test.
> ---
>  mumi/client.scm  | 52 +++++++++++++++++++++++++++++++++++++++++++++++-
>  scripts/mumi.in  |  2 ++
>  tests/client.scm |  8 ++++++++
>  3 files changed, 61 insertions(+), 1 deletion(-)
>
> diff --git a/mumi/client.scm b/mumi/client.scm
> index c30429d..b89e608 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))

I think you've exported 'compose' erroneously here.

>  (define (git-top-level)
>    "Return the top-level directory of the current git repository."
> @@ -229,6 +232,13 @@ arguments."
>                       name)
>                   " <" address ">"))
>  
> +(define (split-cc cc)
> +  "Split CC into a list of email addresses."
> +  (map (lambda (address)
> +         (serialize-email-address (assq-ref address 'name)
> +                                  (assq-ref address 'address)))
> +       (assq-ref (parse-email-headers (string-append "Cc: " cc "\n"))
> +                 'cc)))
>  
>  (define* (git-send-email to patches #:optional (options '()))
>    "Send PATCHES using git send-email to the TO address with
> @@ -311,3 +321,43 @@ 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)))

Ain't this guard equivalent to '(false-if-exception
(call-with-input-pipe* ...))' ? I find the later more readable if yes,
but: does call-with-input-pipe* raise an exception when git is available
but 'sendemail.headerCmd' not set, thus exiting with status 1?  I wasn't
able to find its documentation in the Guile Reference manual.  Otherwise
you'd get header-command set to the empty string, which seems like it'd
be a problem...

> +         (headers
> +          (if header-command
> +              (call-with-input-pipe (string-append header-command " " patch)

                  ^ ... here.  Also, why the mixed use of
                  'call-with-input-pipe*' and 'call-with-input-pipe'?  I'd
                  stick with the former.
                  
> +                get-string-all)
> +              ""))
> +         (external-x-debbugs-cc
> +          (cond
> +           ((assq-ref (parse-email-headers (string-append headers "\n"))
> +                       'x-debbugs-cc)
> +            => split-cc)
> +           (else '())))
> +         ;; Fetch Cc addresses for current issue.
> +         (x-debbugs-cc
> +          (cond
> +           ((assq-ref (reply-email-headers (current-issue-number))
> +                       'cc)
> +            => split-cc)
> +           (else '()))))
> +    ;; Print X-Debbugs-Cc header.
> +    (display "X-Debbugs-Cc: ")
> +    (display (string-join (delete-duplicates
> +                           (append 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))
> diff --git a/tests/client.scm b/tests/client.scm
> index 2b2c1be..ced573b 100644
> --- a/tests/client.scm
> +++ b/tests/client.scm
> @@ -68,6 +68,9 @@ called with."
>  (define serialize-email-address
>    (@@ (mumi client) serialize-email-address))
>  
> +(define split-cc
> +  (@@ (mumi client) split-cc))
> +
>  (test-begin "client")
>  
>  (test-equal "serialize email address"
> @@ -78,6 +81,11 @@ called with."
>    "\"Bar, Foo\" <foobar@example.com>"
>    (serialize-email-address "Bar, Foo" "foobar@example.com"))
>  
> +(test-equal "split Cc field"
> +  (list "Foo <foo@example.com>"
> +        "\"Bar, Foo\" <foobar@example.com>")
> +  (split-cc "Foo <foo@example.com>, \"Bar, Foo\" <foobar@example.com>"))
> +
>  (test-equal "send patches to new issue"
>    '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
>      ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))

The rest LGTM.

-- 
Thanks,
Maxim

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Arun Isaac]

Hi Maxim,

> nitpick: I guess these should be called 'procedures', which seems to be
> the preferred term in Scheme (ironically enough for a functional
> language?  eh!).  CC'ing Ludovic in case they have some thoughts on the
> matter, as I think they were the one originally teaching me that.
>
> If that was just me, intuitively I'd use 'procedure' for something
> involving side effects while 'function' as something taking an input and
> always returning the same output, without side effects (pure function),
> but that doesn't seem to be the prevalent style in the Scheme
> community.

Exactly, that was my intuition too. Maybe, we should break with
tradition! :-) In any case, I have changed all instances of "function"
to "procedure".

>> +            git-send-email-headers
>> +            compose))
>
> I think you've exported 'compose' erroneously here.

Good catch! compose is part of a new "mumi compose" feature I am working
on. I had accidentally committed it. I have removed it from this commit.

Now that you mention it, maybe I should call it compose-email so as to
not conflict with compose from guile core.

>> +(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)))
>
> Ain't this guard equivalent to '(false-if-exception
> (call-with-input-pipe* ...))' ? I find the later more readable if yes,

Good point! I was not aware of false-if-exception. I have changed to
using it now.

> but: does call-with-input-pipe* raise an exception when git is available
> but 'sendemail.headerCmd' not set, thus exiting with status 1?  I wasn't
> able to find its documentation in the Guile Reference manual.

call-with-input-pipe* and call-with-input-pipe are both defined in
mumi/client.scm. They are not part of guile. The only difference between
them is whether they accept the command as a string or as a list of
arguments---thus, they parallel open-pipe and open-pipe*.

> Otherwise you'd get header-command set to the empty string, which
> seems like it'd be a problem...

call-with-input-pipe* does raise an exception when git is available but
sendemail.headerCmd is not set. I checked. So, this is not a problem.

>> +         (headers
>> +          (if header-command
>> +              (call-with-input-pipe (string-append header-command " " patch)
>
>                   ^ ... here.  Also, why the mixed use of
>                   'call-with-input-pipe*' and 'call-with-input-pipe'?  I'd
>                   stick with the former.

sendemail.headerCmd is only available to us as a string, and not as a
list of arguments. It is quite non-trivial to correctly split the string
back into a list of arguments. That would require correct handling of
quotes like the shell does. So, we use call-with-input-pipe to handle
this case.

But everywhere else (such as when invoking "git config
sendemail.headerCmd"), we prefer to pass commands as a list of
arguments. So, we need call-with-input-pipe*.

I understand it's a bit confusing to have two very similar
functions. But, the only possible compromise is to use
call-with-input-pipe everywhere. Should I make that compromise? WDYT?

Thanks for the review!

Regards,
Arun

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Maxim Cournoyer]

Hello,

Arun Isaac <arunisaac@systemreboot.net> writes:


[...]

>>> +            git-send-email-headers
>>> +            compose))
>>
>> I think you've exported 'compose' erroneously here.
>
> Good catch! compose is part of a new "mumi compose" feature I am working
> on. I had accidentally committed it. I have removed it from this commit.
>
> Now that you mention it, maybe I should call it compose-email so as to
> not conflict with compose from guile core.

Good idea!  Shadowing builtins should be avoided; the warnings are
annoying and require the use of #:hide on imports (and the code more
confusing to read).

[...]

>> but: does call-with-input-pipe* raise an exception when git is available
>> but 'sendemail.headerCmd' not set, thus exiting with status 1?  I wasn't
>> able to find its documentation in the Guile Reference manual.
>
> call-with-input-pipe* and call-with-input-pipe are both defined in
> mumi/client.scm. They are not part of guile. The only difference between
> them is whether they accept the command as a string or as a list of
> arguments---thus, they parallel open-pipe and open-pipe*.
>
>> Otherwise you'd get header-command set to the empty string, which
>> seems like it'd be a problem...
>
> call-with-input-pipe* does raise an exception when git is available but
> sendemail.headerCmd is not set. I checked. So, this is not a problem.

Good, thanks for checking.

>>> +         (headers
>>> +          (if header-command
>>> +              (call-with-input-pipe (string-append header-command " " patch)
>>
>>                   ^ ... here.  Also, why the mixed use of
>>                   'call-with-input-pipe*' and 'call-with-input-pipe'?  I'd
>>                   stick with the former.
>
> sendemail.headerCmd is only available to us as a string, and not as a
> list of arguments. It is quite non-trivial to correctly split the string
> back into a list of arguments. That would require correct handling of
> quotes like the shell does. So, we use call-with-input-pipe to handle
> this case.

Ah, I see.  It's reasonable then to use it as is.

> But everywhere else (such as when invoking "git config
> sendemail.headerCmd"), we prefer to pass commands as a list of
> arguments. So, we need call-with-input-pipe*.
>
> I understand it's a bit confusing to have two very similar
> functions. But, the only possible compromise is to use
> call-with-input-pipe everywhere. Should I make that compromise? WDYT?

No, just the explanation here (and a possible comment in the source
mirroring it) is enough!

LGTM.

-- 
Thanks,
Maxim

bug#63802: [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Arun Isaac]

> Good idea!  Shadowing builtins should be avoided; the warnings are
> annoying and require the use of #:hide on imports (and the code more
> confusing to read).

I definitely agree. I was engrossed in writing mumi-compose, and quite
forgot about the builtin compose.

> No, just the explanation here (and a possible comment in the source
> mirroring it) is enough!

Done, and pushed!

Thanks!

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

[Arun Isaac]

* mumi/client.scm (send-email): Accept mumi-arg0 argument and
use it to construct --header-cmd.
* scripts/mumi.in: Pass arg0 to send-email.
* tests/client.scm ("send patches to new issue", "send patches to
existing issue", "send single patch to new issue", "send single patch
to existing issue", "send patch to existing issue and Cc other
participants"): Adjust tests.
---
 mumi/client.scm  |  9 ++++++---
 scripts/mumi.in  |  2 +-
 tests/client.scm | 17 ++++++++++++++---
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index b89e608..1fe9d2c 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -293,8 +293,9 @@ ISSUE-NUMBER."
           (() (list))
           (cc (list (cons 'cc (string-join cc ", "))))))))
 
-(define (send-email patches)
-  "Send PATCHES via email."
+(define (send-email mumi-arg0 patches)
+  "Send PATCHES via email. MUMI-ARG0 is the mumi program currently
+invoked."
   (if (current-issue-number)
       ;; If an issue is current, send patches to that issue's email
       ;; address.
@@ -302,7 +303,9 @@ ISSUE-NUMBER."
         (git-send-email (string-append (number->string issue-number)
                                        "@"
                                        (client-config 'debbugs-host))
-                        patches))
+                        patches
+                        (list (string-append "--header-cmd="
+                                             mumi-arg0 " git-send-email-headers"))))
       (match patches
         ;; If it's a single patch, send it to the patch email address
         ;; and be done with it
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 8fb7cd4..5b98634 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -162,7 +162,7 @@
   (("new")
    (client:clear-current-issue!))
   (("send-email" . patches)
-   (client:send-email patches))
+   (client:send-email (car (program-arguments)) patches))
   (("git-send-email-headers" patch)
    (client:git-send-email-headers patch))
   (("mailer" . rest)
diff --git a/tests/client.scm b/tests/client.scm
index ced573b..d28bc1a 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -99,10 +99,13 @@ called with."
                                        (const 12345))
                                  client-config-stub)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send patches to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch" "bar.patch" "foobar.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -114,6 +117,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send single patch to new issue"
@@ -127,10 +131,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send single patch to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -142,10 +149,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send patch to existing issue and Cc other participants"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -157,6 +167,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-end "client")
-- 
2.39.2

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Maxim Cournoyer]

Hi,

Arun Isaac <arunisaac@systemreboot.net> writes:

> * mumi/client.scm (send-email): Accept mumi-arg0 argument and
> use it to construct --header-cmd.
> * scripts/mumi.in: Pass arg0 to send-email.
> * tests/client.scm ("send patches to new issue", "send patches to
> existing issue", "send single patch to new issue", "send single patch
> to existing issue", "send patch to existing issue and Cc other
> participants"): Adjust tests.

I'd maybe just call mumi-arg0 'mumi-command' or similar, but otherwise,
LGTM!

-- 
Thanks,
Maxim

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Arun Isaac]

> I'd maybe just call mumi-arg0 'mumi-command' or similar, but otherwise,
> LGTM!

Done!

[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Maxim Cournoyer]

Hi Arun!

Arun Isaac <arunisaac@systemreboot.net> writes:

> * mumi/client.scm (serialize-email-address): New function.
> (reply-email-headers): Use serialize-email-address.
> * tests/client.scm (serialize-email-address): New variable.
> ("serialize email address", "serialize email address with comma in
> name"): New tests.

LGTM!

-- 
Thanks,
Maxim

[bug#63802] [PATCH 1/3] client: Separate serialize-email-address into a procedure.

[Arun Isaac]

* mumi/client.scm (serialize-email-address): New procedure.
(reply-email-headers): Use serialize-email-address.
* tests/client.scm (serialize-email-address): New variable.
("serialize email address", "serialize email address with comma in
name"): New tests.
---
 mumi/client.scm  | 14 ++++++++++----
 tests/client.scm | 11 +++++++++++
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index 64ccbeb..c30429d 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -221,6 +221,14 @@ arguments."
            (unless (zero? (close-pipe port))
              (error "Command invocation failed" command))))))))
 
+(define (serialize-email-address name address)
+  "Combine NAME and ADDRESS into a complete email address of the form
+\"NAME <ADDRESS>\". Double quote NAME if necessary."
+  (string-append (if (string-contains name ",")
+                     (string-append "\"" name "\"")
+                     name)
+                 " <" address ">"))
+
 
 (define* (git-send-email to patches #:optional (options '()))
   "Send PATCHES using git send-email to the TO address with
@@ -269,10 +277,8 @@ ISSUE-NUMBER."
       ,@(match (delete-duplicates
                 (map (lambda (message)
                        (let ((from (assoc-ref message "from")))
-                         (string-append (if (string-contains (assoc-ref from "name") ",")
-                                            (string-append "\"" (assoc-ref from "name") "\"")
-                                            (assoc-ref from "name"))
-                                        " <" (assoc-ref from "address") ">")))
+                         (serialize-email-address (assoc-ref from "name")
+                                                  (assoc-ref from "address"))))
                      (vector->list (assoc-ref issue "messages"))))
           (() (list))
           (cc (list (cons 'cc (string-join cc ", "))))))))
diff --git a/tests/client.scm b/tests/client.scm
index 5352b08..2b2c1be 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -65,8 +65,19 @@ called with."
         (lambda _
           (error "Do not poll server for issue number"))))
 
+(define serialize-email-address
+  (@@ (mumi client) serialize-email-address))
+
 (test-begin "client")
 
+(test-equal "serialize email address"
+  "Foo <foo@example.com>"
+  (serialize-email-address "Foo" "foo@example.com"))
+
+(test-equal "serialize email address with comma in name"
+  "\"Bar, Foo\" <foobar@example.com>"
+  (serialize-email-address "Bar, Foo" "foobar@example.com"))
+
 (test-equal "send patches to new issue"
   '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
     ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
-- 
2.39.2

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

[Arun Isaac]

* mumi/client.scm: Import (rnrs exceptions).
(git-send-email-headers): New public procedure.
(split-cc): New procedure.
* scripts/mumi.in: Add git-send-email-headers subcommand.
* tests/client.scm (split-cc): New variable.
("split Cc field"): New test.
---
 mumi/client.scm  | 51 +++++++++++++++++++++++++++++++++++++++++++++++-
 scripts/mumi.in  |  2 ++
 tests/client.scm |  8 ++++++++
 3 files changed, 60 insertions(+), 1 deletion(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index c30429d..797ec91 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,8 @@
             print-current-issue
             set-current-issue!
             clear-current-issue!
-            send-email))
+            send-email
+            git-send-email-headers))
 
 (define (git-top-level)
   "Return the top-level directory of the current git repository."
@@ -229,6 +231,13 @@ arguments."
                      name)
                  " <" address ">"))
 
+(define (split-cc cc)
+  "Split CC into a list of email addresses."
+  (map (lambda (address)
+         (serialize-email-address (assq-ref address 'name)
+                                  (assq-ref address 'address)))
+       (assq-ref (parse-email-headers (string-append "Cc: " cc "\n"))
+                 'cc)))
 
 (define* (git-send-email to patches #:optional (options '()))
   "Send PATCHES using git send-email to the TO address with
@@ -311,3 +320,43 @@ 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
+          (false-if-exception
+            (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
+          (cond
+           ((assq-ref (parse-email-headers (string-append headers "\n"))
+                       'x-debbugs-cc)
+            => split-cc)
+           (else '())))
+         ;; Fetch Cc addresses for current issue.
+         (x-debbugs-cc
+          (cond
+           ((assq-ref (reply-email-headers (current-issue-number))
+                       'cc)
+            => split-cc)
+           (else '()))))
+    ;; Print X-Debbugs-Cc header.
+    (display "X-Debbugs-Cc: ")
+    (display (string-join (delete-duplicates
+                           (append 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))
diff --git a/tests/client.scm b/tests/client.scm
index 2b2c1be..ced573b 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -68,6 +68,9 @@ called with."
 (define serialize-email-address
   (@@ (mumi client) serialize-email-address))
 
+(define split-cc
+  (@@ (mumi client) split-cc))
+
 (test-begin "client")
 
 (test-equal "serialize email address"
@@ -78,6 +81,11 @@ called with."
   "\"Bar, Foo\" <foobar@example.com>"
   (serialize-email-address "Bar, Foo" "foobar@example.com"))
 
+(test-equal "split Cc field"
+  (list "Foo <foo@example.com>"
+        "\"Bar, Foo\" <foobar@example.com>")
+  (split-cc "Foo <foo@example.com>, \"Bar, Foo\" <foobar@example.com>"))
+
 (test-equal "send patches to new issue"
   '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
     ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
-- 
2.39.2

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

[Arun Isaac]

* mumi/client.scm (send-email): Accept mumi-command argument and use
it to construct --header-cmd.
* scripts/mumi.in: Pass command to send-email.
* tests/client.scm ("send patches to new issue", "send patches to
existing issue", "send single patch to new issue", "send single patch
to existing issue", "send patch to existing issue and Cc other
participants"): Adjust tests.
---
 mumi/client.scm  | 10 +++++++---
 scripts/mumi.in  |  2 +-
 tests/client.scm | 17 ++++++++++++++---
 3 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index 797ec91..6ac69f9 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -292,8 +292,9 @@ ISSUE-NUMBER."
           (() (list))
           (cc (list (cons 'cc (string-join cc ", "))))))))
 
-(define (send-email patches)
-  "Send PATCHES via email."
+(define (send-email mumi-command patches)
+  "Send PATCHES via email. MUMI-COMMAND is the mumi program currently
+invoked."
   (if (current-issue-number)
       ;; If an issue is current, send patches to that issue's email
       ;; address.
@@ -301,7 +302,10 @@ ISSUE-NUMBER."
         (git-send-email (string-append (number->string issue-number)
                                        "@"
                                        (client-config 'debbugs-host))
-                        patches))
+                        patches
+                        (list (string-append "--header-cmd="
+                                             mumi-command
+                                             " git-send-email-headers"))))
       (match patches
         ;; If it's a single patch, send it to the patch email address
         ;; and be done with it
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 8fb7cd4..5b98634 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -162,7 +162,7 @@
   (("new")
    (client:clear-current-issue!))
   (("send-email" . patches)
-   (client:send-email patches))
+   (client:send-email (car (program-arguments)) patches))
   (("git-send-email-headers" patch)
    (client:git-send-email-headers patch))
   (("mailer" . rest)
diff --git a/tests/client.scm b/tests/client.scm
index ced573b..d28bc1a 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -99,10 +99,13 @@ called with."
                                        (const 12345))
                                  client-config-stub)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send patches to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch" "bar.patch" "foobar.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -114,6 +117,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch" "bar.patch" "foobar.patch")))))))
 
 (test-equal "send single patch to new issue"
@@ -127,10 +131,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send single patch to existing issue"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -142,10 +149,13 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-equal "send patch to existing issue and Cc other participants"
-  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
+  '(("git" "send-email" "--to=12345@example.com"
+     "--header-cmd=mumi git-send-email-headers"
+     "foo.patch"))
   (map (match-lambda
          ((command _) command))
        (trace-calls (var@@ (mumi client) call-with-input-pipe*)
@@ -157,6 +167,7 @@ called with."
                                  client-config-stub
                                  do-not-poll-server-for-issue-number)
              (cut (@@ (mumi client) send-email)
+                  "mumi"
                   (list "foo.patch")))))))
 
 (test-end "client")
-- 
2.39.2