branch: externals/plz
commit 897c5bbfb2dc97c910dffb35d73e1e63b104b37d
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Improvements, error handling
---
plz.el | 69 +++++++++++++++++++++++++++++++++++++++----------------
tests/test-plz.el | 22 +++++++++++++++++-
2 files changed, 70 insertions(+), 21 deletions(-)
diff --git a/plz.el b/plz.el
index d744e1b76b..0b189d07b9 100644
--- a/plz.el
+++ b/plz.el
@@ -51,13 +51,27 @@
(require 'rx)
(require 'subr-x)
+;;;; Errors
+
+;; FIXME: `condition-case' can't catch these...?
+(define-error 'plz-curl-error "Curl error")
+(define-error 'plz-http-error "HTTP error")
+
;;;; Structs
(cl-defstruct plz-response
version status headers body)
+(cl-defstruct plz-error
+ curl-error response)
+
;;;; Constants
+(defconst plz-http-response-status-line-regexp
+ (rx "HTTP/" (group (1+ (or digit "."))) (1+ blank)
+ (group (1+ digit)))
+ "Regular expression matching HTTP response status line.")
+
(defconst plz-curl-errors
;; Copied from elfeed-curl.el.
'((1 . "Unsupported protocol.")
@@ -172,7 +186,7 @@
;;;; Functions
-(cl-defun plz-get (url &key headers as then
+(cl-defun plz-get (url &key headers as then else
(connect-timeout plz-connect-timeout)
(decode t))
"Get HTTP URL with curl.
@@ -187,7 +201,7 @@ the initial connection attempt."
:headers headers
:connect-timeout connect-timeout
:decode decode
- :as as :then then))
+ :as as :then then :else else))
(cl-defun plz-get-sync (url &key headers as
(connect-timeout plz-connect-timeout)
@@ -207,7 +221,7 @@ the initial connection attempt."
:as as))
(cl-defun plz--request (_method url &key headers connect-timeout
- decode as then)
+ decode as then else)
"Return curl process for HTTP request to URL.
FIXME: Docstring.
@@ -216,9 +230,7 @@ HEADERS may be an alist of extra headers to send with the
request. CONNECT-TIMEOUT may be a number of seconds to timeout
the initial connection attempt."
;; Inspired by and copied from `elfeed-curl-retrieve'.
- (let* ((coding-system-for-read 'binary)
- (process-connection-type nil)
- (header-args (cl-loop for (key . value) in headers
+ (let* ((header-args (cl-loop for (key . value) in headers
collect (format "--header %s: %s" key value)))
(curl-args (append plz-curl-default-args header-args
(when connect-timeout
@@ -227,6 +239,7 @@ the initial connection attempt."
(with-current-buffer (generate-new-buffer " *plz-request-curl*")
(let ((process (make-process :name "plz-request-curl"
:buffer (current-buffer)
+ :coding 'binary
:command (append (list plz-curl-program)
curl-args)
:connection-type 'pipe
:sentinel #'plz--sentinel
@@ -249,7 +262,8 @@ the initial connection attempt."
(when decode
(decode-coding-region (point)
(point-max) coding-system))
(funcall then (funcall as))))))))
- (setf plz-then then)
+ (setf plz-then then
+ plz-else else)
process))))
(cl-defun plz--request-sync (_method url &key headers connect-timeout
@@ -305,26 +319,41 @@ node `(elisp) Sentinels'). Kills the buffer before
returning."
(with-current-buffer buffer
(pcase status
((or 0 "finished\n")
- ;; Request completed successfully: call THEN.
- (funcall plz-then))
-
- ;; FIXME: Implement error callback handling.
- ((rx "exited abnormally with code " (group (1+ digit)))
- ;; Error: call error callback.
- (warn "plz--sentinel: ERROR: %s" (buffer-string))
- ;; (let* ((code (string-to-number (match-string 1 status)))
- ;; (message (alist-get code plz-curl-errors)))
- ;; (funcall plz-error (plz--response buffer)))
- )))
+ ;; Curl exited normally: check HTTP status code.
+ (pcase (plz--http-status)
+ (200 (funcall plz-then))
+ (_ (let ((err (make-plz-error :response (plz--response))))
+ (pcase-exhaustive plz-else
+ (`nil (signal 'plz-http-error err))
+ ((pred functionp) (funcall plz-else err)))))))
+
+ ((or (and (pred numberp) code)
+ (rx "exited abnormally with code " (let code (group (1+
digit)))))
+ ;; Curl error.
+ (let* ((curl-exit-code (cl-typecase code
+ (string (string-to-number code))
+ (number code)))
+ (curl-error-message (alist-get curl-exit-code
plz-curl-errors))
+ (err (make-plz-error :curl-error (cons curl-exit-code
curl-error-message))))
+ (pcase-exhaustive plz-else
+ (`nil (signal 'plz-curl-error err))
+ ((pred functionp) (funcall plz-else err)))))))
(kill-buffer buffer))))
+(defun plz--http-status ()
+ "Return HTTP status code for HTTP response in current buffer.
+Assumes point is at beginning of buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (when (looking-at plz-http-response-status-line-regexp)
+ (string-to-number (match-string 2)))))
+
(defun plz--response ()
"Return response struct for HTTP response in current buffer."
(save-excursion
(goto-char (point-min))
;; Parse HTTP version and status code.
- (looking-at (rx "HTTP/" (group (1+ (or digit "."))) (1+ blank)
- (group (1+ digit))))
+ (looking-at plz-http-response-status-line-regexp)
(let* ((http-version (string-to-number (match-string 1)))
(status-code (string-to-number (match-string 2)))
(headers (plz--headers))
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 74f400fa30..a5d468a399 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -109,7 +109,8 @@
(ert-deftest plz-get-sync-string nil
(should (string-match "curl" (plz-get-sync "https://httpbin.org/get";
- :as 'string))))
+ :as 'string)))
+ (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";))))
(ert-deftest plz-get-sync-response nil
(should (plz-test-get-response (plz-get-sync "https://httpbin.org/get";
@@ -127,6 +128,25 @@
(should-error (plz-get-sync "https://httpbin.org/get";
:as 'buffer)))
+;;;;; Errors
+
+(ert-deftest plz-get-curl-error nil
+ (let ((err (should-error (plz-get-sync
"https://httpbinnnnnn.org/get/status/404";
+ :as 'string)
+ :type 'plz-curl-error)))
+ (should (and (eq 'plz-curl-error (car err))
+ (plz-error-p (cdr err))
+ (equal '(6 . "Couldn't resolve host. The given remote host
was not resolved.") (plz-error-curl-error (cdr err)))))))
+
+(ert-deftest plz-get-404-error nil
+ (let ((err (should-error (plz-get-sync "https://httpbin.org/get/status/404";
+ :as 'string)
+ :type 'plz-http-error)))
+ (should (and (eq 'plz-http-error (car err))
+ (plz-error-p (cdr err))
+ (plz-response-p (plz-error-response (cdr err)))
+ (eq 404 (plz-response-status (plz-error-response (cdr
err))))))))
+
;;;; Footer
(provide 'test-plz)
