From a8b81ba7919fed12f6153bc143221da1a5bee870 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sun, 26 Nov 2023 16:26:07 +0100 Subject: [PATCH] update request Signed-off-by: Andreas Gerler --- elpa/request-20200127.21/request-autoloads.el | 22 - elpa/request-20200127.21/request-pkg.el | 2 - .../request-20230127.417/request-autoloads.el | 213 ++++++ elpa/request-20230127.417/request-pkg.el | 2 + .../request.el | 690 ++++++++---------- 5 files changed, 527 insertions(+), 402 deletions(-) delete mode 100644 elpa/request-20200127.21/request-autoloads.el delete mode 100644 elpa/request-20200127.21/request-pkg.el create mode 100644 elpa/request-20230127.417/request-autoloads.el create mode 100644 elpa/request-20230127.417/request-pkg.el rename elpa/{request-20200127.21 => request-20230127.417}/request.el (71%) diff --git a/elpa/request-20200127.21/request-autoloads.el b/elpa/request-20200127.21/request-autoloads.el deleted file mode 100644 index f6db8b1b..00000000 --- a/elpa/request-20200127.21/request-autoloads.el +++ /dev/null @@ -1,22 +0,0 @@ -;;; request-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "request" "request.el" (0 0 0 0)) -;;; Generated autoloads from request.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "request" '("request-"))) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; request-autoloads.el ends here diff --git a/elpa/request-20200127.21/request-pkg.el b/elpa/request-20200127.21/request-pkg.el deleted file mode 100644 index e375bf03..00000000 --- a/elpa/request-20200127.21/request-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "request" "20200127.21" "Compatible layer for URL request in Emacs" '((emacs "24.4")) :commit "431d14343c61bc51a86c9a9e1acb6c26fe9a6298" :authors '(("Takafumi Arakaki ")) :maintainer '("Takafumi Arakaki ") :url "https://github.com/tkf/emacs-request") diff --git a/elpa/request-20230127.417/request-autoloads.el b/elpa/request-20230127.417/request-autoloads.el new file mode 100644 index 00000000..4ab73860 --- /dev/null +++ b/elpa/request-20230127.417/request-autoloads.el @@ -0,0 +1,213 @@ +;;; request-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "request" "request.el" (0 0 0 0)) +;;; Generated autoloads from request.el + +(autoload 'request-response-header "request" "\ +Fetch the values of RESPONSE header field named FIELD-NAME. + +It returns comma separated values when the header has multiple +field with the same name, as :RFC:`2616` specifies. + +Examples:: + + (request-response-header response + \"content-type\") ; => \"text/html; charset=utf-8\" + (request-response-header response + \"unknown-field\") ; => nil + +\(fn RESPONSE FIELD-NAME)" nil nil) + +(autoload 'request-response-headers "request" "\ +Return RESPONSE headers as an alist. +I would have chosen a function name that wasn't so suggestive that +`headers` is a member of the `request-response` struct, but +as there's already precedent with `request-response-header', I +hew to consistency. + +\(fn RESPONSE)" nil nil) + +(autoload 'request "request" "\ +Main entry requesting URL with property list SETTINGS as follow. + +==================== ======================================================== +Keyword argument Explanation +==================== ======================================================== +TYPE (string) type of request to make: POST/GET/PUT/DELETE +PARAMS (alist) set \"?key=val\" part in URL +DATA (string/alist) data to be sent to the server +FILES (alist) files to be sent to the server (see below) +PARSER (symbol) a function that reads current buffer and return data +HEADERS (alist) additional headers to send with the request +ENCODING (symbol) encoding for request body (utf-8 by default) +SUCCESS (function) called on success +ERROR (function) called on error +COMPLETE (function) called on both success and error +TIMEOUT (number) timeout in second +STATUS-CODE (alist) map status code (int) to callback +SYNC (bool) If non-nil, wait until request is done. Default is nil. +==================== ======================================================== + + +* Callback functions + +Callback functions STATUS, ERROR, COMPLETE and `cdr\\='s in element of +the alist STATUS-CODE take same keyword arguments listed below. For +forward compatibility, these functions must ignore unused keyword +arguments (i.e., it\\='s better to use `&allow-other-keys\\=' [#]_).:: + + (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE + :data data ; whatever PARSER function returns, or nil + :error-thrown error-thrown ; (ERROR-SYMBOL . DATA), or nil + :symbol-status symbol-status ; success/error/timeout/abort/parse-error + :response response ; request-response object + ...) + +.. [#] `&allow-other-keys\\=' is a special \"markers\" available in macros + in the CL library for function definition such as `cl-defun\\=' and + `cl-function\\='. Without this marker, you need to specify all arguments + to be passed. This becomes problem when request.el adds new arguments + when calling callback functions. If you use `&allow-other-keys\\=' + (or manually ignore other arguments), your code is free from this + problem. See info node `(cl) Argument Lists\\=' for more information. + +Arguments data, error-thrown, symbol-status can be accessed by +`request-response-data\\=', `request-response-error-thrown\\=', +`request-response-symbol-status\\=' accessors, i.e.:: + + (request-response-data RESPONSE) ; same as data + +Response object holds other information which can be accessed by +the following accessors: +`request-response-status-code\\=', +`request-response-url\\=' and +`request-response-settings\\=' + +* STATUS-CODE callback + +STATUS-CODE is an alist of the following format:: + + ((N-1 . CALLBACK-1) + (N-2 . CALLBACK-2) + ...) + +Here, N-1, N-2,... are integer status codes such as 200. + + +* FILES + +FILES is an alist of the following format:: + + ((NAME-1 . FILE-1) + (NAME-2 . FILE-2) + ...) + +where FILE-N is a list of the form:: + + (FILENAME &key PATH BUFFER STRING MIME-TYPE) + +FILE-N can also be a string (path to the file) or a buffer object. +In that case, FILENAME is set to the file name or buffer name. + +Example FILES argument:: + + `((\"passwd\" . \"/etc/passwd\") ; filename = passwd + (\"scratch\" . ,(get-buffer \"*scratch*\")) ; filename = *scratch* + (\"passwd2\" . (\"password.txt\" :file \"/etc/passwd\")) + (\"scratch2\" . (\"scratch.txt\" :buffer ,(get-buffer \"*scratch*\"))) + (\"data\" . (\"data.csv\" :data \"1,2,3\\n4,5,6\\n\"))) + +.. note:: FILES is implemented only for curl backend for now. + As furl.el_ supports multipart POST, it should be possible to + support FILES in pure elisp by making furl.el_ another backend. + Contributions are welcome. + + .. _furl.el: https://code.google.com/p/furl-el/ + + +* PARSER function + +PARSER function takes no argument and it is executed in the +buffer with HTTP response body. The current position in the HTTP +response buffer is at the beginning of the buffer. As the HTTP +header is stripped off, the cursor is actually at the beginning +of the response body. So, for example, you can pass `json-read\\=' +to parse JSON object in the buffer. To fetch whole response as a +string, pass `buffer-string\\='. + +When using `json-read\\=', it is useful to know that the returned +type can be modified by `json-object-type\\=', `json-array-type\\=', +`json-key-type\\=', `json-false\\=' and `json-null\\='. See docstring of +each function for what it does. For example, to convert JSON +objects to plist instead of alist, wrap `json-read\\=' by `lambda\\=' +like this.:: + + (request + \"https://...\" + :parser (lambda () + (let ((json-object-type \\='plist)) + (json-read))) + ...) + +This is analogous to the `dataType\\=' argument of jQuery.ajax_. +Only this function can access to the process buffer, which +is killed immediately after the execution of this function. + +* SYNC + +Synchronous request is functional, but *please* don\\='t use it +other than testing or debugging. Emacs users have better things +to do rather than waiting for HTTP request. If you want a better +way to write callback chains, use `request-deferred\\='. + +If you can\\='t avoid using it (e.g., you are inside of some hook +which must return some value), make sure to set TIMEOUT to +relatively small value. + +Due to limitation of `url-retrieve-synchronously\\=', response slots +`request-response-error-thrown\\=', `request-response-history\\=' and +`request-response-url\\=' are unknown (always nil) when using +synchronous request with `url-retrieve\\=' backend. + +* Note + +API of `request\\=' is somewhat mixture of jQuery.ajax_ (Javascript) +and requests.request_ (Python). + +.. _jQuery.ajax: https://api.jquery.com/jQuery.ajax/ +.. _requests.request: https://docs.python-requests.org + +\(fn URL &rest SETTINGS &key (PARAMS nil) (DATA nil) (HEADERS nil) (ENCODING \\='utf-8) (ERROR nil) (SYNC nil) (RESPONSE (make-request-response)) &allow-other-keys)" nil nil) + +(function-put 'request 'lisp-indent-function 'defun) + +(autoload 'request-untrampify-filename "request" "\ +Return FILE as the local file name. + +\(fn FILE)" nil nil) + +(autoload 'request-abort "request" "\ +Abort request for RESPONSE (the object returned by `request'). +Note that this function invoke ERROR and COMPLETE callbacks. +Callbacks may not be called immediately but called later when +associated process is exited. + +\(fn RESPONSE)" nil nil) + +(register-definition-prefixes "request" '("request-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; request-autoloads.el ends here diff --git a/elpa/request-20230127.417/request-pkg.el b/elpa/request-20230127.417/request-pkg.el new file mode 100644 index 00000000..0054698c --- /dev/null +++ b/elpa/request-20230127.417/request-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from request.el -*- no-byte-compile: t -*- +(define-package "request" "20230127.417" "Compatible layer for URL request" '((emacs "24.4")) :commit "01e338c335c07e4407239619e57361944a82cb8a" :authors '(("Takafumi Arakaki ")) :maintainers '(("Takafumi Arakaki ")) :maintainer '("Takafumi Arakaki ") :url "https://github.com/tkf/emacs-request") diff --git a/elpa/request-20200127.21/request.el b/elpa/request-20230127.417/request.el similarity index 71% rename from elpa/request-20200127.21/request.el rename to elpa/request-20230127.417/request.el index 170215d0..785db5ae 100644 --- a/elpa/request-20200127.21/request.el +++ b/elpa/request-20230127.417/request.el @@ -1,4 +1,4 @@ -;;; request.el --- Compatible layer for URL request in Emacs -*- lexical-binding: t; -*- +;;; request.el --- Compatible layer for URL request -*- lexical-binding: t; -*- ;; Copyright (C) 2012 Takafumi Arakaki ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012 @@ -6,9 +6,10 @@ ;; Author: Takafumi Arakaki ;; URL: https://github.com/tkf/emacs-request -;; Package-Version: 20200127.21 +;; Package-Version: 20230127.417 +;; Package-Commit: 01e338c335c07e4407239619e57361944a82cb8a ;; Package-Requires: ((emacs "24.4")) -;; Version: 0.3.2 +;; Version: 0.3.3 ;; This file is NOT part of GNU Emacs. @@ -24,21 +25,15 @@ ;; You should have received a copy of the GNU General Public License ;; along with request.el. -;; If not, see . +;; If not, see . ;;; Commentary: -;; Request.el is a HTTP request library with multiple backends. It -;; supports url.el which is shipped with Emacs and curl command line -;; program. User can use curl when s/he has it, as curl is more reliable -;; than url.el. Library author can use request.el to avoid imposing -;; external dependencies such as curl to users while giving richer -;; experience for users who have curl. - -;; Following functions are adapted from GNU Emacs source code. -;; Free Software Foundation holds the copyright of them. -;; * `request--process-live-p' -;; * `request--url-default-expander' +;; Uses ``curl`` as its backend or Emacs's native ``url.el`` library if +;; ``curl`` is not found. +;; +;; The default encoding for requests is ``utf-8``. Please explicitly specify +;; ``:encoding 'binary`` for binary data. ;;; Code: @@ -49,18 +44,15 @@ (require 'cl-lib) (require 'url) (require 'mail-utils) -(require 'autorevert) (require 'auth-source) +(require 'mailheader) (defgroup request nil "Compatible layer for URL request in Emacs." :group 'comm :prefix "request-") -(defconst request-version "0.3.0") - - -;;; Customize variables +(defconst request-version "0.3.3") (defcustom request-storage-directory (concat (file-name-as-directory user-emacs-directory) "request") @@ -72,10 +64,10 @@ :type 'string) (defcustom request-curl-options nil - "curl command options. + "List of curl command options. -List of strings that will be passed to every curl invocation. You can pass -extra options here, like setting the proxy." +List of strings that will be passed to every curl invocation. +You can pass extra options here, like setting the proxy." :type '(repeat string)) (defcustom request-backend (if (executable-find request-curl) @@ -88,14 +80,11 @@ Automatically set to `curl' if curl command is found." (defcustom request-timeout nil "Default request timeout in second. -`nil' means no timeout." +nil means no timeout." :type '(choice (integer :tag "Request timeout seconds") (boolean :tag "No timeout" nil))) -(defcustom request-temp-prefix "emacs-request" - "Prefix for temporary files created by Request." - :type 'string - :risky t) +(make-obsolete-variable 'request-temp-prefix nil "0.3.3") (defcustom request-log-level -1 "Logging level for request. @@ -122,41 +111,12 @@ See `request-log-level'." (const :tag "Level TRACE" trace) (const :tag "Level BLATHER" blather))) - -;;; Utilities - -(defun request--safe-apply (function &rest arguments) - "Apply FUNCTION with ARGUMENTS, suppressing any errors." - (condition-case nil - (apply #'apply function arguments) - ((debug error)))) - -(defun request--safe-call (function &rest arguments) - (request--safe-apply function arguments)) - -;; (defun request--url-no-cache (url) -;; "Imitate `cache=false' of `jQuery.ajax'. -;; See: http://api.jquery.com/jQuery.ajax/" -;; ;; FIXME: parse URL before adding ?_=TIME. -;; (concat url (format-time-string "?_=%s"))) - (defmacro request--document-function (function docstring) "Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc." (declare (indent defun) (doc-string 2)) `(put ',function 'function-documentation ,docstring)) -(defun request--process-live-p (process) - "Copied from `process-live-p' for backward compatibility (Emacs < 24). -Adapted from lisp/subr.el. -FSF holds the copyright of this function: - Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012 - Free Software Foundation, Inc." - (memq (process-status process) '(run open listen connect stop))) - - -;;; Logging - (defconst request--log-level-def '(;; debugging (blather . 60) (trace . 50) (debug . 40) @@ -166,43 +126,29 @@ FSF holds the copyright of this function: (warn . 10) (error . 0)) "Named logging levels.") -(defun request--log-level-as-int (level) - (if (integerp level) - level - (or (cdr (assq level request--log-level-def)) - 0))) - (defvar request-log-buffer-name " *request-log*") -(defun request--log-buffer () - (get-buffer-create request-log-buffer-name)) - (defmacro request-log (level fmt &rest args) + "Main logging function at warning LEVEL in FMT with ARGS." (declare (indent 1)) - `(let ((level (request--log-level-as-int ,level)) - (log-level (request--log-level-as-int request-log-level)) - (msg-level (request--log-level-as-int request-message-level))) - (when (<= level (max log-level msg-level)) - (let ((msg (format "[%s] %s" ,level - (condition-case err - (format ,fmt ,@args) - (error (format " -!!! Logging error while executing: -%S -!!! Error: -%S" - ',args err)))))) - (when (<= level log-level) - (with-current-buffer (request--log-buffer) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert msg "\n")))) - (when (<= level msg-level) - (message "%s" msg)))))) - - -;;; HTTP specific utilities + `(cl-flet ((log-level-as-int + (level) + (if (integerp level) + level + (or (cdr (assq level request--log-level-def)) 0)))) + (let ((level (log-level-as-int ,level)) + (log-level (log-level-as-int request-log-level)) + (msg-level (log-level-as-int request-message-level))) + (when (<= level (max log-level msg-level)) + (let ((msg (format "[%s] %s" ,level (format ,fmt ,@args)))) + (when (<= level log-level) + (with-current-buffer (get-buffer-create request-log-buffer-name) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert msg "\n")))) + (when (<= level msg-level) + (message "%s" msg))))))) (defconst request--url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z @@ -214,7 +160,7 @@ This is used for making `request--urlencode-alist' RFC 3986 compliant for older Emacs versions.") (defun request--urlencode-alist (alist) - ;; FIXME: make monkey patching `url-unreserved-chars' optional + "Hexify ALIST fields according to RFC3986." (let ((url-unreserved-chars request--url-unreserved-chars)) (cl-loop for sep = "" then "&" for (k . v) in alist @@ -223,8 +169,6 @@ for older Emacs versions.") concat "=" concat (url-hexify-string (format "%s" v))))) - -;;; Header parser (defun request--parse-response-at-point () "Parse the first header line such as \"HTTP/1.1 200 OK\"." @@ -233,21 +177,19 @@ for older Emacs versions.") :code (string-to-number (match-string 2))))) (defun request--goto-next-body (&optional noerror) + "Scan forward to next blank line allowing NOERROR if missing." (re-search-forward "^\r\n" nil noerror)) - -;;; Response object - (cl-defstruct request-response "A structure holding all relevant information of a request." status-code history data error-thrown symbol-status url done-p settings ;; internal variables - -buffer -raw-header -timer -backend -tempfiles) + -buffer -raw-header -timer -backend) (defmacro request--document-response (function docstring) - (declare (indent defun) - (doc-string 2)) + "Append to FUNCTION's DOCSTRING some more canned verbiage." + (declare (indent defun) (doc-string 2)) `(request--document-function ,function ,(concat docstring " .. This is an accessor for `request-response' object. @@ -274,8 +216,7 @@ Slots Backends request-response-url yes yes request-response-header yes no other functions no no -==================================== ============== ============== -") +==================================== ============== ==============") (request--document-response request-response-data "Response parsed by the given parser.") @@ -301,6 +242,7 @@ Some arguments such as HEADERS is changed to the one actually passed to the backend. Also, it has additional keywords such as URL which is the requested URL.") +;;;###autoload (defun request-response-header (response field-name) "Fetch the values of RESPONSE header field named FIELD-NAME. @@ -312,8 +254,7 @@ Examples:: (request-response-header response \"content-type\") ; => \"text/html; charset=utf-8\" (request-response-header response - \"unknown-field\") ; => nil -" + \"unknown-field\") ; => nil" (let ((raw-header (request-response--raw-header response))) (when raw-header (with-temp-buffer @@ -323,11 +264,23 @@ Examples:: ;; separated value [#rfc2616-sec4]_. (mail-fetch-field field-name nil t))))) ;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do -;; (see http://tools.ietf.org/html/rfc2616.html#section-4.2). +;; (see https://tools.ietf.org/html/rfc2616.html#section-4.2). ;; Python's requests module does this too. - -;;; Backend dispatcher +;;;###autoload +(defun request-response-headers (response) + "Return RESPONSE headers as an alist. +I would have chosen a function name that wasn't so suggestive that +`headers` is a member of the `request-response` struct, but +as there's already precedent with `request-response-header', I +hew to consistency." + (let ((raw-header (request-response--raw-header response))) + (when raw-header + (with-temp-buffer + (save-excursion (insert raw-header)) + (when (save-excursion (request--parse-response-at-point)) + (forward-line)) + (mail-header-extract-no-properties))))) (defconst request--backend-alist '((url-retrieve @@ -357,39 +310,27 @@ let's stick to manual dispatch for now.") (assoc-default method (or (assoc-default request-backend request--backend-alist) - (error "%S is not valid `request-backend'." request-backend)))) + (error "%S is not valid `request-backend'" request-backend)))) - -;;; Cookie (defun request-cookie-string (host &optional localpart secure) - "Return cookie string (like `document.cookie'). - + "Lookup HOST LOCALPART SECURE in cookie jar as`document.cookie` string. Example:: - (request-cookie-string \"127.0.0.1\" \"/\") ; => \"key=value; key2=value2\" -" + (request-cookie-string \"127.0.0.1\" \"/\") ; => \"key=value; key2=value2\"" (mapconcat (lambda (nv) (concat (car nv) "=" (cdr nv))) (request-cookie-alist host localpart secure) "; ")) (defun request-cookie-alist (host &optional localpart secure) - "Return cookies as an alist. + "Lookup HOST LOCALPART SECURE in cookie jar as alist. Example:: - (request-cookie-alist \"127.0.0.1\" \"/\") ; => ((\"key\" . \"value\") ...) -" + (request-cookie-alist \"127.0.0.1\" \"/\") ; => ((\"key\" . \"value\") ...)" (funcall (request--choose-backend 'get-cookies) host localpart secure)) - -;;; Main - -(cl-defun request-default-error-callback (url &key symbol-status - &allow-other-keys) - (request-log 'error - "request-default-error-callback: %s %s" url symbol-status)) - +;;;###autoload (cl-defun request (url &rest settings &key (params nil) @@ -400,9 +341,7 @@ Example:: (sync nil) (response (make-request-response)) &allow-other-keys) - "Send request to URL. - -Request.el has a single entry point. It is `request'. + "Main entry requesting URL with property list SETTINGS as follow. ==================== ======================================================== Keyword argument Explanation @@ -419,16 +358,16 @@ ERROR (function) called on error COMPLETE (function) called on both success and error TIMEOUT (number) timeout in second STATUS-CODE (alist) map status code (int) to callback -SYNC (bool) If `t', wait until request is done. Default is `nil'. +SYNC (bool) If non-nil, wait until request is done. Default is nil. ==================== ======================================================== * Callback functions -Callback functions STATUS, ERROR, COMPLETE and `cdr's in element of +Callback functions STATUS, ERROR, COMPLETE and `cdr\\='s in element of the alist STATUS-CODE take same keyword arguments listed below. For forward compatibility, these functions must ignore unused keyword -arguments (i.e., it's better to use `&allow-other-keys' [#]_).:: +arguments (i.e., it\\='s better to use `&allow-other-keys\\=' [#]_).:: (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE :data data ; whatever PARSER function returns, or nil @@ -437,25 +376,25 @@ arguments (i.e., it's better to use `&allow-other-keys' [#]_).:: :response response ; request-response object ...) -.. [#] `&allow-other-keys' is a special \"markers\" available in macros - in the CL library for function definition such as `cl-defun' and - `cl-function'. Without this marker, you need to specify all arguments +.. [#] `&allow-other-keys\\=' is a special \"markers\" available in macros + in the CL library for function definition such as `cl-defun\\=' and + `cl-function\\='. Without this marker, you need to specify all arguments to be passed. This becomes problem when request.el adds new arguments - when calling callback functions. If you use `&allow-other-keys' + when calling callback functions. If you use `&allow-other-keys\\=' (or manually ignore other arguments), your code is free from this - problem. See info node `(cl) Argument Lists' for more information. + problem. See info node `(cl) Argument Lists\\=' for more information. Arguments data, error-thrown, symbol-status can be accessed by -`request-response-data', `request-response-error-thrown', -`request-response-symbol-status' accessors, i.e.:: +`request-response-data\\=', `request-response-error-thrown\\=', +`request-response-symbol-status\\=' accessors, i.e.:: (request-response-data RESPONSE) ; same as data Response object holds other information which can be accessed by the following accessors: -`request-response-status-code', -`request-response-url' and -`request-response-settings' +`request-response-status-code\\=', +`request-response-url\\=' and +`request-response-settings\\=' * STATUS-CODE callback @@ -496,7 +435,7 @@ Example FILES argument:: support FILES in pure elisp by making furl.el_ another backend. Contributions are welcome. - .. _furl.el: http://code.google.com/p/furl-el/ + .. _furl.el: https://code.google.com/p/furl-el/ * PARSER function @@ -505,62 +444,64 @@ PARSER function takes no argument and it is executed in the buffer with HTTP response body. The current position in the HTTP response buffer is at the beginning of the buffer. As the HTTP header is stripped off, the cursor is actually at the beginning -of the response body. So, for example, you can pass `json-read' +of the response body. So, for example, you can pass `json-read\\=' to parse JSON object in the buffer. To fetch whole response as a -string, pass `buffer-string'. +string, pass `buffer-string\\='. -When using `json-read', it is useful to know that the returned -type can be modified by `json-object-type', `json-array-type', -`json-key-type', `json-false' and `json-null'. See docstring of +When using `json-read\\=', it is useful to know that the returned +type can be modified by `json-object-type\\=', `json-array-type\\=', +`json-key-type\\=', `json-false\\=' and `json-null\\='. See docstring of each function for what it does. For example, to convert JSON -objects to plist instead of alist, wrap `json-read' by `lambda' +objects to plist instead of alist, wrap `json-read\\=' by `lambda\\=' like this.:: (request - \"http://...\" + \"https://...\" :parser (lambda () - (let ((json-object-type 'plist)) + (let ((json-object-type \\='plist)) (json-read))) ...) -This is analogous to the `dataType' argument of jQuery.ajax_. +This is analogous to the `dataType\\=' argument of jQuery.ajax_. Only this function can access to the process buffer, which is killed immediately after the execution of this function. * SYNC -Synchronous request is functional, but *please* don't use it +Synchronous request is functional, but *please* don\\='t use it other than testing or debugging. Emacs users have better things to do rather than waiting for HTTP request. If you want a better -way to write callback chains, use `request-deferred'. +way to write callback chains, use `request-deferred\\='. -If you can't avoid using it (e.g., you are inside of some hook +If you can\\='t avoid using it (e.g., you are inside of some hook which must return some value), make sure to set TIMEOUT to relatively small value. -Due to limitation of `url-retrieve-synchronously', response slots -`request-response-error-thrown', `request-response-history' and -`request-response-url' are unknown (always `nil') when using -synchronous request with `url-retrieve' backend. +Due to limitation of `url-retrieve-synchronously\\=', response slots +`request-response-error-thrown\\=', `request-response-history\\=' and +`request-response-url\\=' are unknown (always nil) when using +synchronous request with `url-retrieve\\=' backend. * Note -API of `request' is somewhat mixture of jQuery.ajax_ (Javascript) +API of `request\\=' is somewhat mixture of jQuery.ajax_ (Javascript) and requests.request_ (Python). -.. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/ -.. _requests.request: http://docs.python-requests.org -" +.. _jQuery.ajax: https://api.jquery.com/jQuery.ajax/ +.. _requests.request: https://docs.python-requests.org" (declare (indent defun)) ;; FIXME: support CACHE argument (if possible) ;; (unless cache ;; (setq url (request--url-no-cache url))) (unless error - (setq error (apply-partially #'request-default-error-callback url)) + (setq error (cl-function + (lambda (&rest args &key symbol-status &allow-other-keys) + (request-log 'error + "request-default-error-callback: %s %s" + url symbol-status)))) (setq settings (plist-put settings :error error))) - (unless (or (stringp data) - (null data) - (assoc-string "Content-Type" headers t)) + (when (and (consp data) + (not (assoc-string "Content-Type" headers t))) (setq data (request--urlencode-alist data)) (setq settings (plist-put settings :data data))) (when params @@ -581,7 +522,7 @@ and requests.request_ (Python). response) (defun request--clean-header (response) - "Strip off carriage returns in the header of REQUEST." + "Strip off carriage return in the header of RESPONSE." (let* ((buffer (request-response--buffer response)) (backend (request-response--backend response)) ;; FIXME: a workaround when `url-http-clean-headers' fails... @@ -602,8 +543,7 @@ and requests.request_ (Python). (replace-match ""))))))) (defun request--cut-header (response) - "Cut the first header part in the buffer of RESPONSE and move it to -raw-header slot." + "Move the header to the raw-header slot of RESPONSE object." (let ((buffer (request-response--buffer response))) (when (buffer-live-p buffer) (with-current-buffer buffer @@ -615,13 +555,13 @@ raw-header slot." (buffer-substring (point-min) (min (1+ (point)) (point-max)))) (delete-region (point-min) (min (1+ (point)) (point-max)))))))) +;;;###autoload (defun request-untrampify-filename (file) "Return FILE as the local file name." (or (file-remote-p file 'localname) file)) (defun request--parse-data (response encoding parser) - "For buffer held by RESPONSE, first decode via user's ENCODING elective, -then send to PARSER." + "In RESPONSE buffer, decode via ENCODING, then send to PARSER." (let ((buffer (request-response--buffer response))) (when (buffer-live-p buffer) (with-current-buffer buffer @@ -644,15 +584,20 @@ then send to PARSER." status-code response encoding &allow-other-keys) + "Parse BUFFER according to PARSER. +Delegate to callbacks SUCCESS, ERROR, and COMPLETE the STATUS-CODE of +RESPONSE via ENCODING." + (when (buffer-live-p buffer) + ;; questionable whether BUFFER should override RESPONSE. + (setf (request-response--buffer response) buffer)) (request-log 'debug "request--callback: UNPARSED\n%s" - (when (buffer-live-p buffer) - (with-current-buffer buffer (buffer-string)))) - - ;; Sometimes BUFFER given as the argument is different from the - ;; buffer already set in RESPONSE. That's why it is reset here. - ;; FIXME: Refactor how BUFFER is passed around. - (setf (request-response--buffer response) buffer) - (request-response--cancel-timer response) + (when (buffer-live-p (request-response--buffer response)) + (with-current-buffer (request-response--buffer response) + (buffer-string)))) + (cl-symbol-macrolet ((timer (request-response--timer response))) + (when timer + (cancel-timer timer) + (setq timer nil))) (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) (symbol-status (request-response-symbol-status response)) @@ -670,7 +615,7 @@ then send to PARSER." (request--parse-data response encoding parser) (error (unless error-thrown (setq error-thrown err)) (unless symbol-status (setq symbol-status 'parse-error)))) - (kill-buffer buffer) + (kill-buffer (request-response--buffer response)) ;; Ensuring `symbol-status' and `error-thrown' are consistent ;; is why we should get rid of `symbol-status' @@ -692,32 +637,26 @@ then send to PARSER." (name (if success-p "success" "error"))) (when cb (request-log 'debug "request--callback: executing %s" name) - (request--safe-apply cb args))) - + (apply cb args))) (let ((cb (cdr (assq (request-response-status-code response) status-code)))) (when cb (request-log 'debug "request--callback: executing status-code") - (request--safe-apply cb args))) - + (apply cb args))) (when complete (request-log 'debug "request--callback: executing complete") - (request--safe-apply complete args))) - - (setq done-p t) + (apply complete args))) - ;; Remove temporary files - ;; FIXME: Make tempfile cleanup more reliable. It is possible - ;; callback is never called. - (request--safe-delete-files (request-response--tempfiles response)))) + (setq done-p t))) (cl-defun request-response--timeout-callback (response) + "If RESPONSE times out, ensure `request--callback' gets called." (setf (request-response-symbol-status response) 'timeout) (setf (request-response-error-thrown response) '(error . ("Timeout"))) (let* ((buffer (request-response--buffer response)) (proc (and (buffer-live-p buffer) (get-buffer-process buffer)))) (if proc - ;; This will call `request--callback': + ;; This implicitly calls `request--callback'! (funcall (request--choose-backend 'terminate-process) proc) (cl-symbol-macrolet ((done-p (request-response-done-p response))) (unless done-p @@ -732,13 +671,7 @@ then send to PARSER." (request-response-settings response)) (setq done-p t)))))) -(defun request-response--cancel-timer (response) - (cl-symbol-macrolet ((timer (request-response--timer response))) - (when timer - (cancel-timer timer) - (setq timer nil)))) - - +;;;###autoload (defun request-abort (response) "Abort request for RESPONSE (the object returned by `request'). Note that this function invoke ERROR and COMPLETE callbacks. @@ -751,18 +684,15 @@ associated process is exited." (unless symbol-status ; should I use done-p here? (setq symbol-status 'abort) (setq done-p t) - (when (and - (processp process) ; process can be nil when buffer is killed - (request--process-live-p process)) + (when (process-live-p process) (funcall (request--choose-backend 'terminate-process) process)))))) - -;;; Backend: `url-retrieve' (cl-defun request--url-retrieve-preprocess-settings (&rest settings &key type data files headers &allow-other-keys) + "Augment SETTINGS with properties TYPE DATA FILES HEADERS." (when files - (error "`url-retrieve' backend does not support FILES.")) + (error "`url-retrieve' backend does not support FILES")) (when (and (equal type "POST") data (not (assoc-string "Content-Type" headers t))) @@ -774,13 +704,17 @@ associated process is exited." &key type data timeout response &allow-other-keys &aux headers) + "Internal workhorse querying URL via curl. +SETTINGS is a property list with keys (some optional) such as GET or POST TYPE, +DATA for posting fields, TIMEOUT in seconds, RESPONSE a mandatory struct. +HEADERS needs to be assigned after SETTINGS is preprocessed." (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) (setq headers (plist-get settings :headers)) (let* ((url-request-extra-headers headers) (url-request-method type) (url-request-data data) (buffer (url-retrieve url #'request--url-retrieve-callback - (nconc (list :response response) settings))) + (nconc (list :response response) settings) t)) (proc (get-buffer-process buffer))) (request--install-timeout timeout response) (setf (request-response--buffer response) buffer) @@ -790,6 +724,9 @@ associated process is exited." (cl-defun request--url-retrieve-callback (status &rest settings &key response url &allow-other-keys) + "Ensure `request--callback' gets called for STATUS. +SETTINGS should include RESPONSE and URL properties which +inform any necessary redirect or history recording logic." (when (featurep 'url-http) (setf (request-response-status-code response) url-http-response-status)) (let ((redirect (plist-get status :redirect))) @@ -809,20 +746,21 @@ associated process is exited." do (let ((r (make-request-response :-backend 'url-retrieve))) (setf (request-response-url r) v) (push r (request-response-history response)))) - (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) (status-error (plist-get status :error))) (when status-error (request-log 'warn "request--url-retrieve-callback: %s" status-error) (unless error-thrown (setq error-thrown status-error)))) - (apply #'request--callback (current-buffer) settings)) (cl-defun request--url-retrieve-sync (url &rest settings &key type data timeout response &allow-other-keys &aux headers) + "Internal synchronous retrieve of URL. +SETTINGS include typical TYPE DATA TIMEOUT RESPONSE properties. +HEADERS needs to be assigned after SETTINGS is preprocessed." (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) (setq headers (plist-get settings :headers)) (let* ((url-request-extra-headers headers) @@ -835,8 +773,8 @@ associated process is exited." 'timeout) (setf (request-response-done-p response) t) nil) - (url-retrieve-synchronously url)) - (url-retrieve-synchronously url)))) + (url-retrieve-synchronously url t)) + (url-retrieve-synchronously url t)))) (setf (request-response--buffer response) buffer) ;; It seems there is no way to get redirects and URL here... (when buffer @@ -851,13 +789,11 @@ associated process is exited." response) (defun request--url-retrieve-get-cookies (host localpart secure) + "Retrieve cookies corresponding to HOST LOCALPART SECURE." (mapcar (lambda (c) (cons (url-cookie-name c) (url-cookie-value c))) (url-cookie-retrieve host localpart secure))) - -;;; Backend: curl - (defvar request--curl-cookie-jar nil "Override what the function `request--curl-cookie-jar' returns. Currently it is used only for testing.") @@ -882,12 +818,12 @@ Currently it is used only for testing.") (call-process request-curl nil t nil "--version") (let ((version (progn - (setf (point) (point-min)) + (goto-char (point-min)) (when (re-search-forward "[.0-9]+" nil t) (match-string 0)))) (compression (progn - (setf (point) (point-min)) + (goto-char (point-min)) (not (null (re-search-forward "libz\\>" nil t)))))) (setf (gethash request-curl request--curl-capabilities-cache) `(:version ,version :compression ,compression))))))) @@ -897,19 +833,40 @@ Currently it is used only for testing.") "\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})" "\\n(:num-redirects %{num_redirects} :url-effective \"%{url_effective}\")")) -(defun request--curl-mkdir-for-cookie-jar () - (ignore-errors - (make-directory (file-name-directory (request--curl-cookie-jar)) t))) - -(cl-defun request--curl-command - (url &key type data headers response files* unix-socket encoding auth +(defun request--curl-stdin-config (&rest args) + "Split ARGS such that we \"Only write one option per physical line\". +Fragile. Some escaping will be necessary for special characters +in user `request-curl-options'." + (let (result) + (dolist (arg args (mapconcat #'identity (reverse (cons "" result)) "\n")) + (if (or (not result) + (string-prefix-p "-" arg)) + (push arg result) + (setcar result (format "%s %s" (car result) + (if (cl-search " " arg) + (format "\"%s\"" + (replace-regexp-in-string + "\"" + (regexp-quote "\\\"") arg)) + arg))))))) + +(defun request--curl-command () + "Stub for test-request.el to override." + (list request-curl "--config" "-")) + +(cl-defun request--curl-command-args + (url &key type data headers files unix-socket auth &allow-other-keys &aux (cookie-jar (convert-standard-filename (expand-file-name (request--curl-cookie-jar))))) - "BUG: Simultaneous requests are a known cause of cookie-jar corruption." + "Internal command cobbler for curl to URL. +TYPE, DATA, HEADERS, FILES, UNIX-SOCKET, AUTH are as described in `request'. +COOKIE-JAR is the file location for the netscape cookie jar, usually +in the request subdirectory of `user-emacs-directory'. + +BUG: Simultaneous requests are a known cause of cookie-jar corruption." (append - (list request-curl - "--silent" "--location" + (list "--silent" "--location" "--cookie" cookie-jar "--cookie-jar" cookie-jar) (when auth (let* ((host (url-host (url-generic-parse-url url))) @@ -929,114 +886,54 @@ Currently it is used only for testing.") request-curl-options (when (plist-get (request--curl-capabilities) :compression) (list "--compressed")) (when unix-socket (list "--unix-socket" unix-socket)) - (cl-loop for (name filename path mime-type) in files* - collect "--form" - collect (format "%s=@%s;filename=%s%s" name - (request-untrampify-filename path) filename - (if mime-type - (format ";type=%s" mime-type) - ""))) - (when data - (let ((tempfile (request--make-temp-file))) - (push tempfile (request-response--tempfiles response)) - ;; We dynamic-let the global `buffer-file-coding-system' to `no-conversion' - ;; in case the user-configured `encoding' doesn't fly. - ;; If we do not dynamic-let the global, `select-safe-coding-system' would - ;; plunge us into an undesirable interactive dialogue. - (let ((buffer-file-coding-system-orig - (default-value 'buffer-file-coding-system)) - (select-safe-coding-system-accept-default-p - (lambda (&rest _) t))) - (setf (default-value 'buffer-file-coding-system) 'no-conversion) - (with-temp-file tempfile - (setq-local buffer-file-coding-system encoding) - (insert data)) - (setf (default-value 'buffer-file-coding-system) - buffer-file-coding-system-orig)) - (list "--data-binary" (concat "@" (request-untrampify-filename tempfile))))) - (when type (list "--request" type)) + (when type (if (equal "head" (downcase type)) + (list "--head") + (list "--request" type))) (cl-loop for (k . v) in headers collect "--header" collect (format "%s: %s" k v)) - (list url))) - -(defun request--curl-normalize-files-1 (files get-temp-file) - (cl-loop for (name . item) in files - collect - (cl-destructuring-bind - (filename &key file buffer data mime-type) - (cond - ((stringp item) (list (file-name-nondirectory item) :file item)) - ((bufferp item) (list (buffer-name item) :buffer item)) - (t item)) - (unless (= (cl-loop for v in (list file buffer data) if v sum 1) 1) - (error "Only one of :file/:buffer/:data must be given. Got: %S" - (cons name item))) - (cond - (file - (list name filename file mime-type)) - (buffer - (let ((tf (funcall get-temp-file))) - (with-current-buffer buffer - (write-region (point-min) (point-max) tf nil 'silent)) - (list name filename tf mime-type))) - (data - (let ((tf (funcall get-temp-file))) - (with-temp-buffer - (erase-buffer) - (insert data) - (write-region (point-min) (point-max) tf nil 'silent)) - (list name filename tf mime-type))))))) - - -(declare-function tramp-get-remote-tmpdir "tramp") -(declare-function tramp-dissect-file-name "tramp") - -(defun request--make-temp-file () - "Create a temporary file." - (if (file-remote-p default-directory) - (let ((temporary-file-directory - (tramp-get-remote-tmpdir (tramp-dissect-file-name default-directory)))) - (make-temp-file request-temp-prefix)) - (make-temp-file request-temp-prefix))) - -(defun request--curl-normalize-files (files) - "Change FILES into a list of (NAME FILENAME PATH MIME-TYPE). -This is to make `request--curl-command' cleaner by converting -FILES to a homogeneous list. It returns a list (FILES* TEMPFILES) -where FILES* is a converted FILES and TEMPFILES is a list of -temporary file paths." - (let (tempfiles noerror) - (unwind-protect - (let* ((get-temp-file (lambda () - (let ((tf (request--make-temp-file))) - (push tf tempfiles) - tf))) - (files* (request--curl-normalize-files-1 files get-temp-file))) - (setq noerror t) - (list files* tempfiles)) - (unless noerror - ;; Remove temporary files only when an error occurs - (request--safe-delete-files tempfiles))))) - -(defun request--safe-delete-files (files) - "Remove FILES but do not raise error when failed to do so." - (mapc (lambda (f) (condition-case err - (delete-file f) - (error (request-log 'error - "request--safe-delete-files: %s %s" - f (error-message-string err))))) - files)) + (list "--url" url) + (when data + (split-string "--data-binary @-")) + (cl-loop with stdin-p = data + for (name . item) in files + collect "--form" + collect + (apply #'format "%s=%s%s;filename=%s%s" + (cond ((stringp item) + (list name "@" item (file-name-nondirectory item) "")) + ((bufferp item) + (if stdin-p + (error (concat "request--curl-command-args: " + "only one buffer or data entry permitted")) + (setq stdin-p t)) + (list name "@" "-" (buffer-name item) "")) + ((listp item) + (unless (plist-get (cdr item) :file) + (if stdin-p + (error (concat "request--curl-command-args: " + "only one buffer or data entry permitted")) + (setq stdin-p t))) + (list name + (if (plist-get (cdr item) :use-contents) "<" "@") + (or (plist-get (cdr item) :file) "-") + (car item) + (if (plist-get (cdr item) :mime-type) + (format ";type=%s" (plist-get (cdr item) :mime-type)) + ""))) + (t (error (concat "request--curl-command-args: " + "%S not string, buffer, or list") + item))))))) (defun request--install-timeout (timeout response) - "Out-of-band trigger after TIMEOUT seconds to prevent hangs." + "Out-of-band trigger after TIMEOUT seconds to forestall a hung RESPONSE." (when (numberp timeout) (setf (request-response--timer response) (run-at-time timeout nil #'request-response--timeout-callback response)))) (defun request--curl-occlude-secret (command) - "Simple regex filter on anything looking like a secret." + "Simple regex filter on anything looking like a secret in COMMAND." (let ((matched (string-match (concat (regexp-quote "--user") "\\s-*\\(\\S-+\\)") command))) (if matched @@ -1044,9 +941,22 @@ temporary file paths." command))) (cl-defun request--curl (url &rest settings - &key files timeout response encoding semaphore + &key data files timeout response encoding semaphore &allow-other-keys) - "cURL-based request backend. + "Internal workhorse querying URL via curl. + +SETTINGS is a property list with keys (some optional) such as DATA for +posting fields, FILES containing one or more lists of the form + (NAME . FILENAME) + (NAME . BUFFER) + (NAME . (FILENAME :buffer BUFFER)) + (NAME . (FILENAME :data DATA)) + (NAME . (FILENAME :file FILE :use-contents t)) +with NAME and FILENAME defined by curl(1)'s overwrought `--form` switch format, +TIMEOUT in seconds, RESPONSE a mandatory struct, ENCODING, and SEMAPHORE, +an internal semaphore. Adding `:use-contents t` sends a text field +with the file's contents as opposed to attaching a file as described +in curl(1). Redirection handling strategy ----------------------------- @@ -1059,29 +969,60 @@ This number is used for removing extra headers and parse location header from the last redirection header. Sexp at the end of buffer and extra headers for redirects are -removed from the buffer before it is shown to the parser function. -" - (request--curl-mkdir-for-cookie-jar) - (let* (;; Use pipe instead of pty. Otherwise, curl process hangs. - (process-connection-type nil) - ;; Avoid starting program in non-existing directory. +removed from the buffer before it is shown to the parser function." + (ignore-errors + (make-directory (file-name-directory (request--curl-cookie-jar)) t)) + (let* (process-connection-type ;; pipe, not pty, else curl hangs (home-directory (or (file-remote-p default-directory) "~/")) (default-directory (expand-file-name home-directory)) (buffer (generate-new-buffer " *request curl*")) - (command (cl-destructuring-bind - (files* tempfiles) - (request--curl-normalize-files files) - (setf (request-response--tempfiles response) tempfiles) - (apply #'request--curl-command url :files* files* - :response response :encoding encoding settings))) + (file-items (mapcar #'cdr files)) + (file-buffer (or (cl-some (lambda (item) + (when (bufferp item) item)) + file-items) + (cl-some (lambda (item) + (and (listp item) + (plist-get (cdr item) :buffer))) + file-items))) + (file-data (cl-some (lambda (item) + (and (listp item) + (plist-get (cdr item) :data))) + file-items)) + (command-args (apply #'request--curl-command-args url settings)) + (stdin-config (apply #'request--curl-stdin-config command-args)) + (command (request--curl-command)) (proc (apply #'start-process "request curl" buffer command))) (request--install-timeout timeout response) (request-log 'debug "request--curl: %s" - (request--curl-occlude-secret (mapconcat 'identity command " "))) + (request--curl-occlude-secret (mapconcat #'identity command-args " "))) (setf (request-response--buffer response) buffer) (process-put proc :request-response response) (set-process-coding-system proc 'no-conversion 'no-conversion) (set-process-query-on-exit-flag proc nil) + (process-send-string proc stdin-config) + (when (or data file-buffer file-data) + ;; We dynamic-let the global `buffer-file-coding-system' to `no-conversion' + ;; in case the user-configured `encoding' doesn't fly. + ;; If we do not dynamic-let the global, `select-safe-coding-system' would + ;; plunge us into an undesirable interactive dialogue. + (let* ((buffer-file-coding-system-orig + (default-value 'buffer-file-coding-system)) + (select-safe-coding-system-accept-default-p + (lambda (&rest _) t))) + (unwind-protect + (progn + (setf (default-value 'buffer-file-coding-system) 'no-conversion) + (with-temp-buffer + (setq-local buffer-file-coding-system encoding) + (insert (or data + (when file-buffer + (with-current-buffer file-buffer + (buffer-substring-no-properties (point-min) (point-max)))) + file-data)) + (process-send-region proc (point-min) (point-max)))) + (setf (default-value 'buffer-file-coding-system) + buffer-file-coding-system-orig)))) + (process-send-eof proc) (let ((callback-2 (apply-partially #'request--curl-callback url))) (if semaphore (set-process-sentinel proc (lambda (&rest args) @@ -1108,7 +1049,7 @@ See also `request--curl-write-out-template'." "secure" "version" "expires") "\\|") "Uninterested keys in cookie. -See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") +See \"set-cookie-av\" in https://www.ietf.org/rfc/rfc2965.txt") (defun request--consume-100-continue () "Remove \"HTTP/* 100 Continue\" header at the point." @@ -1126,11 +1067,12 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (defun request--consume-200-connection-established () "Remove \"HTTP/* 200 Connection established\" header at the point." - (when (looking-at-p "HTTP/1\\.[0-1] 200 Connection established") + (when (looking-at-p "HTTP/1\\.[0-1] 200 Connect") (delete-region (point) (progn (request--goto-next-body) (point))))) (defun request--curl-preprocess (&optional url) - "Pre-process current buffer before showing it to user." + "Pre-process current buffer before showing it to user. +Curl switches need to be adjusted if URL is a file://." (let (history) (cl-destructuring-bind (&key num-redirects url-effective) (if (request-url-file-p url) @@ -1180,8 +1122,13 @@ START-URL is the URL requested." do (setf (request-response-url response) url))) (defun request--curl-callback (url proc event) - (let* ((buffer (process-buffer proc)) - (response (process-get proc :request-response)) + "Ensure `request--callback' gets called after curl to URL finishes. +See info entries on sentinels regarding PROC and EVENT." + (let* ((response (process-get proc :request-response)) + ;; questionable whether (process-buffer proc) + ;; should override RESPONSE's -buffer member. + (buffer (or (process-buffer proc) + (request-response--buffer response))) (settings (request-response-settings response))) (request-log 'debug "request--curl-callback: event %s" event) (request-log 'trace "request--curl-callback: raw-bytes=\n%s" @@ -1208,54 +1155,39 @@ START-URL is the URL requested." (or error (and (numberp code) (>= code 400) `(error . (http ,code))))) (apply #'request--callback buffer settings)))))) -(defun request-auto-revert-notify-rm-watch () - "Backport of M. Engdegard's fix of `auto-revert-notify-rm-watch'." - (let ((desc auto-revert-notify-watch-descriptor) - (table (if (boundp 'auto-revert--buffers-by-watch-descriptor) - auto-revert--buffers-by-watch-descriptor - auto-revert-notify-watch-descriptor-hash-list))) - (when desc - (let ((buffers (delq (current-buffer) (gethash desc table)))) - (if buffers - (puthash desc buffers table) - (remhash desc table))) - (condition-case nil ;; ignore-errors doesn't work for me, sorry - (file-notify-rm-watch desc) - (error)) - (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))) - (setq auto-revert-notify-watch-descriptor nil - auto-revert-notify-modified-p nil)) - (cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys) + "Internal synchronous curl call to URL with SETTINGS bespeaking RESPONSE." (let (finished) (prog1 (apply #'request--curl url :semaphore (lambda (&rest _) (setq finished t)) settings) - (let ((proc (get-buffer-process (request-response--buffer response)))) - (auto-revert-set-timer) - (when auto-revert-use-notify - (dolist (buf (buffer-list)) - (with-current-buffer buf - (request-auto-revert-notify-rm-watch)))) - (with-local-quit - (cl-loop with iter = 0 - until (or (>= iter 10) finished) - do (accept-process-output nil 0.3) - unless (request--process-live-p proc) - do (cl-incf iter) - end - finally (when (>= iter 10) - (let ((m "request--curl-sync: semaphore never called")) - (princ (format "%s\n" m) #'external-debugging-output) - (request-log 'error m))))))))) + (cl-loop with buf = (request-response--buffer response) + with interval = 0.05 + with timeout = 5 + with maxiter = (truncate (/ timeout interval)) + with iter = 0 + until (or (>= iter maxiter) finished) + do (accept-process-output nil interval) + for proc = (get-buffer-process buf) + if (or (not proc) (not (process-live-p proc))) + ;; only run the clock if lollygagging + ;; (before or after process lifetime) + do (cl-incf iter) + end + finally (when (>= iter maxiter) + (let ((m "request--curl-sync: semaphore never called")) + (princ (format "%s %S %s\n" + m + buf + (buffer-live-p buf)) + #'external-debugging-output) + (request-log 'error m))))))) (defun request--curl-get-cookies (host localpart secure) + "Return entry for HOST LOCALPART SECURE in cookie jar." (request--netscape-get-cookies (request--curl-cookie-jar) host localpart secure)) - -;;; Netscape cookie.txt parser - (defun request--netscape-cookie-parse () "Parse Netscape/Mozilla cookie format." (goto-char (point-min)) @@ -1283,6 +1215,7 @@ START-URL is the URL requested." value)))) (defun request--netscape-filter-cookies (cookies host localpart secure) + "Filter COOKIES for entries containing HOST LOCALPART SECURE." (cl-loop for (domain _flag path secure-1 _http-only _expiration name value) in cookies when (and (equal domain host) (equal path localpart) @@ -1290,6 +1223,7 @@ START-URL is the URL requested." collect (cons name value))) (defun request--netscape-get-cookies (filename host localpart secure) + "Get cookies from FILENAME corresponding to HOST LOCALPART SECURE." (when (file-readable-p filename) (with-temp-buffer (erase-buffer) -- 2.47.3