From 41c4842e973978456276d7368118f61658a8e1ad Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Fri, 31 Jan 2020 17:48:07 +0100 Subject: [PATCH] update request --- .../request-20191022.615/request-autoloads.el | 15 -- elpa/request-20191022.615/request-pkg.el | 2 - elpa/request-20200127.21/request-autoloads.el | 22 ++ elpa/request-20200127.21/request-pkg.el | 2 + .../request.el | 238 ++++++++++-------- elpa/request-readme.txt | 11 + 6 files changed, 163 insertions(+), 127 deletions(-) delete mode 100644 elpa/request-20191022.615/request-autoloads.el delete mode 100644 elpa/request-20191022.615/request-pkg.el create mode 100644 elpa/request-20200127.21/request-autoloads.el create mode 100644 elpa/request-20200127.21/request-pkg.el rename elpa/{request-20191022.615 => request-20200127.21}/request.el (87%) create mode 100644 elpa/request-readme.txt diff --git a/elpa/request-20191022.615/request-autoloads.el b/elpa/request-20191022.615/request-autoloads.el deleted file mode 100644 index 1f28d824..00000000 --- a/elpa/request-20191022.615/request-autoloads.el +++ /dev/null @@ -1,15 +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 nil ("request.el") (23994 46384 94366 357000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; request-autoloads.el ends here diff --git a/elpa/request-20191022.615/request-pkg.el b/elpa/request-20191022.615/request-pkg.el deleted file mode 100644 index 8ad61786..00000000 --- a/elpa/request-20191022.615/request-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "request" "20191022.615" "Compatible layer for URL request in Emacs" '((emacs "24.4")) :commit "6d170649ae9ef1c7c3d545517f896c03ca12062c" :authors '(("Takafumi Arakaki ")) :maintainer '("Takafumi Arakaki ") :url "https://github.com/tkf/emacs-request") diff --git a/elpa/request-20200127.21/request-autoloads.el b/elpa/request-20200127.21/request-autoloads.el new file mode 100644 index 00000000..f6db8b1b --- /dev/null +++ b/elpa/request-20200127.21/request-autoloads.el @@ -0,0 +1,22 @@ +;;; 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 new file mode 100644 index 00000000..e375bf03 --- /dev/null +++ b/elpa/request-20200127.21/request-pkg.el @@ -0,0 +1,2 @@ +;;; -*- 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-20191022.615/request.el b/elpa/request-20200127.21/request.el similarity index 87% rename from elpa/request-20191022.615/request.el rename to elpa/request-20200127.21/request.el index b03a819e..170215d0 100644 --- a/elpa/request-20191022.615/request.el +++ b/elpa/request-20200127.21/request.el @@ -6,7 +6,7 @@ ;; Author: Takafumi Arakaki ;; URL: https://github.com/tkf/emacs-request -;; Package-Version: 20191022.615 +;; Package-Version: 20200127.21 ;; Package-Requires: ((emacs "24.4")) ;; Version: 0.3.2 @@ -50,7 +50,7 @@ (require 'url) (require 'mail-utils) (require 'autorevert) - +(require 'auth-source) (defgroup request nil "Compatible layer for URL request in Emacs." @@ -199,7 +199,7 @@ FSF holds the copyright of this function: (goto-char (point-max)) (insert msg "\n")))) (when (<= level msg-level) - (message "REQUEST %s" msg)))))) + (message "%s" msg)))))) ;;; HTTP specific utilities @@ -232,8 +232,8 @@ for older Emacs versions.") (list :version (match-string 1) :code (string-to-number (match-string 2))))) -(defun request--goto-next-body () - (re-search-forward "^\r\n")) +(defun request--goto-next-body (&optional noerror) + (re-search-forward "^\r\n" nil noerror)) ;;; Response object @@ -388,7 +388,7 @@ Example:: (cl-defun request-default-error-callback (url &key symbol-status &allow-other-keys) (request-log 'error - "Error (%s) while connecting to %s." symbol-status url)) + "request-default-error-callback: %s %s" url symbol-status)) (cl-defun request (url &rest settings &key @@ -551,7 +551,7 @@ and requests.request_ (Python). .. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/ .. _requests.request: http://docs.python-requests.org " - (request-log 'debug "REQUEST") + (declare (indent defun)) ;; FIXME: support CACHE argument (if possible) ;; (unless cache ;; (setq url (request--url-no-cache url))) @@ -582,31 +582,28 @@ and requests.request_ (Python). (defun request--clean-header (response) "Strip off carriage returns in the header of REQUEST." - (request-log 'debug "-CLEAN-HEADER") - (let ((buffer (request-response--buffer response)) - (backend (request-response--backend response)) - sep-regexp) - (if (eq backend 'url-retrieve) - ;; FIXME: make this workaround optional. - ;; But it looks like sometimes `url-http-clean-headers' - ;; fails to cleanup. So, let's be bit permissive here... - (setq sep-regexp "^\r?$") - (setq sep-regexp "^\r$")) + (let* ((buffer (request-response--buffer response)) + (backend (request-response--backend response)) + ;; FIXME: a workaround when `url-http-clean-headers' fails... + (sep-regexp (if (eq backend 'url-retrieve) "^\r?$" "^\r$"))) (when (buffer-live-p buffer) (with-current-buffer buffer - (request-log 'trace - "(buffer-string) at %S =\n%s" buffer (buffer-string)) (goto-char (point-min)) (when (and (re-search-forward sep-regexp nil t) - ;; Are \r characters stripped off already?: (not (equal (match-string 0) ""))) + (request-log 'trace "request--clean-header: cleaning\n%s" + (buffer-substring (save-excursion + (forward-line -1) + (line-beginning-position)) + (save-excursion + (forward-line 1) + (line-end-position)))) (while (re-search-backward "\r$" (point-min) t) (replace-match ""))))))) (defun request--cut-header (response) "Cut the first header part in the buffer of RESPONSE and move it to raw-header slot." - (request-log 'debug "-CUT-HEADER") (let ((buffer (request-response--buffer response))) (when (buffer-live-p buffer) (with-current-buffer buffer @@ -614,30 +611,40 @@ raw-header slot." (when (re-search-forward "^$" nil t) (setf (request-response--raw-header response) (buffer-substring (point-min) (point))) + (request-log 'trace "request--cut-header: cutting\n%s" + (buffer-substring (point-min) (min (1+ (point)) (point-max)))) (delete-region (point-min) (min (1+ (point)) (point-max)))))))) (defun request-untrampify-filename (file) "Return FILE as the local file name." (or (file-remote-p file 'localname) file)) -(defun request--parse-data (response parser) - "Run PARSER in current buffer if ERROR-THROWN is nil, -then kill the current buffer." - (request-log 'debug "-PARSE-DATA") +(defun request--parse-data (response encoding parser) + "For buffer held by RESPONSE, first decode via user's ENCODING elective, +then send to PARSER." (let ((buffer (request-response--buffer response))) - (request-log 'debug "parser = %s" parser) - (when (and (buffer-live-p buffer) parser) + (when (buffer-live-p buffer) (with-current-buffer buffer - (request-log 'trace - "(buffer-string) at %S =\n%s" buffer (buffer-string)) - (unless (equal (request-response-status-code response) 204) + (request-log 'trace "request--parse-data: %s" (buffer-string)) + (unless (eq (request-response-status-code response) 204) + (recode-region (point-min) (point-max) encoding 'no-conversion) (goto-char (point-min)) - (setf (request-response-data response) (funcall parser))))))) - -(cl-defun request--callback (buffer &key parser success error complete status-code response - &allow-other-keys) - (request-log 'debug "REQUEST--CALLBACK") - (request-log 'debug "(buffer-string) =\n%s" + (setf (request-response-data response) + (if parser (funcall parser) (buffer-string)))))))) + +(defsubst request-url-file-p (url) + "Return non-nil if URL looks like a file URL." + (let ((scheme (and (stringp url) (url-type (url-generic-parse-url url))))) + (and (stringp scheme) + (not (string-match-p "^http" scheme))))) + +(cl-defun request--callback (buffer + &key + parser success error complete + status-code response + encoding + &allow-other-keys) + (request-log 'debug "request--callback: UNPARSED\n%s" (when (buffer-live-p buffer) (with-current-buffer buffer (buffer-string)))) @@ -651,42 +658,31 @@ then kill the current buffer." (symbol-status (request-response-symbol-status response)) (data (request-response-data response)) (done-p (request-response-done-p response))) - - ;; Parse response header - ;; Note: Try to do this even `error-thrown' is set. For example, - ;; timeout error can occur while downloading response body and - ;; header is there in that case. (let* ((response-url (request-response-url response)) - (scheme (and (stringp response-url) - (url-type (url-generic-parse-url response-url)))) - (curl-file-p (and (stringp scheme) - (not (string-match-p "^http" scheme)) - (eq (request-response--backend response) 'curl)))) - ;; curl does not add a header for say file:///foo/bar + (curl-file-p (and (eq (request-response--backend response) 'curl) + (request-url-file-p response-url)))) (unless curl-file-p (request--clean-header response) (request--cut-header response))) - ;; Parse response body - (request-log 'debug "error-thrown = %S" error-thrown) + ;; Parse response even if `error-thrown' is set, e.g., timeout (condition-case err - (request--parse-data response parser) - (error - ;; If there was already an error (e.g. server timeout) do not set the - ;; status to `parse-error'. - (unless error-thrown - (setq symbol-status 'parse-error) - (setq error-thrown err) - (request-log 'error "Error from parser %S: %S" parser err)))) + (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) - (request-log 'debug "data = %s" data) - ;; Determine `symbol-status' - (unless symbol-status - (setq symbol-status (if error-thrown 'error 'success))) - (request-log 'debug "symbol-status = %s" symbol-status) + ;; Ensuring `symbol-status' and `error-thrown' are consistent + ;; is why we should get rid of `symbol-status' + ;; (but downstream apps might ill-advisedly rely on it). + (if error-thrown + (progn + (request-log 'error "request--callback: %s" + (error-message-string error-thrown)) + (unless symbol-status (setq symbol-status 'error))) + (unless symbol-status (setq symbol-status 'success)) + (request-log 'debug "request--callback: PARSED\n%s" data)) - ;; Call callbacks (let ((args (list :data data :symbol-status symbol-status :error-thrown error-thrown @@ -695,17 +691,17 @@ then kill the current buffer." (cb (if success-p success error)) (name (if success-p "success" "error"))) (when cb - (request-log 'debug "Executing %s callback." name) + (request-log 'debug "request--callback: executing %s" name) (request--safe-apply cb args))) (let ((cb (cdr (assq (request-response-status-code response) status-code)))) (when cb - (request-log 'debug "Executing status-code callback.") + (request-log 'debug "request--callback: executing status-code") (request--safe-apply cb args))) (when complete - (request-log 'debug "Executing complete callback.") + (request-log 'debug "request--callback: executing complete") (request--safe-apply complete args))) (setq done-p t) @@ -716,7 +712,6 @@ then kill the current buffer." (request--safe-delete-files (request-response--tempfiles response)))) (cl-defun request-response--timeout-callback (response) - (request-log 'debug "-TIMEOUT-CALLBACK") (setf (request-response-symbol-status response) 'timeout) (setf (request-response-error-thrown response) '(error . ("Timeout"))) (let* ((buffer (request-response--buffer response)) @@ -738,7 +733,6 @@ then kill the current buffer." (setq done-p t)))))) (defun request-response--cancel-timer (response) - (request-log 'debug "REQUEST-RESPONSE--CANCEL-TIMER") (cl-symbol-macrolet ((timer (request-response--timer response))) (when timer (cancel-timer timer) @@ -791,19 +785,13 @@ associated process is exited." (request--install-timeout timeout response) (setf (request-response--buffer response) buffer) (process-put proc :request-response response) - (request-log 'debug "Start querying: %s" url) (set-process-query-on-exit-flag proc nil))) (cl-defun request--url-retrieve-callback (status &rest settings &key response url &allow-other-keys) - (request-log 'debug "-URL-RETRIEVE-CALLBACK") - (request-log 'debug "status = %S" status) (when (featurep 'url-http) - (request-log 'debug "url-http-method = %s" url-http-method) - (request-log 'debug "url-http-response-status = %s" url-http-response-status) (setf (request-response-status-code response) url-http-response-status)) - (let ((redirect (plist-get status :redirect))) (when redirect (setf (request-response-url response) redirect))) @@ -824,12 +812,10 @@ associated process is exited." (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) (status-error (plist-get status :error))) - (when (and error-thrown status-error) - (request-log 'warn - "Error %S thrown already but got another error %S from \ -`url-retrieve'. Ignoring it..." error-thrown status-error)) - (unless error-thrown - (setq error-thrown 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)) @@ -916,17 +902,30 @@ Currently it is used only for testing.") (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 + (url &key type data headers response files* unix-socket encoding auth &allow-other-keys - &aux - (cookie-jar (convert-standard-filename - (expand-file-name (request--curl-cookie-jar))))) + &aux (cookie-jar (convert-standard-filename + (expand-file-name (request--curl-cookie-jar))))) "BUG: Simultaneous requests are a known cause of cookie-jar corruption." (append - (list request-curl "--silent" "--include" - "--location" - "--cookie" cookie-jar "--cookie-jar" cookie-jar - "--write-out" request--curl-write-out-template) + (list request-curl + "--silent" "--location" + "--cookie" cookie-jar "--cookie-jar" cookie-jar) + (when auth + (let* ((host (url-host (url-generic-parse-url url))) + (auth-source-creation-prompts `((user . ,(format "%s user: " host)) + (secret . "Password for %u: "))) + (cred (car (auth-source-search + :host host :require '(:user :secret) :create t :max 1)))) + (split-string (format "--%s --user %s:%s" + auth + (plist-get cred :user) + (let ((secret (plist-get cred :secret))) + (if (functionp secret) + (funcall secret) + secret)))))) + (unless (request-url-file-p url) + (list "--include" "--write-out" request--curl-write-out-template)) request-curl-options (when (plist-get (request--curl-capabilities) :compression) (list "--compressed")) (when unix-socket (list "--unix-socket" unix-socket)) @@ -1025,17 +1024,25 @@ temporary file paths." (mapc (lambda (f) (condition-case err (delete-file f) (error (request-log 'error - "Failed delete file %s. Got: %S" f err)))) + "request--safe-delete-files: %s %s" + f (error-message-string err))))) files)) (defun request--install-timeout (timeout response) "Out-of-band trigger after TIMEOUT seconds to prevent hangs." (when (numberp timeout) - (request-log 'debug "Start timer: timeout=%s sec" 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." + (let ((matched + (string-match (concat (regexp-quote "--user") "\\s-*\\(\\S-+\\)") command))) + (if matched + (replace-match "elided" nil nil command 1) + command))) + (cl-defun request--curl (url &rest settings &key files timeout response encoding semaphore &allow-other-keys) @@ -1069,16 +1076,18 @@ removed from the buffer before it is shown to the parser function. :response response :encoding encoding settings))) (proc (apply #'start-process "request curl" buffer command))) (request--install-timeout timeout response) - (request-log 'debug "Run: %s" (mapconcat 'identity command " ")) + (request-log 'debug "request--curl: %s" + (request--curl-occlude-secret (mapconcat 'identity command " "))) (setf (request-response--buffer response) buffer) (process-put proc :request-response response) - (set-process-coding-system proc encoding encoding) + (set-process-coding-system proc 'no-conversion 'no-conversion) (set-process-query-on-exit-flag proc nil) - (set-process-sentinel proc 'request--curl-callback) - (when semaphore - (set-process-sentinel proc (lambda (&rest args) - (apply #'request--curl-callback args) - (apply semaphore args)))))) + (let ((callback-2 (apply-partially #'request--curl-callback url))) + (if semaphore + (set-process-sentinel proc (lambda (&rest args) + (apply callback-2 args) + (apply semaphore args))) + (set-process-sentinel proc callback-2))))) (defun request--curl-read-and-delete-tail-info () "Read a sexp at the end of buffer and remove it and preceding character. @@ -1106,6 +1115,11 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (cl-destructuring-bind (&key code &allow-other-keys) (save-excursion (request--parse-response-at-point)) (when (equal code 100) + (request-log 'debug "request--consume-100-continue: consuming\n%s" + (buffer-substring (point) + (save-excursion + (request--goto-next-body t) + (point)))) (delete-region (point) (progn (request--goto-next-body) (point))) ;; FIXME: Does this make sense? Is it possible to have multiple 100? (request--consume-100-continue)))) @@ -1115,11 +1129,13 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (when (looking-at-p "HTTP/1\\.[0-1] 200 Connection established") (delete-region (point) (progn (request--goto-next-body) (point))))) -(defun request--curl-preprocess () +(defun request--curl-preprocess (&optional url) "Pre-process current buffer before showing it to user." (let (history) (cl-destructuring-bind (&key num-redirects url-effective) - (request--curl-read-and-delete-tail-info) + (if (request-url-file-p url) + `(:num-redirects 0 :url-effective ,url) + (request--curl-read-and-delete-tail-info)) (goto-char (point-min)) (request--consume-100-continue) (request--consume-200-connection-established) @@ -1157,31 +1173,30 @@ START-URL is the URL requested." (cl-loop for url in (request--curl-absolutify-redirects start-url (mapcar (lambda (response) - (request-response-header response "location")) + (or (request-response-header response "location") + (request-response-url response))) history)) for response in (cdr history) do (setf (request-response-url response) url))) -(defun request--curl-callback (proc event) +(defun request--curl-callback (url proc event) (let* ((buffer (process-buffer proc)) (response (process-get proc :request-response)) - (symbol-status (request-response-symbol-status response)) (settings (request-response-settings response))) - (request-log 'debug "REQUEST--CURL-CALLBACK event = %s" event) - (request-log 'debug "REQUEST--CURL-CALLBACK proc = %S" proc) - (request-log 'debug "REQUEST--CURL-CALLBACK buffer = %S" buffer) - (request-log 'debug "REQUEST--CURL-CALLBACK symbol-status = %S" - symbol-status) + (request-log 'debug "request--curl-callback: event %s" event) + (request-log 'trace "request--curl-callback: raw-bytes=\n%s" + (when (buffer-live-p buffer) + (with-current-buffer buffer (buffer-string)))) (cond ((and (memq (process-status proc) '(exit signal)) (/= (process-exit-status proc) 0)) (setf (request-response-error-thrown response) (cons 'error event)) (apply #'request--callback buffer settings)) - ((equal event "finished\n") + ((cl-search "finished" event) (cl-destructuring-bind (&key code history error url-effective &allow-other-keys) (condition-case err (with-current-buffer buffer - (request--curl-preprocess)) + (request--curl-preprocess url)) ((debug error) (list :error err))) (request--curl-absolutify-location-history (plist-get settings :url) @@ -1218,7 +1233,10 @@ START-URL is the URL requested." settings) (let ((proc (get-buffer-process (request-response--buffer response)))) (auto-revert-set-timer) - (when auto-revert-use-notify (request-auto-revert-notify-rm-watch)) + (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) diff --git a/elpa/request-readme.txt b/elpa/request-readme.txt new file mode 100644 index 00000000..d0354754 --- /dev/null +++ b/elpa/request-readme.txt @@ -0,0 +1,11 @@ +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' -- 2.47.3