Permalink
Browse files

Merge pull request #12 from hanshuebner/master

Fix a POST problem
  • Loading branch information...
2 parents 74cae00 + e63bf0d commit 6066807096b6f67ed6e2a41942921fb3c30303fb @skypher committed Nov 15, 2012
Showing with 79 additions and 51 deletions.
  1. +49 −31 src/core/consumer.lisp
  2. +3 −3 src/core/request-adapter.lisp
  3. +1 −1 src/core/signature.lisp
  4. +1 −0 src/package.lisp
  5. +5 −1 src/util/query-string.lisp
  6. +20 −15 src/util/uri.lisp
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,28 +151,37 @@ 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
signature-method
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

0 comments on commit 6066807

Please sign in to comment.