Permalink
Browse files

Misc. important fixes and amendments.

  • Loading branch information...
1 parent de8d471 commit aade8b7f5d739aa0e7f9b7f9cf8e19f5b80724f5 @skypher committed Feb 6, 2010
Showing with 45 additions and 33 deletions.
  1. +0 −4 cl-oauth.asd
  2. +19 −16 src/core/consumer.lisp
  3. +14 −9 src/core/request-adapter.lisp
  4. +2 −2 src/core/signature.lisp
  5. +10 −2 test/core/request-adapter.lisp
View
@@ -63,7 +63,3 @@
:puri :hunchentoot)
:in-order-to ((asdf:test-op (load-op "cl-oauth"))))
-(defmethod perform ((o asdf:test-op) (c (eql (find-system :cl-oauth))))
- (funcall (intern "RUN!" :5am)
- (intern "OAUTH" :oauth-test)))
-
View
@@ -25,18 +25,20 @@ it has query params already they are added onto it."
(defun obtain-request-token (uri consumer-token
&key (version :1.0) user-parameters drakma-args
(timestamp (get-universal-time)) (request-method :post)
+ callback-uri
(signature-method :hmac-sha1))
"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)))))
(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)))
(signature (encode-signature (hmac-sha1 sbs key) nil))
(signed-parameters (cons `("oauth_signature" . ,signature) parameters)))
@@ -54,11 +56,11 @@ token."
(assert key)
(assert secret)
(make-request-token :consumer consumer-token :key key :secret secret
- :user-data user-data))
- (warn "Server returned status ~D" status))))) ; TODO: elaborate
+ :callback-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)
+(defun make-authorization-uri (uri request-token &key (version :1.0) 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?
@@ -84,18 +86,19 @@ and must return a valid unauthorized request token or NIL.
Returns the authorized token or NIL if the token couldn't be found."
;; TODO test
(let* ((parameters (get-parameters))
- (token-key (assoc "oauth_token" parameters :test #'equal))
- (token (funcall request-token-lookup-fn token-key))
- (user-parameters (remove-oauth-parameters parameters)))
- (cond
- (token
- (authorize-request-token token)
- (setf (token-user-data token) user-parameters)
- token)
- (t
- (warn "Cannot find request token with key ~A~
- (never requested or already authorized)" token-key)
- nil))))
+ (token-key (cdr (assoc "oauth_token" parameters :test #'equal))))
+ (unless token-key
+ (error "No token key passed"))
+ (let ((token (funcall request-token-lookup-fn token-key))
+ (user-parameters (remove-oauth-parameters parameters)))
+ (cond
+ (token
+ (authorize-request-token token)
+ (setf (token-user-data token) user-parameters)
+ token)
+ (t
+ (error "Cannot find request token with key ~A ~
+ (never requested or already authorized)" token-key))))))
(defun authorize-request-token (request-token)
@@ -8,6 +8,7 @@
make-request-adapter
*request-adapter*
make-hunchentoot-request-adapter
+ init-default-request-adapter
*request*
request
request-method
@@ -26,7 +27,7 @@
auth-parameters-fn
post-parameters-fn
get-parameters-fn)
- collect `(,slotname nil :type (or function null)))
+ collect `(,slotname nil :type (or function symbol null)))
(:documentation "An adapter for server-specific parts of OAuth.
The return value of REQUEST-OBJECT-FN must be comparable with EQ."))
@@ -43,20 +44,24 @@
: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
- :post-parameters-fn #'hunchentoot:post-parameters*
- :get-parameters-fn #'hunchentoot:get-parameters*))
+ :request-method-fn 'hunchentoot:request-method*
+ :abort-request-fn 'hunchentoot:abort-request-handler
+ :auth-parameters-fn (lambda (request) nil) ; TODO
+ :post-parameters-fn 'hunchentoot:post-parameters*
+ :get-parameters-fn 'hunchentoot:get-parameters*))
-(defvar *request-adapter* (make-hunchentoot-request-adapter)
+(defvar *request-adapter* nil
"Set this variable to an instance of REQUEST-ADAPTER tailored to
your web server.")
+(defun init-default-request-adapter ()
+ (setf *request-adapter* (make-hunchentoot-request-adapter)))
+
+(init-default-request-adapter)
+
(defvar *request* nil
- "User-supplied request override. Only if you're know what you're doing.")
+ "User-supplied request override. Only if you know what you're doing.")
(defun request ()
(or *request* ; allow request object override
View
@@ -13,9 +13,9 @@
:include-leading-ampersand nil))))
(declaim (notinline hmac-key)) ; we want to trace this when debugging.
-(defun hmac-key (consumer-secret &optional (token-secret ""))
+(defun hmac-key (consumer-secret &optional token-secret)
"9.2"
- (concatenate 'string (url-encode consumer-secret) "&" (url-encode token-secret)))
+ (concatenate 'string (url-encode consumer-secret) "&" (url-encode (or token-secret ""))))
(defun encode-signature (octets url-encode-p)
"9.2.1"
@@ -30,6 +30,14 @@
(declare (ignore request))
*get-parameters*)))
-;; TODO: bind this dynamically to not mess up a live image through testing.
-(setf *request-adapter* (make-test-request-adapter))
+(defun init-test-request-adapter ()
+ (setf *request-adapter* (make-test-request-adapter)))
+
+(defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system :cl-oauth))))
+ (let ((original-request-adapter *request-adapter*))
+ (unwind-protect
+ (progn
+ (init-test-request-adapter)
+ (fiveam:run! 'oauth))
+ (setf *request-adapter* original-request-adapter))))

0 comments on commit aade8b7

Please sign in to comment.