From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id YDF0GAusCGQFSAEASxT56A (envelope-from ) for ; Wed, 08 Mar 2023 16:38:51 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id iNF0GAusCGTmYwAA9RJhRA (envelope-from ) for ; Wed, 08 Mar 2023 16:38:51 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id DD1F07355 for ; Wed, 8 Mar 2023 16:38:50 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pZvrh-0006HC-KK; Wed, 08 Mar 2023 10:38:05 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pZvrf-0006GE-Rs for guix-patches@gnu.org; Wed, 08 Mar 2023 10:38:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pZvrf-00043J-8r for guix-patches@gnu.org; Wed, 08 Mar 2023 10:38:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pZvrf-0007p7-4l for guix-patches@gnu.org; Wed, 08 Mar 2023 10:38:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61645] [mumi v3 3/4] client: Support sending email to issues. Resent-From: Arun Isaac Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 08 Mar 2023 15:38:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61645 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61645@debbugs.gnu.org, Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: Ricardo Wurmus , Arun Isaac Received: via spool by 61645-submit@debbugs.gnu.org id=B61645.167828986130009 (code B ref 61645); Wed, 08 Mar 2023 15:38:03 +0000 Received: (at 61645) by debbugs.gnu.org; 8 Mar 2023 15:37:41 +0000 Received: from localhost ([127.0.0.1]:49957 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pZvrH-0007nj-Ky for submit@debbugs.gnu.org; Wed, 08 Mar 2023 10:37:41 -0500 Received: from mugam.systemreboot.net ([139.59.75.54]:56586) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pZvrD-0007nN-Tz for 61645@debbugs.gnu.org; Wed, 08 Mar 2023 10:37:37 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=systemreboot.net; s=default; h=Content-Transfer-Encoding:Content-Type: MIME-Version:References:In-Reply-To:Message-Id:Date:Subject:Cc:To:From:Sender :Reply-To:Content-ID:Content-Description:Resent-Date:Resent-From: Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help: List-Unsubscribe:List-Subscribe:List-Post:List-Owner:List-Archive; bh=iYyN7nvntcyHU5E3F1yGomnxbUMT68d9iLn7jn7IvKM=; b=qHVPU8gPDMUdAHl1nMeOKrYlIT OkM6TkXAUwVVzSytFbSrerhyGURvsska9ajF4SXYB52OcmEnDYh1k0/VBvn7ngu6+QqxaybV04Wzs poM63fpq6jSJ9Txzo/5XlWuYuKsaYvXD98rfDGaUpzgqqepsLWvG1kU029tNE1KU+wE+VLLoyiRt+ HxWInJdp1ZsJexR5aLfr5JVbN2avWCD4D89CTmyxTYotYN3aZi9xQ+OlxOutw97W4AqQSvn7Uz52V s9kFlyZlkz7gCc50z41GDdPmPloF0dlWCCpB4riFFkATmkteT56iSjd7s9geY3XUZoP+jUdEUG/pE FFkIzzLA==; Received: from [192.168.2.1] (port=6222 helo=localhost.localdomain) by systemreboot.net with esmtpsa (TLS1.3) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.96) (envelope-from ) id 1pZvr7-0006Dd-33; Wed, 08 Mar 2023 21:07:31 +0530 From: Arun Isaac Date: Wed, 8 Mar 2023 15:36:57 +0000 Message-Id: <20230308153658.19929-4-arunisaac@systemreboot.net> X-Mailer: git-send-email 2.39.1 In-Reply-To: <87r0tzgyok.fsf@systemreboot.net> References: <87r0tzgyok.fsf@systemreboot.net> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1678289931; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=iYyN7nvntcyHU5E3F1yGomnxbUMT68d9iLn7jn7IvKM=; b=dTr4B0c/f57RI9U5jm1m5JmNKq3h8gjaDvW+jbHY72Wd5EwzOMkMSLJERUpkz6xqjPMYzs cCKJOD2duVd5I6FUqTaMGHojMPNJ1P8Yxv2Utt5z1+IISrxf9YFmidl4qQOV4M7aZ/pfdM OFt0leQjUHpJvwyyqsNKHgERVQwQQtKGzBHSUyn1HGR56suxZ7ijlepcayeMmTbzzn+9hJ bV2AfA0hz4j5VHVuIcE9/eoNX6rgHHErNMrjRHd2Xs+MRyIhZMC2SnHsiNaMCUlO4/cT8h rCoV4lRvaOVQ1Yn06RNwkxwlWKegYRZWGFQBTaLH1+EDf+SC3GMpCj4z5Bqupw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=systemreboot.net header.s=default header.b=qHVPU8gP; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=systemreboot.net (policy=none) ARC-Seal: i=1; s=key1; d=yhetil.org; t=1678289931; a=rsa-sha256; cv=none; b=LGhcCI1fWS4G55gCWLVwXPeFeeZ0ySzxqeGrofKWRg08CcZFv4pefYnRGKI8JgJXyX5tT3 1Ry5KOkrWKOHTKT3hfs6KfjNjeqCtPEqhZytMTtTmZJJQUakCUEXXYQqiiUf6jpiM7I2Ch yEC0keqtGfD/FFmIV29UenkGtsBdUzsNI0pVziSyFP5zL1JuDd2bd10LMtJeBcIh68C7cq EyHd8ZcrqhIGgzyCHPb06Z4XJYNZBLL0oEp+TZICAJWi5Gcq/Kl4trxbZM4trsBSnVWbFr yntemwYPIYIalRaFa74o+5mlT9ayAZ5hBVIpQKjy8D212ltrSTk/6+tyczljDw== Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=systemreboot.net header.s=default header.b=qHVPU8gP; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=systemreboot.net (policy=none) X-Migadu-Spam-Score: 6.80 X-Spam-Score: 6.80 X-Migadu-Queue-Id: DD1F07355 X-Migadu-Scanner: scn1.migadu.com X-TUID: G37jv1z6I726 * mumi/client.scm: Import (rnrs io ports), (srfi srfi-71), (srfi srfi-171), (ice-9 match), (ice-9 popen), (web client), (web response) and (email email). (issue-number-of-message, call-with-input-pipe, git-send-email): New functions. (send-email): New public function. * scripts/mumi.in (show-mumi-usage): Document send-email subcommand. (main): Add send-email subcommand. * tests/client.scm: New file. * Makefile.am (SCM_TESTS): Add tests/client.scm. --- Makefile.am | 1 + mumi/client.scm | 112 +++++++++++++++++++++++++++++++++++++++++++- scripts/mumi.in | 5 ++ tests/client.scm | 118 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 235 insertions(+), 1 deletion(-) create mode 100644 tests/client.scm diff --git a/Makefile.am b/Makefile.am index a8c11a1..86ba4f0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -58,6 +58,7 @@ SOURCES = \ TEST_EXTENSIONS = .scm SCM_TESTS = \ + tests/client.scm \ tests/debbugs.scm \ tests/xapian.scm diff --git a/mumi/client.scm b/mumi/client.scm index ae3a0a9..b8d588b 100644 --- a/mumi/client.scm +++ b/mumi/client.scm @@ -17,18 +17,27 @@ ;;; along with mumi. If not, see . (define-module (mumi client) + #:use-module (rnrs io ports) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-43) + #:use-module (srfi srfi-71) + #:use-module (srfi srfi-171) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) #:use-module (term ansi-color) + #:use-module (web client) + #:use-module (web response) #:use-module (web uri) + #:use-module (email email) #:use-module (kolam http) #:use-module (mumi config) #:use-module (mumi web view utils) #:export (search print-current-issue set-current-issue! - clear-current-issue!)) + clear-current-issue! + send-email)) (define (git-top-level) "Return the top-level directory of the current git repository." @@ -152,3 +161,104 @@ (let ((issue-file (current-issue-file))) (when (file-exists? issue-file) (delete-file issue-file)))) + +(define* (issue-number-of-message message-id #:optional (retries 15)) + "Return issue number that MESSAGE-ID belongs to. Retry RETRIES number +of times with an interval of 60 seconds between retries." + ;; TODO: Re-implement this using our GraphQL endpoint once it + ;; supports retrieving the issue from a message ID. Later, + ;; re-implement this using a GraphQL subscription when kolam + ;; supports it. + (define (poll-issue-number-of-message message-id) + (let ((response _ (http-get (build-uri (client-config 'mumi-scheme) + #:host (client-config 'mumi-host) + #:path (string-append "/msgid/" message-id))))) + (and (>= (response-code response) 300) + (< (response-code response) 400) + (match (split-and-decode-uri-path + (uri-path (response-location response))) + (("issue" issue-number) + (string->number issue-number)))))) + + (let loop ((i retries)) + (if (zero? i) + (begin + (format (current-error-port) + "Mail not acknowledged by issue tracker. Giving up.~%") + (exit #f)) + (or (poll-issue-number-of-message message-id) + (begin + (let ((retry-interval 60)) + (format (current-error-port) + "Server has not yet received our email. Will retry in ~a seconds. ~a retries remaining.~%" + retry-interval (1- i)) + (sleep retry-interval)) + (loop (1- i))))))) + +(define (call-with-input-pipe command proc) + "Call PROC with input pipe to COMMAND. COMMAND is a list of program +arguments." + (match command + ((prog args ...) + (let ((port #f)) + (dynamic-wind + (lambda () + (set! port (apply open-pipe* OPEN_READ prog args))) + (cut proc port) + (cut close-pipe port)))))) + +(define (git-send-email to patches) + "Send PATCHES using git send-email to the TO address and return the +message ID of the first email sent." + (let ((command (cons* "git" "send-email" + (string-append "--to=" to) + patches))) + (display (string-join command)) + (newline) + (call-with-input-pipe command + (lambda (port) + ;; FIXME: This messes up the order of stdout and stderr. + (let ((message-id + ;; Read till you get the Message ID. + (port-transduce (tlog (lambda (_ line) + (display line) + (newline))) + (rany (lambda (line) + (and (string-prefix-ci? "Message-ID:" line) + (assq-ref + (parse-email-headers + (string-append line "\n")) + 'message-id)))) + get-line + port))) + ;; Pass through the rest. + (display (get-string-all port)) + message-id))))) + +(define (send-email patches) + "Send PATCHES via email." + (if (current-issue-number) + ;; If an issue is current, send patches to that issue's email + ;; address. + (git-send-email (string-append (number->string (current-issue-number)) + "@" + (client-config 'debbugs-host)) + patches) + (match patches + ;; If it's a single patch, send it to the patch email address + ;; and be done with it + ((patch) + (git-send-email (client-config 'patch-email-address) + (list patch))) + ;; Else, send first patch to the patch email address and get an + ;; issue number. Then, send the remaining patches to that + ;; issue's email address. + ((first-patch other-patches ...) + (git-send-email + (string-append (number->string + (issue-number-of-message + (git-send-email (client-config 'patch-email-address) + (list first-patch)))) + "@" + (client-config 'debbugs-host)) + other-patches))))) diff --git a/scripts/mumi.in b/scripts/mumi.in index dfd082d..2295328 100644 --- a/scripts/mumi.in +++ b/scripts/mumi.in @@ -126,6 +126,9 @@ `mumi new': clear current issue presumably to open a new one. + `mumi send-email': + send patches to debbugs. + `mumi web [--address=address] [--port=port] [--listen-repl[=port]] [--disable-mailer]': start the application web server. @@ -158,6 +161,8 @@ (client:print-current-issue)) (("new") (client:clear-current-issue!)) + (("send-email" . patches) + (client:send-email patches)) (("mailer" . rest) (let* ((opts (parse-options rest)) (sender (assoc-ref opts 'sender)) diff --git a/tests/client.scm b/tests/client.scm new file mode 100644 index 0000000..fb03713 --- /dev/null +++ b/tests/client.scm @@ -0,0 +1,118 @@ +;;; mumi -- Mediocre, uh, mail interface +;;; Copyright © 2023 Arun Isaac +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(use-modules (srfi srfi-26) + (srfi srfi-64) + (ice-9 match)) + +(define (with-variable variable value thunk) + "Set VARIABLE to VALUE, run THUNK and restore the old value of +VARIABLE. Return the value returned by THUNK." + (let ((old-value (variable-ref variable))) + (dynamic-wind + (cut variable-set! variable value) + thunk + (cut variable-set! variable old-value)))) + +(define (with-variables variable-bindings thunk) + "Set VARIABLE-BINDINGS, run THUNK and restore the old values of the +variables. Return the value returned by THUNK. VARIABLE-BINDINGS is a +list of pairs mapping variables to their values." + (match variable-bindings + (((variable . value) tail ...) + (with-variable variable value + (cut with-variables tail thunk))) + (() (thunk)))) + +(define-syntax-rule (var@@ module-name variable-name) + (module-variable (resolve-module 'module-name) + 'variable-name)) + +(define (trace-calls function-variable thunk) + "Run THUNK and return a list of argument lists FUNCTION-VARIABLE is +called with." + (let ((args-list (list))) + (with-variable function-variable (lambda args + (set! args-list + (cons args args-list))) + thunk) + (reverse args-list))) + +(define client-config-stub + (cons (var@@ (mumi client) client-config) + (lambda (key) + (case key + ((debbugs-host) "example.com") + ((patch-email-address) "foo@patches.com") + (else (error "Key unimplemented in stub" key)))))) + +(test-begin "client") + +(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")) + (map (match-lambda + ((command _) command)) + (trace-calls (var@@ (mumi client) call-with-input-pipe) + (lambda () + (with-variables (list (cons (var@@ (mumi client) issue-number-of-message) + (const 12345)) + client-config-stub) + (cut (@@ (mumi client) send-email) + (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")) + (map (match-lambda + ((command _) command)) + (trace-calls (var@@ (mumi client) call-with-input-pipe) + (lambda () + (with-variables (list (cons (var@@ (mumi client) current-issue-number) + (const 12345)) + client-config-stub) + (cut (@@ (mumi client) send-email) + (list "foo.patch" "bar.patch" "foobar.patch"))))))) + +(test-equal "send single patch to new issue" + '(("git" "send-email" "--to=foo@patches.com" "foo.patch")) + (map (match-lambda + ((command _) command)) + (trace-calls (var@@ (mumi client) call-with-input-pipe) + (lambda () + (with-variables (list (cons (var@@ (mumi client) issue-number-of-message) + (lambda _ + (error "Do not poll server for issue number"))) + client-config-stub) + (cut (@@ (mumi client) send-email) + (list "foo.patch"))))))) + +(test-equal "send single patch to existing issue" + '(("git" "send-email" "--to=12345@example.com" "foo.patch")) + (map (match-lambda + ((command _) command)) + (trace-calls (var@@ (mumi client) call-with-input-pipe) + (lambda () + (with-variables (list (cons (var@@ (mumi client) current-issue-number) + (const 12345)) + (cons (var@@ (mumi client) issue-number-of-message) + (lambda _ + (error "Do not poll server for issue number"))) + client-config-stub) + (cut (@@ (mumi client) send-email) + (list "foo.patch"))))))) + +(test-end "client") -- 2.39.1