[elpa] externals/plz f2176dc56c 60/81: Change/Fix: Avoid command-line arguments

[ELPA Syncer]

branch: externals/plz
commit f2176dc56c379b5d4676f5cd7c3511bd1399e53a
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Change/Fix: Avoid command-line arguments
---
 notes.org         |  8 +++++++-
 plz.el            | 50 ++++++++++++++++++++++++++++++--------------------
 tests/test-plz.el | 43 ++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 79 insertions(+), 22 deletions(-)

diff --git a/notes.org b/notes.org
index 52f1f93164..b192071e2b 100644
--- a/notes.org
+++ b/notes.org
@@ -14,10 +14,16 @@
 
 * Tasks
 
-** TODO Ensure that secrets are not leaked via command line or temp files
+** DONE Ensure that secrets are not leaked via command line or temp files
+CLOSED: [2021-08-15 Sun 15:34]
+:LOGBOOK:
+-  State "DONE"       from "TODO"       [2021-08-15 Sun 15:34]
+:END:
 
 e.g. =request.el= can leak secrets and other data via the command line and 
[[https://github.com/tkf/emacs-request/blob/431d14343c61bc51a86c9a9e1acb6c26fe9a6298/request.el#L709][leftover
 temp files]].  We want to handle this safely.
 
+[2021-08-15 Sun 15:33]  Finally figured out how to do this using ~--config~.  
It required some trial-and-error, since the curl man page doesn't explain how 
to pass request bodies over STDIN after the arguments.  But it works!
+
 * Ideas
 
 ** TODO Use finalizers to clean up response buffers
diff --git a/plz.el b/plz.el
index 348f2f8b36..1a9fdd742f 100644
--- a/plz.el
+++ b/plz.el
@@ -184,7 +184,9 @@ the curl process buffer.")
     "--compressed"
     "--location"
     "--dump-header" "-")
-  "Default arguments to curl."
+  "Default arguments to curl.
+Note that these arguments are passed on the command line, which
+may be visible to other users on the local system."
   :type '(repeat string))
 
 (defcustom plz-connect-timeout 5
@@ -336,28 +338,35 @@ from a host, respectively.
 
 NOQUERY is passed to `make-process', which see."
   ;; Inspired by and copied from `elfeed-curl-retrieve'.
-
   ;; NOTE: By default, for PUT requests and POST requests >1KB, curl sends an
   ;; "Expect:" header, which causes servers to send a "100 Continue" response, 
which
   ;; we don't want to have to deal with, so we disable it by setting the 
header to
   ;; the empty string.  See <https://gms.tf/when-curl-sends-100-continue.html>.
   ;; TODO: Handle "100 Continue" responses and remove this workaround.
   (push (cons "Expect" "") headers)
-  (let* ((header-args (cl-loop for (key . value) in headers
-                               append (list "--header" (format "%s: %s" key 
value))))
-         (data-arg (pcase-exhaustive body-type
+  (let* ((data-arg (pcase-exhaustive body-type
                      ('binary "--data-binary")
                      ('text "--data")))
-         (curl-args (append plz-curl-default-args header-args
-                            (when connect-timeout
-                              (list "--connect-timeout" (number-to-string 
connect-timeout)))
-                            (when timeout
-                              (list "--max-time" (number-to-string timeout)))
-                            (pcase method
-                              ((or 'put 'post)
-                               (cl-assert body)
-                               (list data-arg "@-" "--request" (upcase 
(symbol-name method)))))
-                            (list url)))
+         (curl-command-line-args (append plz-curl-default-args
+                                         (list "--config" "-")))
+         (curl-config-header-args (cl-loop for (key . value) in headers
+                                           collect (cons "--header" (format 
"%s: %s" key value))))
+         (curl-config-args (append curl-config-header-args
+                                   (list (cons "--url" url))
+                                   (when connect-timeout
+                                     (list (cons "--connect-timeout"
+                                                 (number-to-string 
connect-timeout))))
+                                   (when timeout
+                                     (list (cons "--max-time" 
(number-to-string timeout))))
+                                   (pcase method
+                                     ((or 'put 'post)
+                                      (cl-assert body)
+                                      (list (cons "--request" (upcase 
(symbol-name method)))
+                                            ;; It appears that this must be 
the last argument
+                                            ;; in order to pass data on the 
rest of STDIN.
+                                            (cons data-arg "@-"))))))
+         (curl-config (cl-loop for (key . value) in curl-config-args
+                               concat (format "%s \"%s\"\n" key value)))
          (decode (pcase as
                    ('binary nil)
                    (_ decode))))
@@ -369,7 +378,7 @@ NOQUERY is passed to `make-process', which see."
             (process (make-process :name "plz-request-curl"
                                    :buffer (current-buffer)
                                    :coding 'binary
-                                   :command (append (list plz-curl-program) 
curl-args)
+                                   :command (append (list plz-curl-program) 
curl-command-line-args)
                                    :connection-type 'pipe
                                    :sentinel #'plz--sentinel
                                    :stderr (current-buffer)
@@ -398,13 +407,14 @@ NOQUERY is passed to `make-process', which see."
         (setf plz-then then
               plz-else else
               plz-finally finally)
+        ;; Send --config arguments.
+        (process-send-string process curl-config)
         (when body
           (cl-typecase body
-            (string (process-send-string process body)
-                    (process-send-eof process))
+            (string (process-send-string process body))
             (buffer (with-current-buffer body
-                      (process-send-region process (point-min) (point-max))
-                      (process-send-eof process)))))
+                      (process-send-region process (point-min) (point-max))))))
+        (process-send-eof process)
         process))))
 
 (cl-defun plz--curl-sync (_method url &key headers connect-timeout timeout
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 37e8bad697..8fa933e6af 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -122,18 +122,21 @@
 (ert-deftest plz-post-jpeg-string nil
   (let* ((jpeg-to-upload (plz-get-sync "https://httpbin.org/image/jpeg";
                            :as 'binary))
+         (response-json)
          (response-jpeg)
          (process (plz 'post "https://httpbin.org/post";
                     :headers '(("Content-Type" . "image/jpeg"))
                     :body jpeg-to-upload :body-type 'binary
                     :as #'json-read
                     :then (lambda (json)
-                            (setf response-jpeg
+                            (setf response-json json
+                                  response-jpeg
                                   (base64-decode-string
                                    (string-remove-prefix 
"data:application/octet-stream;base64,"
                                                          (alist-get 'data 
json))))))))
     (should (equal 'jpeg (image-type-from-data jpeg-to-upload)))
     (plz-test-wait process)
+    (should response-json)
     (should (equal 'jpeg (image-type-from-data response-jpeg)))
     (should (equal (length jpeg-to-upload) (length response-jpeg)))
     (should (equal jpeg-to-upload response-jpeg))))
@@ -177,6 +180,44 @@
   (should-error (plz-get-sync "https://httpbin.org/get";
                   :as 'buffer)))
 
+;;;;; Headers
+
+;; These tests were added when plz--curl was changed to send headers
+;; with "--config" rather than on the command line.
+
+(ert-deftest plz-get-with-headers ()
+  (let* ((response-json)
+         (process (plz 'get "https://httpbin.org/get";
+                    :headers '(("X-Plz-Test-Header" . "plz-test-header-value"))
+                    :as #'json-read
+                    :then (lambda (json)
+                            (setf response-json json)))))
+    (plz-test-wait process)
+    (let-alist response-json
+      (should (equal "plz-test-header-value" .headers.X-Plz-Test-Header)))))
+
+(ert-deftest plz-post-with-headers ()
+  (let* ((alist (list (cons "key" "value")))
+         (response-json)
+         (process (plz 'post "https://httpbin.org/post";
+                    :headers '(("Content-Type" . "application/json")
+                               ("X-Plz-Test-Header" . "plz-test-header-value"))
+                    :body (json-encode alist)
+                    :as #'json-read
+                    :then (lambda (json)
+                            (setf response-json json)))))
+    (plz-test-wait process)
+    (let-alist response-json
+      (should (equal "plz-test-header-value" .headers.X-Plz-Test-Header))
+      (should (equal "value" (alist-get 'key (json-read-from-string 
.data)))))))
+
+(ert-deftest plz-get-json-with-headers-sync ()
+  (let-alist (plz-get-sync "https://httpbin.org/get";
+               :headers '(("X-Plz-Test-Header" . "plz-test-header-value"))
+               :as #'json-read)
+    (should (string-match "curl" .headers.User-Agent))
+    (should (equal "plz-test-header-value" .headers.X-Plz-Test-Header))))
+
 ;;;;; Errors
 
 (ert-deftest plz-get-curl-error nil