[elpa] externals/plz f0a0d114a6 01/81: Initial commit

[ELPA Syncer]

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

    Initial commit
---
 http-lib.el           | 256 ++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-http-lib.el |  53 +++++++++++
 2 files changed, 309 insertions(+)

diff --git a/http-lib.el b/http-lib.el
new file mode 100644
index 0000000000..7903dcbb33
--- /dev/null
+++ b/http-lib.el
@@ -0,0 +1,256 @@
+;;; http-lib.el --- HTTP library                         -*- lexical-binding: 
t; -*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Keywords:
+
+;; 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.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'subr-x)
+
+;;;; Structs
+
+(cl-defstruct http-lib-response
+  version status headers body)
+
+;;;; Constants
+
+(defconst http-lib-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 http-lib-error nil
+  "Callback function for errored completion of request in current curl process 
buffer.")
+
+(defvar-local http-lib-success nil
+  "Callback function for successful completion of request in current curl 
process buffer.")
+
+;;;; Customization
+
+(defgroup http-lib nil
+  "Options for `http-lib'."
+  :group 'network)
+
+(defcustom http-lib-curl-program "curl"
+  "Name of curl program to call."
+  :type 'string)
+
+(defcustom http-lib-curl-default-args
+  '("--silent"
+    "--compressed"
+    "--location"
+    ;;  "--write-out" "(http-lib-curl-request . %%{size_header})"
+    "--connect-timeout" "5"
+    "--dump-header" "-")
+  "Default arguments to curl."
+  :type '(repeat string))
+
+;; (defcustom http-lib-curl-connection-timeout 5
+;;   "Default connection timeout for HTTP requests made with curl.
+;; The --connect-timeout option for curl.")
+
+;;;; Commands
+
+
+;;;; Functions
+
+(cl-defun http-lib-get (url &key headers _connect-timeout
+                            success error)
+  "FIXME: Docstring."
+  (http-lib-request 'get url
+                    :headers headers
+                    ;;  :connect-timeout timeout
+                    :success success
+                    :error error))
+
+(cl-defun http-lib-request (_method url &key headers _connect-timeout
+                                    success error)
+  "FIXME: Docstring."
+  ;; Inspired by and copied from `elfeed-curl-retrieve'.
+  (with-current-buffer (generate-new-buffer "*http-lib-request-curl*")
+    (let* ((coding-system-for-read 'binary)
+           (process-connection-type nil)
+           (header-args (cl-loop for (key . value) in headers
+                                 collect (format "--header %s: %s" key value)))
+           (curl-args (append http-lib-curl-default-args header-args
+                              (list url)))
+           (process (apply #'start-process "http-lib-request-curl" 
(current-buffer)
+                           http-lib-curl-program curl-args)))
+      (setf http-lib-success success
+            http-lib-error error
+            (process-sentinel process) #'http-lib--sentinel)
+      process)))
+
+(defun http-lib--sentinel (process status)
+  "FIXME: Docstring."
+  ;; Inspired by and some code copied from `elfeed-curl--sentinel'.
+  (let ((buffer (process-buffer process)))
+    (unwind-protect
+        (with-current-buffer buffer
+          (pcase status
+            ("finished\n"
+             ;; Request completed successfully: call success callback with 
parsed response.
+             (let ((response (http-lib--parse-response buffer)))
+               (funcall http-lib-success response)))
+
+            ((rx "exited abnormally with code " (group (1+ digit)))
+             ;; Error: call error callback.
+             ;; FIXME: Call with an error struct.
+             (warn "http-lib--sentinel: ERROR: %s" (buffer-string))
+             ;; (let* ((code (string-to-number (match-string 1 status)))
+             ;;        (message (alist-get code http-lib-curl-errors)))
+             ;;   (funcall http-lib-error (http-lib--parse-response buffer)))
+             )))
+      (kill-buffer buffer))))
+
+(defun http-lib--parse-response (buffer)
+  "FIXME: Docstring."
+  (with-current-buffer 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))))
+      (let* ((http-version (string-to-number (match-string 1)))
+             (status-code (string-to-number (match-string 2)))
+             (headers (http-lib--headers buffer))
+             (coding-system (or (when-let* ((it (alist-get "Content-Type" 
headers nil nil #'string=)))
+                                  (coding-system-from-name it))
+                                'utf-8))
+             (body (http-lib--decode-body buffer coding-system)))
+        (make-http-lib-response
+         :version http-version
+         :status status-code
+         :headers headers
+         :body body)))))
+
+(defun http-lib--headers (buffer)
+  "FIXME: Docstring."
+  (with-current-buffer 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)
+                 collect (cons (match-string 1) (match-string 2)))))))
+
+(defun http-lib--decode-body (buffer coding-system)
+  "FIXME: Docstring."
+  (with-current-buffer buffer
+    (save-excursion
+      (goto-char (point-min))
+      ;; Skip headers.
+      (re-search-forward "^\r\n" nil)
+      (decode-coding-region (point) (point-max) coding-system t))))
+
+
+;;;; Footer
+
+(provide 'http-lib)
+
+;;; http-lib.el ends here
diff --git a/test/test-http-lib.el b/test/test-http-lib.el
new file mode 100644
index 0000000000..9ad0582bd1
--- /dev/null
+++ b/test/test-http-lib.el
@@ -0,0 +1,53 @@
+;;; test-http-lib.el --- Tests for http-lib          -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2019  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Keywords:
+
+;; 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:
+
+;;
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'ert)
+
+;;;; Variables
+
+
+;;;; Customization
+
+
+;;;; Commands
+
+
+;;;; Functions
+
+;;;; Tests
+
+(ert-deftest http-lib-get nil
+  (http-lib-response-body (http-lib-get "https://httpbin.org/get";))
+  )
+
+
+;;;; Footer
+
+(provide 'test-http-lib)
+
+;;; test-http-lib.el ends here