Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Fix a POST problem #12

Merged
merged 4 commits into from

2 participants

@hanshuebner

Leslie,

I had some problems with cl-oauth and POST requests (and tumblr's braindead image posting API), and these changes help fixing them. Can you have a look and maybe pull them into your repository?

The issue was that the URL encoders used by DRAKMA and cl-oauth differ, which makes signature verification fail. With this change, POST parameters are encoded explicitly using cl-oauth's url-encode function and passed to DRAKMA as request body.

Thanks,
Hans

@skypher skypher merged commit 6066807 into skypher:master
@skypher
Owner

Looks good, merged!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
View
80 src/core/consumer.lisp
@@ -93,7 +93,7 @@ it has query params already they are added onto it."
(error "Server returned status ~D: ~A" status body)))))
-(defun make-authorization-uri (uri request-token &key (version :1.0) callback-uri user-parameters)
+(defun make-authorization-uri (uri request-token &key callback-uri user-parameters)
"Return the service provider's authorization URI. Use the resulting PURI
for a redirect. [6.2.1] in 1.0." ; TODO 1.0a section number
;; TODO: does 1.0 support oob callbacks?
@@ -151,12 +151,14 @@ Returns the authorized token or NIL if the token couldn't be found."
(auth-location :header)
(version :1.0)
(timestamp (get-unix-time))
+ xauth-username xauth-password
drakma-args
(signature-method :hmac-sha1))
"Additional parameters will be stored in the USER-DATA slot of the
token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section number
(let ((refresh-p (typep request-or-access-token 'access-token)))
- (unless refresh-p
+ (when (and request-or-access-token
+ (not refresh-p))
(assert (request-token-authorized-p request-or-access-token)))
(let* ((parameters (append
(generate-auth-parameters consumer-token
@@ -164,15 +166,22 @@ token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section numbe
timestamp
version
request-or-access-token)
- (if refresh-p
+ (cond
+ (refresh-p
`(("oauth_session_handle" . ,(access-token-session-handle
- request-or-access-token)))
+ request-or-access-token))))
+ ((null request-or-access-token)
+ `(("x_auth_mode" . "client_auth")
+ ("x_auth_username" . ,xauth-username)
+ ("x_auth_password" . ,xauth-password)))
+ (t
(awhen (request-token-verification-code request-or-access-token)
- `(("oauth_verifier" . ,it))))))
+ `(("oauth_verifier" . ,it)))))))
(sbs (signature-base-string :uri uri :request-method request-method
- :parameters (sort-parameters (copy-alist parameters))))
+ :parameters (sort-parameters (copy-alist parameters))))
(key (hmac-key (token-secret consumer-token)
- (url-decode (token-secret request-or-access-token))))
+ (when request-or-access-token
+ (url-decode (token-secret request-or-access-token)))))
(signature (encode-signature (hmac-sha1 sbs key) nil))
(signed-parameters (cons `("oauth_signature" . ,signature) parameters)))
(multiple-value-bind (body status)
@@ -185,29 +194,29 @@ token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section numbe
(let ((response (query-string->alist (if (stringp body)
body
(babel:octets-to-string body)))))
- (flet ((field (name)
- (cdr (assoc name response :test #'equal))))
- (let ((key (field "oauth_token"))
- (secret (field "oauth_token_secret"))
- (session-handle (field "oauth_session_handle"))
- (expires (awhen (field "oauth_expires_in")
- (parse-integer it)))
- (authorization-expires (awhen (field "oauth_authorization_expires_in")
- (parse-integer it)))
- (user-data (remove-oauth-parameters response)))
- (assert key)
- (assert secret)
- (make-access-token :consumer consumer-token
- :key (url-decode key)
- :secret (url-decode secret)
- :session-handle session-handle
- :expires (awhen expires
- (+ (get-universal-time) it))
- :authorization-expires (awhen authorization-expires
- (+ (get-universal-time) it))
- :origin-uri uri
- :user-data user-data))))
- (error "Couldn't obtain access token: server returned status ~D" status))))))
+ (flet ((field (name)
+ (cdr (assoc name response :test #'equal))))
+ (let ((key (field "oauth_token"))
+ (secret (field "oauth_token_secret"))
+ (session-handle (field "oauth_session_handle"))
+ (expires (awhen (field "oauth_expires_in")
+ (parse-integer it)))
+ (authorization-expires (awhen (field "oauth_authorization_expires_in")
+ (parse-integer it)))
+ (user-data (remove-oauth-parameters response)))
+ (assert key)
+ (assert secret)
+ (make-access-token :consumer consumer-token
+ :key (url-decode key)
+ :secret (url-decode secret)
+ :session-handle session-handle
+ :expires (awhen expires
+ (+ (get-universal-time) it))
+ :authorization-expires (awhen authorization-expires
+ (+ (get-universal-time) it))
+ :origin-uri uri
+ :user-data user-data))))
+ (error "Couldn't obtain access token: server returned status ~D" status))))))
(defun refresh-access-token (access-token)
(obtain-access-token (access-token-origin-uri access-token) access-token))
@@ -275,12 +284,21 @@ whenever the access token is renewed."
(key (hmac-key (token-secret consumer-token) (token-secret access-token)))
(signature (encode-signature (hmac-sha1 sbs key) nil))
(signed-parameters (cons `("oauth_signature" . ,signature) auth-parameters)))
+ (when (and (eql request-method :post)
+ user-parameters)
+ (assert (and (not (getf drakma-args :content-type))
+ (not (getf drakma-args :content)))
+ () "User parameters and content/content-type in drakma arguments cannot be combined")
+ (setf drakma-args (list* :content-type "application/x-www-form-urlencoded"
+ :content (alist->query-string user-parameters
+ :url-encode t
+ :include-leading-ampersand nil)
+ drakma-args)))
(multiple-value-bind (body status headers)
(http-request uri
:method request-method
:auth-location auth-location
:auth-parameters signed-parameters
- :parameters user-parameters
:additional-headers additional-headers
:drakma-args drakma-args)
(if (eql status 200)
View
6 src/core/request-adapter.lisp
@@ -39,14 +39,14 @@
(port (second http-host)))
(make-instance 'puri:uri
:scheme (etypecase hunchentoot:*acceptor*
- (hunchentoot:acceptor :http)
- (hunchentoot:ssl-acceptor :https))
+ (hunchentoot:ssl-acceptor :https)
+ (hunchentoot:acceptor :http))
:host hostname
:port port
:path (hunchentoot:script-name* request))))
:request-method-fn 'hunchentoot:request-method*
:abort-request-fn 'hunchentoot:abort-request-handler
- :auth-parameters-fn (lambda (request) nil) ; TODO
+ :auth-parameters-fn (lambda (request) (declare (ignore request)) nil) ; TODO
:post-parameters-fn 'hunchentoot:post-parameters*
:get-parameters-fn 'hunchentoot:get-parameters*))
View
2  src/core/signature.lisp
@@ -9,7 +9,7 @@
(normalize-uri uri))
"&" (url-encode
(alist->query-string parameters
- :url-encode t
+ :url-encode t
:include-leading-ampersand nil))))
(declaim (notinline hmac-key)) ; we want to trace this when debugging.
View
1  src/package.lisp
@@ -63,6 +63,7 @@
#:signature-base-string
#:hmac-key
#:hmac-sha1
+ #:encode-url
#:encode-signature
;;; parameters
View
6 src/util/query-string.lisp
@@ -3,7 +3,11 @@
(defun alist->query-string (alist &key (include-leading-ampersand t) url-encode)
(let* ((plist (splice-alist alist))
- (plist* (if url-encode (mapcar #'(lambda (item) (url-encode (string item))) plist) plist))
+ (plist* (if url-encode
+ (loop for (key value) on plist by #'cddr
+ collect (url-encode (string key))
+ collect (url-encode value))
+ plist))
(result (format nil "~{&~A=~A~}" plist*)))
(subseq ; TODO: nsubseq http://darcs.informatimago.com/lisp/common-lisp/utility.lisp
result
View
35 src/util/uri.lisp
@@ -7,22 +7,27 @@
;; this function is taken from Hunchentoot but modified to
;; satisfy the OAuth spec demands.
-(defun url-encode (string &optional (external-format +utf-8+))
- "URL-encodes a string using the external format EXTERNAL-FORMAT."
+(defun url-encode (input &optional (external-format +utf-8+))
+ "URL-encodes INPUT according to the percent encoding rules of
+ RFC5849 (section 3.6). If a string is passed as INPUT, it is
+ encoded using the external format EXTERNAL-FORMAT. If a vector of
+ bytes is passed, the values are used verbatim."
(with-output-to-string (s)
- (loop for c across string
- for index from 0
- do (cond ((or (char<= #\0 c #\9)
- (char<= #\a c #\z)
- (char<= #\A c #\Z)
- (find c "-_.~" :test #'char=))
- (write-char c s))
- (t (loop for octet across (flexi-streams:string-to-octets string
- :start index
- :end (1+ index)
- :external-format external-format)
- do (format s "%~2,'0x" octet)))))))
-
+ (loop for octet across (etypecase input
+ (string
+ (flexi-streams:string-to-octets input :external-format external-format))
+ ((or (array (integer) (*))
+ (array (unsigned-byte 8) (*)))
+ input)
+ (null
+ #()))
+ for char = (code-char octet)
+ do (if (or (char<= #\0 char #\9)
+ (char<= #\a char #\z)
+ (char<= #\A char #\Z)
+ (find char "-_.~" :test #'char=))
+ (write-char char s)
+ (format s "%~2,'0x" octet)))))
(defmacro upgrade-vector (vector new-type &key converter)
"Returns a vector with the same length and the same elements as
Something went wrong with that request. Please try again.