Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Various fixes #3

Closed
wants to merge 12 commits into from

3 participants

@sellout

I was using cl-oauth in project a while ago, and fixed/extended it to support what I needed – EG, using the Authorization header rather than passing OAuth params as GET/POST parameters.

@Harag

Some of those would be nice to have :)

@skypher
Owner

Somehow I missed this. Will review and merge RSN.

@skypher skypher was assigned
@skypher
Owner

Merged.

@skypher skypher closed this
@sellout

Cool, thanks.

@Harag

Kewl, thanx.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Mar 12, 2011
  1. @sellout

    Separate the location of the authorization parameters from the reques…

    sellout authored
    …t type – :AUTH-LOCATION can be either :HEADER (the default), or :PARAMETERS. Currently this is only done for OBTAIN-REQUEST-TOKEN.
  2. @sellout
  3. @sellout
  4. @sellout
Commits on Mar 14, 2011
  1. @sellout
Commits on Mar 15, 2011
  1. @sellout
Commits on Mar 20, 2011
  1. @sellout

    Generate actually random keys/secrets by default. Use base-36 to comp…

    sellout authored
    …ress the string as much as possible (save 7 bytes per value vs hexidecimal – which makes for _slightly_ nicer URLs)
Commits on Mar 24, 2011
  1. @sellout
  2. @sellout
  3. @sellout
Commits on May 26, 2011
  1. Removed unnecessary ampersand.

    Tomohiro Matsuyama authored
Commits on Nov 25, 2011
  1. Bug fix for Hunchentoot 1.2.x.

    m2ym authored
This page is out of date. Refresh to see the latest.
View
173 src/core/consumer.lisp
@@ -18,64 +18,76 @@ it has query params already they are added onto it."
(mapcar (compose #'url-encode #'car) parameters)
(mapcar (compose #'url-encode #'cdr) parameters)))))
-(defun http-request (uri &key (request-method :get) parameters drakma-args)
- ;; TODO handle redirects properly
- (let* ((param-string-encoded (alist->query-string parameters :include-leading-ampersand nil :url-encode t)))
- (case request-method
- (:get
- (apply #'drakma:http-request
- (uri-with-additional-query-part uri param-string-encoded)
- :method request-method
- drakma-args))
- (:post
- (apply #'drakma:http-request
- uri
- :method request-method
- :content param-string-encoded
- drakma-args))
- (:auth
- (apply #'drakma:http-request
- uri
- :method :get
- :additional-headers `(("Authorization" . ,(build-auth-string parameters)))
- drakma-args)))))
+(defun http-request
+ (uri &key (auth-location :header) (method :get) auth-parameters parameters additional-headers drakma-args)
+ (apply #'drakma:http-request
+ uri
+ :method method
+ :parameters (if (eq auth-location :parameters)
+ (append parameters auth-parameters)
+ parameters)
+ :additional-headers (if (eq auth-location :header)
+ (cons `("Authorization" . ,(build-auth-string auth-parameters))
+ additional-headers)
+ additional-headers)
+ :redirect-methods '(:get :post :head)
+ drakma-args))
+
+(defun generate-auth-parameters
+ (consumer signature-method timestamp version &optional token)
+ (let ((parameters `(("oauth_consumer_key" . ,(token-key consumer))
+ ("oauth_signature_method" . ,(string signature-method))
+ ("oauth_timestamp" . ,(princ-to-string timestamp))
+ ("oauth_nonce" . ,(princ-to-string
+ (random most-positive-fixnum)))
+ ("oauth_version" . ,(princ-to-string version)))))
+ (if token
+ (cons `("oauth_token" . ,(url-decode (token-key token))) parameters)
+ parameters)))
(defun obtain-request-token (uri consumer-token
&key (version :1.0) user-parameters drakma-args
- (timestamp (get-unix-time)) (request-method :post)
+ (timestamp (get-unix-time))
+ (auth-location :header)
+ (request-method :post)
callback-uri
+ additional-headers
(signature-method :hmac-sha1))
- "Additional parameters will be stored in the USER-DATA slot of the
-token."
+ "Additional parameters will be stored in the USER-DATA slot of the token."
;; TODO: support 1.0a too
- (let* ((parameters (append user-parameters
- `(("oauth_consumer_key" . ,(token-key consumer-token))
- ("oauth_signature_method" . ,(string signature-method))
- ("oauth_callback" . ,(or callback-uri "oob"))
- ("oauth_timestamp" . ,(princ-to-string timestamp))
- ("oauth_nonce" . ,(princ-to-string (random most-positive-fixnum)))
- ("oauth_version" . ,(princ-to-string version)))))
+ (let* ((callback-uri (or callback-uri "oob"))
+ (auth-parameters (cons `("oauth_callback" . ,callback-uri)
+ (generate-auth-parameters consumer-token
+ signature-method
+ timestamp
+ version)))
(sbs (signature-base-string :uri uri :request-method request-method
- :parameters (sort-parameters (copy-alist parameters))))
+ :parameters (sort-parameters (copy-alist (append user-parameters auth-parameters)))))
(key (hmac-key (token-secret consumer-token)))
(signature (encode-signature (hmac-sha1 sbs key) nil))
- (signed-parameters (cons `("oauth_signature" . ,signature) parameters)))
+ (signed-parameters (cons `("oauth_signature" . ,signature) auth-parameters)))
(multiple-value-bind (body status)
- (apply #'drakma:http-request uri :method request-method
- :parameters signed-parameters
- drakma-args)
+ (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)
- (let* ((response (query-string->alist body))
- (key (cdr (assoc "oauth_token" response :test #'equal)))
- (secret (cdr (assoc "oauth_token_secret" response :test #'equal)))
- (user-data (set-difference response '("oauth_token" "oauth_token_secret")
- :test (lambda (e1 e2)
- (equal (car e1) e2)))))
- (assert key)
- (assert secret)
- (make-request-token :consumer consumer-token :key key :secret secret ;; TODO url-decode
- :callback-uri callback-uri :user-data user-data))
- (error "Server returned status ~D" status))))) ; TODO: elaborate
+ (let* ((response (query-string->alist (typecase body
+ (string body)
+ (t (map 'string #'code-char body)))))
+ (key (cdr (assoc "oauth_token" response :test #'equal)))
+ (secret (cdr (assoc "oauth_token_secret" response :test #'equal)))
+ (user-data (set-difference response '("oauth_token" "oauth_token_secret")
+ :test (lambda (e1 e2)
+ (equal (car e1) e2)))))
+ (assert key)
+ (assert secret)
+ (make-request-token :consumer consumer-token :key key :secret secret ;; TODO url-decode
+ :callback-uri (puri:uri callback-uri) :user-data user-data))
+ (error "Server returned status ~D" status))))) ; TODO: elaborate
(defun make-authorization-uri (uri request-token &key (version :1.0) callback-uri user-parameters)
@@ -89,9 +101,13 @@ for a redirect. [6.2.1] in 1.0." ; TODO 1.0a section number
(list (cons "oauth_token" (token-key request-token))))
(when callback-uri
(list (cons "oauth_callback" callback-uri)))))
- (puri (puri:parse-uri uri)))
- (setf (puri:uri-query puri) (concatenate 'string (or (puri:uri-query puri) "")
- (alist->query-string parameters)))
+ (puri (puri:copy-uri (puri:parse-uri uri))))
+ (setf (puri:uri-query puri)
+ (if (puri:uri-query puri)
+ (concatenate 'string
+ (puri:uri-query puri)
+ (alist->query-string parameters))
+ (alist->query-string parameters :include-leading-ampersand nil)))
puri))
@@ -126,10 +142,10 @@ Returns the authorized token or NIL if the token couldn't be found."
(setf (request-token-authorized-p request-token) t)
request-token)
-
(defun obtain-access-token (uri request-or-access-token &key
(consumer-token (token-consumer request-or-access-token))
(request-method :post)
+ (auth-location :header)
(version :1.0)
(timestamp (get-unix-time))
drakma-args
@@ -140,12 +156,11 @@ token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section numbe
(unless refresh-p
(assert (request-token-authorized-p request-or-access-token)))
(let* ((parameters (append
- `(("oauth_consumer_key" . ,(token-key consumer-token))
- ("oauth_token" . ,(url-decode (token-key request-or-access-token)))
- ("oauth_signature_method" . ,(string signature-method))
- ("oauth_timestamp" . ,(princ-to-string timestamp))
- ("oauth_nonce" . ,(princ-to-string (random most-positive-fixnum)))
- ("oauth_version" . ,(princ-to-string version)))
+ (generate-auth-parameters consumer-token
+ signature-method
+ timestamp
+ version
+ request-or-access-token)
(if refresh-p
`(("oauth_session_handle" . ,(access-token-session-handle
request-or-access-token)))
@@ -158,11 +173,15 @@ token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section numbe
(signature (encode-signature (hmac-sha1 sbs key) nil))
(signed-parameters (cons `("oauth_signature" . ,signature) parameters)))
(multiple-value-bind (body status)
- (apply #'drakma:http-request uri :method request-method
- :parameters signed-parameters
- drakma-args)
+ (http-request uri
+ :method request-method
+ :auth-location auth-location
+ :auth-parameters signed-parameters
+ :drakma-args drakma-args)
(if (eql status 200)
- (let ((response (query-string->alist body)))
+ (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"))
@@ -222,8 +241,10 @@ token. POST is recommended as request method. [6.3.1]" ; TODO 1.0a section numbe
on-refresh
(timestamp (get-unix-time))
user-parameters
+ additional-headers
(version :1.0)
drakma-args
+ (auth-location :header)
(request-method :get)
(signature-method :hmac-sha1))
"Access the protected resource at URI using ACCESS-TOKEN.
@@ -235,26 +256,24 @@ request sent again using the new token. ON-REFRESH will be called
whenever the access token is renewed."
(setf access-token (maybe-refresh-access-token access-token on-refresh))
(multiple-value-bind (normalized-uri query-string-parameters) (normalize-uri uri)
- (let* ((parameters (append query-string-parameters
- user-parameters
- `(("oauth_consumer_key" . ,(token-key consumer-token))
- ("oauth_token" . ,(token-key access-token))
- ("oauth_signature_method" . ,(string signature-method))
- ("oauth_timestamp" . ,(princ-to-string timestamp))
- ("oauth_nonce" . ,(princ-to-string (random most-positive-fixnum)))
- ("oauth_version" . ,(princ-to-string version)))))
+ (let* ((auth-parameters (generate-auth-parameters consumer-token
+ signature-method
+ timestamp
+ version
+ access-token))
(sbs (signature-base-string :uri normalized-uri
- :request-method (if (eq request-method :auth)
- :get
- request-method)
- :parameters (sort-parameters (copy-alist parameters))))
+ :request-method request-method
+ :parameters (sort-parameters (copy-alist (append query-string-parameters user-parameters auth-parameters)))))
(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) parameters)))
+ (signed-parameters (cons `("oauth_signature" . ,signature) auth-parameters)))
(multiple-value-bind (body status headers)
- (http-request normalized-uri
- :request-method request-method
- :parameters signed-parameters
+ (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)
(values body status)
View
6 src/core/error-handling.lisp
@@ -20,10 +20,6 @@
(error type :reason-phrase reason-phrase))
(error type)))
-;; TODO what follows is Hunchentoot-specific
-(pushnew 400 hunchentoot:*approved-return-codes*)
-(pushnew 401 hunchentoot:*approved-return-codes*)
-
(defun default-error-handler (condition)
"Default error handler for conditions of type HTTP-ERROR."
(check-type condition http-error)
@@ -36,5 +32,5 @@
(defmacro protocol-assert (&body body)
`(unless (progn ,@body)
- (raise-error 'bad-request)))
+ (raise-error 'bad-request "Failed protocol assertion")))
View
13 src/core/tokens.lisp
@@ -13,14 +13,15 @@
;;; TODO: token registry GC
;;; default token values
-(defun random-key ()
- "key")
+(let ((random-state (make-random-state t)))
+ (defun random-key ()
+ (format nil "~36,25,'0r" (random (expt 36 25) random-state)))
-(defun random-secret ()
- "secret")
+ (defun random-secret ()
+ (format nil "~36,25,'0r" (random (expt 36 25) random-state)))
-(defun random-verification-code ()
- "verification_code")
+ (defun random-verification-code ()
+ (format nil "~36,25,'0r" (random (expt 36 25) random-state))))
;;; token base class
Something went wrong with that request. Please try again.