[elpa] externals/srht b1bdf349ab 07/27: Add build.yml and external dependencies.

[ELPA Syncer]

branch: externals/srht
commit b1bdf349abe838e5faac8586136978dcf7e8bb53
Author: Aleksandr Vityazev <avityazev@posteo.org>
Commit: Aleksandr Vityazev <avityazev@posteo.org>

    Add build.yml and external dependencies.
---
 .build.yml      |  11 ++
 Eldev           |   2 +-
 external/plz.el | 523 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 535 insertions(+), 1 deletion(-)

diff --git a/.build.yml b/.build.yml
new file mode 100644
index 0000000000..11ef39da39
--- /dev/null
+++ b/.build.yml
@@ -0,0 +1,11 @@
+image: guix
+packages:
+  - make
+  - emacs
+  - emacs-eldev
+sources:
+  - https://git.sr.ht/~akagi/srht.el
+tasks:
+  - check: |
+      cd srht.el
+      make test
diff --git a/Eldev b/Eldev
index e13ca687bc..b5a00dde97 100644
--- a/Eldev
+++ b/Eldev
@@ -8,4 +8,4 @@
 ;; (eldev-use-plugin 'autoloads)
 ;; (file-name-directory (find-library-name "plz"))
 (setq eldev-project-main-file "lisp/srht.el")
-(eldev-use-local-dependency 
"/gnu/store/r48pqszz01hvph933i7k5m2h0cwh0wpz-emacs-rrr-plz-0.1-pre-2.1d3efc0/share/emacs/site-lisp/rrr-plz-0.1-pre-2.1d3efc0/")
+(eldev-use-local-dependency "./external/" 'source)
diff --git a/external/plz.el b/external/plz.el
new file mode 100644
index 0000000000..62fd5563b8
--- /dev/null
+++ b/external/plz.el
@@ -0,0 +1,523 @@
+;;; plz.el --- HTTP library                         -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; URL: https://github.com/alphapapa/plz.el
+;; Version: 0.1-pre
+;; Package-Requires: ((emacs "26.3"))
+;; Keywords: comm, network, http
+
+;;; License:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; An HTTP library that uses curl as a backend.  Inspired by, and some
+;; code copied from, Christopher Wellons's library, elfeed-curl.el.
+;;
+;; Why this package?
+;;
+;; 1.  `url' works well for many things, but it has some issues (and have
+;;     you seen its code?).
+;; 2.  `request' works well for many things, but it has some issues (and
+;;     have you seen its code?).
+;; 3.  Chris Wellons doesn't have time to factor his excellent
+;;     elfeed-curl.el library out of Elfeed.  This will have to do.
+;;
+;; Why is it called `plz'?
+;;
+;; 1.  There's already a package called `http'.
+;; 2.  There's already a package called `request'.
+;; 3.  Naming things is hard.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(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 message)
+
+;;;; Constants
+
+(defconst plz-http-response-status-line-regexp
+  (rx bol "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.")
+    (2 . "Failed to initialize.")
+    (3 . "URL malformed. The syntax was not correct.")
+    (4 . "A feature or option that was needed to perform the desired request 
was not enabled or was explicitly disabled at build-time.")
+    (5 . "Couldn't resolve proxy. The given proxy host could not be resolved.")
+    (6 . "Couldn't resolve host. The given remote host was not resolved.")
+    (7 . "Failed to connect to host.")
+    (8 . "FTP weird server reply. The server sent data curl couldn't parse.")
+    (9 . "FTP access denied.")
+    (11 . "FTP weird PASS reply.")
+    (13 . "FTP weird PASV reply.")
+    (14 . "FTP weird 227 format.")
+    (15 . "FTP can't get host.")
+    (17 . "FTP couldn't set binary.")
+    (18 . "Partial file. Only a part of the file was transferred.")
+    (19 . "FTP couldn't download/access the given file, the RETR (or similar) 
command failed.")
+    (21 . "FTP quote error. A quote command returned error from the server.")
+    (22 . "HTTP page not retrieved.")
+    (23 . "Write error.")
+    (25 . "FTP couldn't STOR file.")
+    (26 . "Read error. Various reading problems.")
+    (27 . "Out of memory. A memory allocation request failed.")
+    (28 . "Operation timeout.")
+    (30 . "FTP PORT failed.")
+    (31 . "FTP couldn't use REST.")
+    (33 . "HTTP range error. The range \"command\" didn't work.")
+    (34 . "HTTP post error. Internal post-request generation error.")
+    (35 . "SSL connect error. The SSL handshaking failed.")
+    (36 . "FTP bad download resume.")
+    (37 . "FILE couldn't read file.")
+    (38 . "LDAP bind operation failed.")
+    (39 . "LDAP search failed.")
+    (41 . "Function not found. A required LDAP function was not found.")
+    (42 . "Aborted by callback.")
+    (43 . "Internal error. A function was called with a bad parameter.")
+    (45 . "Interface error. A specified outgoing interface could not be used.")
+    (47 . "Too many redirects.")
+    (48 . "Unknown option specified to libcurl.")
+    (49 . "Malformed telnet option.")
+    (51 . "The peer's SSL certificate or SSH MD5 fingerprint was not OK.")
+    (52 . "The server didn't reply anything, which here is considered an 
error.")
+    (53 . "SSL crypto engine not found.")
+    (54 . "Cannot set SSL crypto engine as default.")
+    (55 . "Failed sending network data.")
+    (56 . "Failure in receiving network data.")
+    (58 . "Problem with the local certificate.")
+    (59 . "Couldn't use specified SSL cipher.")
+    (60 . "Peer certificate cannot be authenticated with known CA 
certificates.")
+    (61 . "Unrecognized transfer encoding.")
+    (62 . "Invalid LDAP URL.")
+    (63 . "Maximum file size exceeded.")
+    (64 . "Requested FTP SSL level failed.")
+    (65 . "Sending the data requires a rewind that failed.")
+    (66 . "Failed to initialise SSL Engine.")
+    (67 . "The user name, password, or similar was not accepted and curl 
failed to log in.")
+    (68 . "File not found on TFTP server.")
+    (69 . "Permission problem on TFTP server.")
+    (70 . "Out of disk space on TFTP server.")
+    (71 . "Illegal TFTP operation.")
+    (72 . "Unknown TFTP transfer ID.")
+    (73 . "File already exists (TFTP).")
+    (74 . "No such user (TFTP).")
+    (75 . "Character conversion failed.")
+    (76 . "Character conversion functions required.")
+    (77 . "Problem with reading the SSL CA cert (path? access rights?).")
+    (78 . "The resource referenced in the URL does not exist.")
+    (79 . "An unspecified error occurred during the SSH session.")
+    (80 . "Failed to shut down the SSL connection.")
+    (82 . "Could not load CRL file, missing or wrong format (added in 
7.19.0).")
+    (83 . "Issuer check failed (added in 7.19.0).")
+    (84 . "The FTP PRET command failed")
+    (85 . "RTSP: mismatch of CSeq numbers")
+    (86 . "RTSP: mismatch of Session Identifiers")
+    (87 . "unable to parse FTP file list")
+    (88 . "FTP chunk callback reported error")
+    (89 . "No connection available, the session will be queued")
+    (90 . "SSL public key does not matched pinned public key"))
+  "Alist mapping curl error code integers to helpful error messages.")
+
+;;;; Variables
+
+(defvar-local plz-else nil
+  "Callback function for errored completion of request.
+Called in current curl process buffer.")
+
+(defvar-local plz-then nil
+  "Callback function for successful completion of request.
+Called in current curl process buffer.")
+
+(defvar-local plz-finally nil
+  "Function called unconditionally after completion of request.
+Called after the then/else function, without arguments, outside
+the curl process buffer.")
+
+(defvar-local plz-result nil
+  "Used when `plz' is called synchronously.")
+
+(defvar-local plz-sync nil
+  "Used when `plz' is called synchronously.")
+
+;;;; Customization
+
+(defgroup plz nil
+  "Options for `plz'."
+  :group 'network
+  :link '(url-link "https://github.com/alphapapa/plz.el";))
+
+(defcustom plz-curl-program "curl"
+  "Name of curl program to call."
+  :type 'string)
+
+(defcustom plz-curl-default-args
+  '("--silent"
+    "--compressed"
+    "--location"
+    "--dump-header" "-")
+  "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
+  "Default connection timeout in seconds.
+This limits how long the connection phase may last (the
+\"--connect-timeout\" argument to curl)."
+  :type 'number)
+
+(defcustom plz-timeout 60
+  "Default request timeout in seconds.
+This limits how long an entire request may take, including the
+connection phase and waiting to receive the response (the
+\"--max-time\" argument to curl)."
+  :type 'number)
+
+;;;; Functions
+
+;;;;; Public
+
+(cl-defun plz (method url &key headers body else finally noquery
+                      (as 'string) (then 'sync)
+                      (body-type 'text) (decode t decode-s)
+                      (connect-timeout plz-connect-timeout) (timeout 
plz-timeout))
+  "Request METHOD from URL with curl.
+Return the curl process object or, for a synchronous request, the
+selected result.
+
+HEADERS may be an alist of extra headers to send with the
+request.
+
+BODY-TYPE may be `text' to send BODY as text, or `binary' to send
+it as binary.
+
+AS selects the kind of result to pass to the callback function
+THEN, or the kind of result to return for synchronous requests.
+It may be:
+
+- `buffer' to pass the response buffer.
+
+- `binary' to pass the response body as an undecoded string.
+
+- `string' to pass the response body as a decoded string.
+
+- `response' to pass a `plz-response' struct.
+
+- `file' to pass a temporary filename to which the response body
+  has been saved without decoding.
+
+- `(file FILENAME)' to pass FILENAME after having saved the
+  response body to it without decoding.  FILENAME must be a
+  non-existent file; if it exists, it will not be overwritten,
+  and an error will be signaled.
+
+- A function, which is called in the response buffer with it
+  narrowed to the response body (suitable for, e.g. `json-read').
+
+If DECODE is non-nil, the response body is decoded automatically.
+For binary content, it should be nil.  When AS is `binary',
+DECODE is automatically set to nil.
+
+THEN is a callback function, whose sole argument is selected
+above with AS.  Or THEN may be `sync' to make a synchronous
+request, in which case the result is returned directly.
+
+ELSE is an optional callback function called when the request
+fails with one argument, a `plz-error' struct.  If ELSE is nil,
+an error is signaled when the request fails, either
+`plz-curl-error' or `plz-http-error' as appropriate, with a
+`plz-error' struct as the error data.  For synchronous requests,
+this argument is ignored.
+
+FINALLY is an optional function called without argument after
+THEN or ELSE, as appropriate.  For synchronous requests, this
+argument is ignored.
+
+CONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit
+how long it takes to connect to a host and to receive a response
+from a host, respectively.
+
+NOQUERY is passed to `make-process', which see."
+  ;; Inspired by and copied from `elfeed-curl-retrieve'.
+  (declare (indent defun))
+  (setf decode (if (and decode-s (not decode))
+                   nil decode))
+  ;; 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* ((data-arg (pcase-exhaustive body-type
+                     ('binary "--data-binary")
+                     ('text "--data")))
+         (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 "@-")))
+                                     ('delete
+                                      (list (cons "--request" (upcase 
(symbol-name method))))))))
+         (curl-config (cl-loop for (key . value) in curl-config-args
+                               concat (format "%s \"%s\"\n" key value)))
+         (decode (pcase as
+                   ('binary nil)
+                   (_ decode)))
+         sync-p)
+    (when (eq 'sync then)
+      (setf sync-p t
+            then (lambda (result)
+                   (setf plz-result result))))
+    (with-current-buffer (generate-new-buffer " *plz-request-curl*")
+      ;; Avoid making process in a nonexistent directory (in case the current
+      ;; default-directory has since been removed).  It's unclear what the best
+      ;; directory is, but this seems to make sense, and it should still exist.
+      (let ((default-directory temporary-file-directory)
+            (process (make-process :name "plz-request-curl"
+                                   :buffer (current-buffer)
+                                   :coding 'binary
+                                   :command (append (list plz-curl-program) 
curl-command-line-args)
+                                   :connection-type 'pipe
+                                   :sentinel #'plz--sentinel
+                                   :stderr (current-buffer)
+                                   :noquery noquery))
+            ;; The THEN function is called in the response buffer.
+            (then (pcase-exhaustive as
+                    ((or 'binary 'string)
+                     (lambda ()
+                       (let ((coding-system (or (plz--coding-system) 'utf-8)))
+                         (pcase as
+                           ('binary (set-buffer-multibyte nil)))
+                         (plz--narrow-to-body)
+                         (when decode
+                           (decode-coding-region (point) (point-max) 
coding-system))
+                         (funcall then (buffer-string)))))
+                    ('buffer (lambda ()
+                               (funcall then (current-buffer))))
+                    ('response (lambda ()
+                                 (funcall then (plz--response :decode-p 
decode))))
+                    ('file (lambda ()
+                             (set-buffer-multibyte nil)
+                             (plz--narrow-to-body)
+                             (let ((filename (make-temp-file "plz-")))
+                               (condition-case err
+                                   (write-region (point-min) (point-max) 
filename)
+                                 ;; In case of an error writing to the file, 
delete the temp file
+                                 ;; and signal the error.  Ignore any errors 
encountered while
+                                 ;; deleting the file, which would obscure the 
original error.
+                                 (error (ignore-errors
+                                          (delete-file filename))
+                                        (signal (car err) (cdr err))))
+                               (funcall then filename))))
+                    (`(file ,(and (pred stringp) filename))
+                     (lambda ()
+                       (set-buffer-multibyte nil)
+                       (plz--narrow-to-body)
+                       (condition-case err
+                           (write-region (point-min) (point-max) filename nil 
nil nil 'excl)
+                         ;; Since we are creating the file, it seems sensible 
to delete it in case of an
+                         ;; error while writing to it (e.g. a disk-full 
error).  And we ignore any errors
+                         ;; encountered while deleting the file, which would 
obscure the original error.
+                         (error (ignore-errors
+                                  (when (file-exists-p filename)
+                                    (delete-file filename)))
+                                (signal (car err) (cdr err))))
+                       (funcall then filename)))
+                    ((pred functionp) (lambda ()
+                                        (let ((coding-system (or 
(plz--coding-system) 'utf-8)))
+                                          (plz--narrow-to-body)
+                                          (when decode
+                                            (decode-coding-region (point) 
(point-max) coding-system))
+                                          (funcall then (funcall as))))))))
+        (setf plz-then then
+              plz-else else
+              plz-finally finally
+              plz-sync sync-p)
+        ;; Send --config arguments.
+        (process-send-string process curl-config)
+        (when body
+          (cl-typecase body
+            (string (process-send-string process body))
+            (buffer (with-current-buffer body
+                      (process-send-region process (point-min) (point-max))))))
+        (process-send-eof process)
+        (if sync-p
+            (progn
+              (while
+                  ;; According to the Elisp manual, blocking on a process's
+                  ;; output is really this simple.  And it seems to work.
+                  (accept-process-output process))
+              (prog1 plz-result
+                (unless (eq as 'buffer)
+                  (kill-buffer))))
+          process)))))
+
+;;;;; Private
+
+(defun plz--sentinel (process-or-buffer status)
+  "Process buffer of curl output in PROCESS-OR-BUFFER.
+If PROCESS-OR-BUFFER if a process, uses its buffer; if a buffer,
+uses it.  STATUS should be the process's event string (see info
+node `(elisp) Sentinels').  Kills the buffer before returning."
+  ;; Inspired by and some code copied from `elfeed-curl--sentinel'.
+  (let* ((buffer (cl-etypecase process-or-buffer
+                   (process (process-buffer process-or-buffer))
+                   (buffer process-or-buffer)))
+         (finally (buffer-local-value 'plz-finally buffer))
+         sync)
+    (unwind-protect
+        (with-current-buffer buffer
+          (setf sync plz-sync)
+          (pcase-exhaustive status
+            ((or 0 "finished\n")
+             ;; 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
+                 ;; FIXME: Returning a plz-error struct which has a curl-error 
slot, wrapped in a plz-curl-error, is confusing.
+                 (`nil (signal 'plz-curl-error err))
+                 ((pred functionp) (funcall plz-else err)))))
+
+            ("killed\n"
+             ;; Curl process killed.
+             (let ((err (make-plz-error :message "curl process killed")))
+               (pcase-exhaustive plz-else
+                 (`nil (signal 'plz-curl-error err))
+                 ((pred functionp) (funcall plz-else err)))))))
+      (when finally
+        (funcall finally))
+      (unless sync
+        (kill-buffer buffer)))))
+
+;;;;;; HTTP Responses
+
+;; Functions for parsing HTTP responses.
+
+(cl-defun plz--response (&key (decode-p t))
+  "Return response struct for HTTP response in current buffer.
+When DECODE-P is non-nil, decode the response body automatically
+according to the apparent coding system."
+  (save-excursion
+    (goto-char (point-min))
+    ;; Parse HTTP version and status code.
+    (unless (looking-at plz-http-response-status-line-regexp)
+      (error "Unable to parse HTTP response"))
+    (let* ((http-version (string-to-number (match-string 1)))
+           (status-code (string-to-number (match-string 2)))
+           (headers (plz--headers))
+           (coding-system (or (plz--coding-system headers) 'utf-8)))
+      (plz--narrow-to-body)
+      (when decode-p
+        (decode-coding-region (point) (point-max) coding-system))
+      (make-plz-response
+       :version http-version
+       :status status-code
+       :headers headers
+       :body (buffer-string)))))
+
+(defun plz--coding-system (&optional headers)
+  "Return coding system for HTTP response in current buffer.
+HEADERS may optionally be an alist of parsed HTTP headers to
+refer to rather than the current buffer's unparsed headers."
+  (let* ((headers (or headers (plz--headers)))
+         (content-type (alist-get 'content-type headers)))
+    (when content-type
+      (coding-system-from-name content-type))))
+
+(defun plz--http-status ()
+  "Return HTTP status code for HTTP response in current buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (when (looking-at plz-http-response-status-line-regexp)
+      (string-to-number (match-string 2)))))
+
+(defun plz--headers ()
+  "Return headers alist for HTTP response in current buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (forward-line 1)
+    (let ((limit (save-excursion
+                   (re-search-forward "^\r\n" nil)
+                   (point))))
+      (cl-loop while (re-search-forward (rx bol (group (1+ (not (in ":")))) 
":" (1+ blank)
+                                            (group (1+ (not (in "\r\n")))))
+                                        limit t)
+               ;; NOTE: Some HTTP servers send all-lowercase header keys, 
which means an alist
+               ;; lookup with `equal' or `string=' fails when the case 
differs.  We don't want
+               ;; users to have to worry about this, so for consistency, we 
downcase the
+               ;; header name.  And while we're at it, we might as well intern 
it so we can
+               ;; use `alist-get' without having to add "nil nil #'equal" 
every time.
+               collect (cons (intern (downcase (match-string 1))) 
(match-string 2))))))
+
+(defun plz--narrow-to-body ()
+  "Narrow to body of HTTP response in current buffer."
+  (goto-char (point-min))
+  (re-search-forward "^\r\n" nil)
+  (narrow-to-region (point) (point-max)))
+
+;;;; Footer
+
+(provide 'plz)
+
+;;; plz.el ends here