From 584d436f9155835af965205312224410213e6edb Mon Sep 17 00:00:00 2001 From: Austin Bingham Date: Thu, 15 May 2014 10:58:55 +0200 Subject: [PATCH 1/8] Fixed parameter ordering in assoc-string calls --- request.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/request.el b/request.el index bca7717..97ecbe9 100644 --- a/request.el +++ b/request.el @@ -526,7 +526,7 @@ and requests.request_ (Python). (setq settings (plist-put settings :error error))) (unless (or (stringp data) (null data) - (assoc-string headers "Content-Type" t)) + (assoc-string "Content-Type" headers t)) (setq data (request--urlencode-alist data)) (setq settings (plist-put settings :data data))) (when params @@ -734,7 +734,7 @@ associated process is exited." (error "`url-retrieve' backend does not support FILES.")) (when (and (equal type "POST") data - (not (assoc-string headers "Content-Type" t))) + (not (assoc-string "Content-Type" headers t))) (push '("Content-Type" . "application/x-www-form-urlencoded") headers) (setq settings (plist-put settings :headers headers))) settings) From 9337d373d2b6178821784c073266fc1e3e920887 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sun, 3 May 2015 20:24:22 +0200 Subject: [PATCH 2/8] Enforce use of spaces for indentation --- .dir-locals.el | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..8602c48 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,4 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((emacs-lisp-mode (indent-tabs-mode . nil))) From fd89e467450507d0b4002757e0578225cde31adf Mon Sep 17 00:00:00 2001 From: KOBAYASHI Shigeru Date: Thu, 17 Sep 2015 02:55:58 +0900 Subject: [PATCH 3/8] Specify curl process encoding --- request.el | 1 + 1 file changed, 1 insertion(+) diff --git a/request.el b/request.el index bca7717..6f24958 100644 --- a/request.el +++ b/request.el @@ -969,6 +969,7 @@ removed from the buffer before it is shown to the parser function. (request-log 'debug "Run: %s" (mapconcat 'identity command " ")) (setf (request-response--buffer response) buffer) (process-put proc :request-response response) + (set-process-coding-system proc 'binary 'binary) (set-process-query-on-exit-flag proc nil) (set-process-sentinel proc #'request--curl-callback) (when data From 16b479e6999e30601330d33213e106e2ded5bad7 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sun, 3 May 2015 20:29:47 +0200 Subject: [PATCH 4/8] Use cl-lib instead of the old prefix-less CL package `cl-lib' is available for older Emacsen, see http://elpa.gnu.org/packages/cl-lib.html. --- request.el | 300 ++++++++++++++++++++------------------- tests/request-testing.el | 30 ++-- tests/test-request.el | 2 +- 3 files changed, 168 insertions(+), 164 deletions(-) diff --git a/request.el b/request.el index bca7717..d1ffa57 100644 --- a/request.el +++ b/request.el @@ -5,6 +5,7 @@ ;; Free Software Foundation, Inc. ;; Author: Takafumi Arakaki +;; Package-Requires: ((cl-lib "0.5")) ;; Version: 0.2.0 ;; This file is NOT part of GNU Emacs. @@ -39,7 +40,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) ; for obsolete `lexical-let' + (require 'cl-lib)) (require 'url) (require 'mail-utils) @@ -178,12 +181,12 @@ for older Emacs versions.") (defun request--urlencode-alist (alist) ;; FIXME: make monkey patching `url-unreserved-chars' optional (let ((url-unreserved-chars request--url-unreserved-chars)) - (loop for sep = "" then "&" - for (k . v) in alist - concat sep - concat (url-hexify-string (format "%s" k)) - concat "=" - concat (url-hexify-string v)))) + (cl-loop for sep = "" then "&" + for (k . v) in alist + concat sep + concat (url-hexify-string (format "%s" k)) + concat "=" + concat (url-hexify-string v)))) ;;; Header parser @@ -200,7 +203,7 @@ for older Emacs versions.") ;;; Response object -(defstruct request-response +(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 @@ -347,26 +350,26 @@ Example:: ;;; Main -(defun* request-default-error-callback (url &key symbol-status - &allow-other-keys) +(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)) -(defun* request (url &rest settings - &key - (type "GET") - (params nil) - (data nil) - (files nil) - (parser nil) - (headers nil) - (success nil) - (error nil) - (complete nil) - (timeout request-timeout) - (status-code nil) - (sync nil) - (response (make-request-response))) +(cl-defun request (url &rest settings + &key + (type "GET") + (params nil) + (data nil) + (files nil) + (parser nil) + (headers nil) + (success nil) + (error nil) + (complete nil) + (timeout request-timeout) + (status-code nil) + (sync nil) + (response (make-request-response))) "Send request to URL. Request.el has a single entry point. It is `request'. @@ -404,7 +407,7 @@ arguments (i.e., it's better to use `&allow-other-keys' [#]_).:: ...) .. [#] `&allow-other-keys' is a special \"markers\" available in macros - in the CL library for function definition such as `defun*' and + in the CL library for function definition such as `cl-defun' and `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' @@ -530,7 +533,7 @@ and requests.request_ (Python). (setq data (request--urlencode-alist data)) (setq settings (plist-put settings :data data))) (when params - (assert (listp params) nil "PARAMS must be an alist. Given: %S" params) + (cl-assert (listp params) nil "PARAMS must be an alist. Given: %S" params) (setq url (concat url (if (string-match-p "\\?" url) "&" "?") (request--urlencode-alist params)))) (setq settings (plist-put settings :url url)) @@ -599,9 +602,9 @@ then kill the current buffer." (goto-char (point-min)) (setf (request-response-data response) (funcall parser)))))) -(defun* request--callback (buffer &key parser success error complete - timeout status-code response - &allow-other-keys) +(cl-defun request--callback (buffer &key parser success error complete + timeout status-code response + &allow-other-keys) (request-log 'debug "REQUEST--CALLBACK") (request-log 'debug "(buffer-string) =\n%s" (when (buffer-live-p buffer) @@ -612,7 +615,7 @@ then kill the current buffer." ;; FIXME: Refactor how BUFFER is passed around. (setf (request-response--buffer response) buffer) (request-response--cancel-timer response) - (symbol-macrolet + (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) (symbol-status (request-response-symbol-status response)) (data (request-response-data response)) @@ -671,7 +674,7 @@ then kill the current buffer." ;; callback is never called. (request--safe-delete-files (request-response--tempfiles response)))) -(defun* request-response--timeout-callback (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"))) @@ -681,7 +684,7 @@ then kill the current buffer." ;; This will call `request--callback': (funcall (request--choose-backend 'terminate-process) proc)) - (symbol-macrolet ((done-p (request-response-done-p response))) + (cl-symbol-macrolet ((done-p (request-response-done-p response))) (unless done-p ;; This code should never be executed. However, it occurs ;; sometimes with `url-retrieve' backend. @@ -690,7 +693,7 @@ then kill the current buffer." (request-log 'error "Callback is not called when stopping process! \ Explicitly calling from timer.") (when (buffer-live-p buffer) - (destructuring-bind (&key code &allow-other-keys) + (cl-destructuring-bind (&key code &allow-other-keys) (with-current-buffer buffer (goto-char (point-min)) (ignore-errors (request--parse-response-at-point))) @@ -702,7 +705,7 @@ Explicitly calling from timer.") (defun request-response--cancel-timer (response) (request-log 'debug "REQUEST-RESPONSE--CANCEL-TIMER") - (symbol-macrolet ((timer (request-response--timer response))) + (cl-symbol-macrolet ((timer (request-response--timer response))) (when timer (cancel-timer timer) (setq timer nil)))) @@ -713,9 +716,9 @@ Explicitly calling from timer.") Note that this function invoke ERROR and COMPLETE callbacks. Callbacks may not be called immediately but called later when associated process is exited." - (symbol-macrolet ((buffer (request-response--buffer response)) - (symbol-status (request-response-symbol-status response)) - (done-p (request-response-done-p response))) + (cl-symbol-macrolet ((buffer (request-response--buffer response)) + (symbol-status (request-response-symbol-status response)) + (done-p (request-response-done-p response))) (let ((process (get-buffer-process buffer))) (unless symbol-status ; should I use done-p here? (setq symbol-status 'abort) @@ -728,7 +731,7 @@ associated process is exited." ;;; Backend: `url-retrieve' -(defun* request--url-retrieve-preprocess-settings +(cl-defun request--url-retrieve-preprocess-settings (&rest settings &key type data files headers &allow-other-keys) (when files (error "`url-retrieve' backend does not support FILES.")) @@ -739,10 +742,10 @@ associated process is exited." (setq settings (plist-put settings :headers headers))) settings) -(defun* request--url-retrieve (url &rest settings - &key type data timeout response - &allow-other-keys - &aux headers) +(cl-defun request--url-retrieve (url &rest settings + &key type data timeout response + &allow-other-keys + &aux headers) (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) (setq headers (plist-get settings :headers)) (let* ((url-request-extra-headers headers) @@ -756,9 +759,9 @@ associated process is exited." (request-log 'debug "Start querying: %s" url) (set-process-query-on-exit-flag proc nil))) -(defun* request--url-retrieve-callback (status &rest settings - &key response url - &allow-other-keys) +(cl-defun request--url-retrieve-callback (status &rest settings + &key response url + &allow-other-keys) (declare (special url-http-method url-http-response-status)) (request-log 'debug "-URL-RETRIEVE-CALLBACK") @@ -771,22 +774,22 @@ associated process is exited." (when redirect (setf (request-response-url response) redirect))) ;; Construct history slot - (loop for v in - (loop with first = t - with l = nil - for (k v) on status by 'cddr - when (eq k :redirect) - if first - do (setq first nil) - else - do (push v l) - finally do (cons url l)) - do (let ((r (make-request-response :-backend 'url-retrieve))) - (setf (request-response-url r) v) - (push r (request-response-history response)))) - - (symbol-macrolet ((error-thrown (request-response-error-thrown response)) - (status-error (plist-get status :error))) + (cl-loop for v in + (cl-loop with first = t + with l = nil + for (k v) on status by 'cddr + when (eq k :redirect) + if first + do (setq first nil) + else + do (push v l) + finally do (cons url l)) + 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 (and error-thrown status-error) (request-log 'warn "Error %S thrown already but got another error %S from \ @@ -796,10 +799,10 @@ associated process is exited." (apply #'request--callback (current-buffer) settings)) -(defun* request--url-retrieve-sync (url &rest settings - &key type data timeout response - &allow-other-keys - &aux headers) +(cl-defun request--url-retrieve-sync (url &rest settings + &key type data timeout response + &allow-other-keys + &aux headers) (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) (setq headers (plist-get settings :headers)) (let* ((url-request-extra-headers headers) @@ -820,7 +823,7 @@ associated process is exited." ;; Fetch HTTP response code (with-current-buffer buffer (goto-char (point-min)) - (destructuring-bind (&key version code) + (cl-destructuring-bind (&key version code) (request--parse-response-at-point) (setf (request-response-status-code response) code))) ;; Parse response body, etc. @@ -853,7 +856,7 @@ Currently it is used only for testing.") (ignore-errors (make-directory (file-name-directory (request--curl-cookie-jar)) t))) -(defun* request--curl-command +(cl-defun request--curl-command (url &key type data headers timeout files* &allow-other-keys &aux @@ -868,45 +871,46 @@ Currently it is used only for testing.") ;; running multiple requests. "--cookie" cookie-jar "--cookie-jar" cookie-jar "--write-out" request--curl-write-out-template) - (loop for (name filename path mime-type) in files* - collect "--form" - collect (format "%s=@%s;filename=%s%s" name path filename - (if mime-type - (format ";type=%s" mime-type) - ""))) + (cl-loop for (name filename path mime-type) in files* + collect "--form" + collect (format "%s=@%s;filename=%s%s" name path filename + (if mime-type + (format ";type=%s" mime-type) + ""))) (when data (list "--data-binary" "@-")) (when type (list "--request" type)) - (loop for (k . v) in headers - collect "--header" - collect (format "%s: %s" k v)) + (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) - (loop for (name . item) in files - collect - (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 (= (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))))))) + (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))))))) (defun request--curl-normalize-files (files) "Change FILES into a list of (NAME FILENAME PATH MIME-TYPE). @@ -935,9 +939,9 @@ temporary file paths." "Failed delete file %s. Got: %S" f err)))) files)) -(defun* request--curl (url &rest settings - &key type data files headers timeout response - &allow-other-keys) +(cl-defun request--curl (url &rest settings + &key type data files headers timeout response + &allow-other-keys) "cURL-based request backend. Redirection handling strategy @@ -959,7 +963,7 @@ removed from the buffer before it is shown to the parser function. ;; Avoid starting program in non-existing directory. (default-directory (expand-file-name "~/")) (buffer (generate-new-buffer " *request curl*")) - (command (destructuring-bind + (command (cl-destructuring-bind (files* tempfiles) (request--curl-normalize-files files) (setf (request-response--tempfiles response) tempfiles) @@ -998,7 +1002,7 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (defun request--consume-100-continue () "Remove \"HTTP/* 100 Continue\" header at the point." - (destructuring-bind (&key code &allow-other-keys) + (cl-destructuring-bind (&key code &allow-other-keys) (save-excursion (ignore-errors (request--parse-response-at-point))) (when (equal code 100) (delete-region (point) (progn (request--goto-next-body) (point))) @@ -1013,22 +1017,22 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (defun request--curl-preprocess () "Pre-process current buffer before showing it to user." (let (history) - (destructuring-bind (&key num-redirects url-effective) + (cl-destructuring-bind (&key num-redirects url-effective) (request--curl-read-and-delete-tail-info) (goto-char (point-min)) (request--consume-100-continue) (request--consume-200-connection-established) (when (> num-redirects 0) - (loop with case-fold-search = t - repeat num-redirects - ;; Do not store code=100 headers: - do (request--consume-100-continue) - do (let ((response (make-request-response - :-buffer (current-buffer) - :-backend 'curl))) - (request--clean-header response) - (request--cut-header response) - (push response history)))) + (cl-loop with case-fold-search = t + repeat num-redirects + ;; Do not store code=100 headers: + do (request--consume-100-continue) + do (let ((response (make-request-response + :-buffer (current-buffer) + :-backend 'curl))) + (request--clean-header response) + (request--cut-header response) + (push response history)))) (goto-char (point-min)) (nconc (list :num-redirects num-redirects :url-effective url-effective @@ -1038,24 +1042,24 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (defun request--curl-absolutify-redirects (start-url redirects) "Convert relative paths in REDIRECTS to absolute URLs. START-URL is the URL requested." - (loop for prev-url = start-url then url - for url in redirects - unless (string-match url-nonrelative-link url) - do (setq url (url-expand-file-name url prev-url)) - collect url)) + (cl-loop for prev-url = start-url then url + for url in redirects + unless (string-match url-nonrelative-link url) + do (setq url (url-expand-file-name url prev-url)) + collect url)) (defun request--curl-absolutify-location-history (start-url history) "Convert relative paths in HISTORY to absolute URLs. START-URL is the URL requested." (when history (setf (request-response-url (car history)) start-url)) - (loop for url in (request--curl-absolutify-redirects - start-url - (mapcar (lambda (response) - (request-response-header response "location")) - history)) - for response in (cdr history) - do (setf (request-response-url response) url))) + (cl-loop for url in (request--curl-absolutify-redirects + start-url + (mapcar (lambda (response) + (request-response-header response "location")) + history)) + for response in (cdr history) + do (setf (request-response-url response) url))) (defun request--curl-callback (proc event) (let* ((buffer (process-buffer proc)) @@ -1073,8 +1077,8 @@ START-URL is the URL requested." (setf (request-response-error-thrown response) (cons 'error event)) (apply #'request--callback buffer settings)) ((equal event "finished\n") - (destructuring-bind (&key version code num-redirects history error - url-effective) + (cl-destructuring-bind (&key version code num-redirects history error + url-effective) (condition-case err (with-current-buffer buffer (request--curl-preprocess)) @@ -1089,7 +1093,7 @@ START-URL is the URL requested." (or error (when (>= code 400) `(error . (http ,code))))) (apply #'request--callback buffer settings)))))) -(defun* request--curl-sync (url &rest settings &key response &allow-other-keys) +(cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys) ;; To make timeout work, use polling approach rather than using ;; `call-process'. (lexical-let (finished) @@ -1111,7 +1115,7 @@ START-URL is the URL requested." "Parse Netscape/Mozilla cookie format." (goto-char (point-min)) (let ((tsv-re (concat "^\\=" - (loop repeat 6 concat "\\([^\t\n]+\\)\t") + (cl-loop repeat 6 concat "\\([^\t\n]+\\)\t") "\\(.*\\)")) cookies) (while @@ -1120,27 +1124,27 @@ START-URL is the URL requested." ((re-search-forward "^\\=#" nil t)) ((re-search-forward "^\\=$" nil t)) ((re-search-forward tsv-re) - (push (loop for i from 1 to 7 collect (match-string i)) + (push (cl-loop for i from 1 to 7 collect (match-string i)) cookies) t)) (= (forward-line 1) 0) (not (= (point) (point-max))))) (setq cookies (nreverse cookies)) - (loop for (domain flag path secure expiration name value) in cookies - collect (list domain - (equal flag "TRUE") - path - (equal secure "TRUE") - (string-to-number expiration) - name - value)))) + (cl-loop for (domain flag path secure expiration name value) in cookies + collect (list domain + (equal flag "TRUE") + path + (equal secure "TRUE") + (string-to-number expiration) + name + value)))) (defun request--netscape-filter-cookies (cookies host localpart secure) - (loop for (domain flag path secure-1 expiration name value) in cookies - when (and (equal domain host) - (equal path localpart) - (or secure (not secure-1))) - collect (cons name value))) + (cl-loop for (domain flag path secure-1 expiration name value) in cookies + when (and (equal domain host) + (equal path localpart) + (or secure (not secure-1))) + collect (cons name value))) (defun request--netscape-get-cookies (filename host localpart secure) (when (file-readable-p filename) diff --git a/tests/request-testing.el b/tests/request-testing.el index 5eaf8b8..b4dfbbd 100644 --- a/tests/request-testing.el +++ b/tests/request-testing.el @@ -55,22 +55,22 @@ Following symbols are bound: response / status-code / history / data / error-thrown / symbol-status / url / done-p / settings / -buffer / -timer -The symbols other than `response' is bound using `symbol-macrolet'." +The symbols other than `response' is bound using `cl-symbol-macrolet'." (declare (indent 1)) `(let ((response ,response)) - (symbol-macrolet - ,(loop for slot in '(status-code - history - data - error-thrown - symbol-status - url - done-p - settings - -buffer - -timer) - for accessor = (intern (format "request-response-%s" slot)) - collect `(,slot (,accessor response))) + (cl-symbol-macrolet + ,(cl-loop for slot in '(status-code + history + data + error-thrown + symbol-status + url + done-p + settings + -buffer + -timer) + for accessor = (intern (format "request-response-%s" slot)) + collect `(,slot (,accessor response))) ,@body))) (defvar request-testing-server--process nil) @@ -246,7 +246,7 @@ TEMPFILES ;; "Decorate" BODY. (setq body (request-deftest--capture-message body)) (setq body (request-deftest--url-retrieve-isolate body)) - (destructuring-bind (&key backends tempfiles) req-keys + (cl-destructuring-bind (&key backends tempfiles) req-keys (setq body (request-deftest--tempfiles tempfiles body)) (setq body (request-deftest--backends backends name body))) diff --git a/tests/test-request.el b/tests/test-request.el index a266612..f5ea122 100644 --- a/tests/test-request.el +++ b/tests/test-request.el @@ -402,7 +402,7 @@ To check that, run test with: (should-not (request--process-live-p process)))) (should (= (length called) 1)) - (destructuring-bind (&key data symbol-status error-thrown response) + (cl-destructuring-bind (&key data symbol-status error-thrown response) (car called) (should-not data) (should (eq symbol-status 'abort)) From fa53e98bd4a902ba246579555919a64973b7cd3e Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Mon, 19 Oct 2015 15:44:10 +0200 Subject: [PATCH 5/8] Silence byte-compiler --- request.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/request.el b/request.el index d1ffa57..81e1add 100644 --- a/request.el +++ b/request.el @@ -42,7 +42,9 @@ (eval-when-compile (require 'cl) ; for obsolete `lexical-let' - (require 'cl-lib)) + (require 'cl-lib) + (defvar url-http-method) + (defvar url-http-response-status)) (require 'url) (require 'mail-utils) From 19da4e8ae300a08e7297766426b469d8e703f834 Mon Sep 17 00:00:00 2001 From: Syohei YOSHIDA Date: Thu, 19 Nov 2015 16:46:08 +0900 Subject: [PATCH 6/8] Correct arguments in error callback There is no '&allow-other-keys&rest' keyword and it is treated as normal argument. And '&rest' keyword should be declared before '&key' keyword. --- README.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.rst b/README.rst index 7ab5285..89ee7f8 100644 --- a/README.rst +++ b/README.rst @@ -85,7 +85,7 @@ Rich callback dispatch (like `jQuery.ajax`):: (insert data) (pop-to-buffer (current-buffer)))))) :error - (function* (lambda (&key error-thrown &allow-other-keys&rest _) + (function* (lambda (&rest args &key error-thrown &allow-other-keys) (message "Got error: %S" error-thrown))) :complete (lambda (&rest _) (message "Finished!")) :status-code '((400 . (lambda (&rest _) (message "Got 400."))) From f64af7b9ce1590955a5b06aab1d9879c0d030f68 Mon Sep 17 00:00:00 2001 From: Syohei YOSHIDA Date: Mon, 4 Jan 2016 07:43:59 +0900 Subject: [PATCH 7/8] Use cl-lib macro instead of cl.el macro --- README.rst | 26 +++++++++++++------------- request.el | 2 +- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/README.rst b/README.rst index 89ee7f8..c7002f2 100644 --- a/README.rst +++ b/README.rst @@ -42,7 +42,7 @@ GET:: "http://httpbin.org/get" :params '(("key" . "value") ("key2" . "value2")) :parser 'json-read - :success (function* + :success (cl-function (lambda (&key data &allow-other-keys) (message "I sent: %S" (assoc-default 'args data))))) @@ -54,7 +54,7 @@ POST:: :data '(("key" . "value") ("key2" . "value2")) ;; :data "key=value&key2=value2" ; this is equivalent :parser 'json-read - :success (function* + :success (cl-function (lambda (&key data &allow-other-keys) (message "I sent: %S" (assoc-default 'form data))))) @@ -66,7 +66,7 @@ POST file (**WARNING**: it will send the contents of the current buffer!):: :files `(("current buffer" . ,(current-buffer)) ("data" . ("data.csv" :data "1,2,3\n4,5,6\n"))) :parser 'json-read - :success (function* + :success (cl-function (lambda (&key data &allow-other-keys) (message "I sent: %S" (assoc-default 'files data))))) @@ -78,15 +78,15 @@ Rich callback dispatch (like `jQuery.ajax`):: ;; "http://httpbin.org/status/400" ; you will see "Got 400." :parser 'buffer-string :success - (function* (lambda (&key data &allow-other-keys) - (when data - (with-current-buffer (get-buffer-create "*request demo*") - (erase-buffer) - (insert data) - (pop-to-buffer (current-buffer)))))) + (cl-function (lambda (&key data &allow-other-keys) + (when data + (with-current-buffer (get-buffer-create "*request demo*") + (erase-buffer) + (insert data) + (pop-to-buffer (current-buffer)))))) :error - (function* (lambda (&rest args &key error-thrown &allow-other-keys) - (message "Got error: %S" error-thrown))) + (cl-function (lambda (&rest args &key error-thrown &allow-other-keys) + (message "Got error: %S" error-thrown))) :complete (lambda (&rest _) (message "Finished!")) :status-code '((400 . (lambda (&rest _) (message "Got 400."))) (418 . (lambda (&rest _) (message "Got 418."))))) @@ -97,7 +97,7 @@ Flexible PARSER option:: "https://github.com/tkf/emacs-request/commits/master.atom" ;; Parse XML in response body: :parser (lambda () (libxml-parse-xml-region (point) (point-max))) - :success (function* + :success (cl-function (lambda (&key data &allow-other-keys) ;; Just don't look at this function.... (let ((get (lambda (node &rest names) @@ -119,7 +119,7 @@ PUT JSON data:: :data (json-encode '(("key" . "value") ("key2" . "value2"))) :headers '(("Content-Type" . "application/json")) :parser 'json-read - :success (function* + :success (cl-function (lambda (&key data &allow-other-keys) (message "I sent: %S" (assoc-default 'json data))))) diff --git a/request.el b/request.el index 6689a7b..7329f58 100644 --- a/request.el +++ b/request.el @@ -410,7 +410,7 @@ arguments (i.e., it's better to use `&allow-other-keys' [#]_).:: .. [#] `&allow-other-keys' is a special \"markers\" available in macros in the CL library for function definition such as `cl-defun' and - `function*'. Without this marker, you need to specify all arguments + `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 From 336204ee103eb1c8308ea42b7d078d59355a657a Mon Sep 17 00:00:00 2001 From: "Desmond O. Chang" Date: Fri, 27 Nov 2015 03:20:51 +0800 Subject: [PATCH 8/8] Ignore more proxy headers 57b9c7ab05eb968e0d619cbc81bdd453b69e4ee6 just removes the header returned by Squid. But some proxies -- such as [polipo][] -- return a different header. Remove those headers as well. [polipo]: https://github.com/jech/polipo/blob/master/tunnel.c#L302 --- request.el | 14 ++++++++++++-- tests/test-request.el | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 2 deletions(-) diff --git a/request.el b/request.el index d538fb8..d8fd89b 100644 --- a/request.el +++ b/request.el @@ -1013,8 +1013,18 @@ See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") (request--consume-100-continue)))) (defun request--consume-200-connection-established () - "Remove \"HTTP/* 200 Connection established\" header at the point." - (when (looking-at-p "HTTP/1\\.0 200 Connection established") + "Remove proxy header at the point. + +Some proxies return a header block before the server headers. Remove it." + ;; [RFC draft][1] & [Privoxy code][2] use "Connection established". + ;; But [polipo][] & [cow][] use "Tunnel established". I use `[^\r\n]` here for + ;; compatibility. + ;; + ;; [1]: https://tools.ietf.org/html/draft-luotonen-web-proxy-tunneling-01#section-3.2 + ;; [2]: http://ijbswa.cvs.sourceforge.net/viewvc/ijbswa/current/jcc.c?view=markup + ;; [polipo]: https://github.com/jech/polipo/blob/master/tunnel.c#L302 + ;; [cow]: https://github.com/cyfdecyf/cow/blob/master/proxy.go#L1160 + (when (looking-at-p "HTTP/[0-9]+\\.[0-9]+ 2[0-9][0-9] [^\r\n]* established\r\n") (delete-region (point) (progn (request--goto-next-body) (point))))) (defun request--curl-preprocess () diff --git a/tests/test-request.el b/tests/test-request.el index f5ea122..d3d32a3 100644 --- a/tests/test-request.el +++ b/tests/test-request.el @@ -700,6 +700,38 @@ RESPONSE-BODY")) :history nil :version "1.1" :code 200)))))) +(ert-deftest request--curl-preprocess/200-proxy-tunnel-established () + (with-temp-buffer + (erase-buffer) + (insert "\ +HTTP/1.1 200 Tunnel established\r +\r +HTTP/1.1 200 OK\r +Content-Type: application/json\r +Date: Wed, 19 Dec 2012 16:51:53 GMT\r +Server: gunicorn/0.13.4\r +Content-Length: 492\r +Connection: keep-alive\r +\r +RESPONSE-BODY") + (insert "\n(:num-redirects 0 :url-effective \"DUMMY-URL\")") + (let ((info (request--curl-preprocess))) + (should (equal (buffer-string) + "\ +HTTP/1.1 200 OK\r +Content-Type: application/json\r +Date: Wed, 19 Dec 2012 16:51:53 GMT\r +Server: gunicorn/0.13.4\r +Content-Length: 492\r +Connection: keep-alive\r +\r +RESPONSE-BODY")) + (should (equal info + (list :num-redirects 0 + :url-effective "DUMMY-URL" + :history nil + :version "1.1" :code 200)))))) + (ert-deftest request--curl-absolutify-redirects/simple () (should (equal (request--curl-absolutify-redirects "http://localhost"