branch: externals/plz
commit f2176dc56c379b5d4676f5cd7c3511bd1399e53a
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@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
