Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Consumer: support for Session and Problem Reporting extensions.

API change: access-protected-resource no longer needs to be passed the consumer token.
  • Loading branch information...
commit 952d5bba81249aa7835e5c7d63ac932b6bc58b83 1 parent 4279ffb
@skypher authored
View
14 README
@@ -6,8 +6,8 @@ Spec URI: http://oauth.net/core/1.0a
Section numbers mentioned in the code and documentation
refer to this document, unless mentioned otherwise.
-Most of the code has passed basic manual and automated
-tests, but it hasn't been used in a real-world application
+Most of the code has passed basic manual and automated tests,
+but the SP code hasn't been used in a real-world application
yet.
@@ -28,8 +28,10 @@ Service Provider:
Consumer:
- * Auth parameters appear to be working, but Google rejects them
- for some reason. Do more testing and debugging.
+ * Auth parameters should be working, but Google rejects them for
+ some reason. Do more testing and debugging.
+
+ * Revoking tokens as per section 7 of the Session extension
Both:
@@ -39,6 +41,8 @@ Both:
* PLAINTEXT signature. Meh. [9.4]
+ * POST and Auth requests are hardly tested yet.
+
People who contributed in some way to this library:
@@ -60,3 +64,5 @@ TODO (apart from spec things not implemented yet):
* compare with the Hammer draft spec and resolve differences
+ * always store the URL-decoded key/secret in the request token
+
View
5 examples/consumer/google.lisp
@@ -24,8 +24,7 @@
(defparameter *access-token* nil)
(defun get-access-token ()
- (obtain-access-token *get-access-token-endpoint*
- *consumer-token* *request-token*))
+ (obtain-access-token *get-access-token-endpoint* *request-token*))
;;; get a request token
(defun get-request-token (scope)
@@ -63,7 +62,7 @@
;; test request:
(let ((result (access-protected-resource
"http://www.google.com/calendar/feeds/default/allcalendars/full?orderby=starttime"
- *access-token* *consumer-token*)))
+ *access-token*)))
(if (stringp result)
result
(babel:octets-to-string result)))))))
View
4 examples/consumer/twitter.lisp
@@ -24,7 +24,7 @@
(defparameter *access-token* nil)
(defun get-access-token ()
- (obtain-access-token *get-access-token-endpoint* *consumer-token* *request-token*))
+ (obtain-access-token *get-access-token-endpoint* *request-token*))
;;; get a request token
(defun get-request-token ()
@@ -60,7 +60,7 @@
;; test request:
(babel:octets-to-string
(access-protected-resource "http://search.twitter.com/search.json?q=twitter"
- *access-token* *consumer-token*))))))
+ *access-token*))))))
(pushnew 'callback-dispatcher hunchentoot:*dispatch-table*)
View
13 examples/consumer/yahoo.lisp
@@ -26,7 +26,7 @@
(defparameter *access-token* nil)
(defun get-access-token ()
- (obtain-access-token *get-access-token-endpoint* *consumer-token* *request-token*))
+ (obtain-access-token *get-access-token-endpoint* *request-token*))
;;; get a request token
(defun get-request-token ()
@@ -58,7 +58,16 @@
(warn "Couldn't verify request token authorization: ~A" c)))
(when (request-token-authorized-p *request-token*)
(format t "Successfully verified request token with key ~S~%" (token-key *request-token*))
- (setf *access-token* (get-access-token))))))
+ (setf *access-token* (get-access-token))
+ (let ((reply-body (access-protected-resource
+ "http://social.yahooapis.com/v1/user/jupitercollision/profile"
+ *access-token*
+ ;; Yahoo uses OAuth session so the token might need refresh.
+ :on-refresh (lambda (new-token)
+ (setf *access-token* new-token)) )))
+ (etypecase reply-body
+ (string reply-body)
+ ((vector (unsigned-byte 8)) (babel:octets-to-string reply-body))))))))
(pushnew 'callback-dispatcher hunchentoot:*dispatch-table*)
View
180 src/core/consumer.lisp
@@ -103,14 +103,11 @@ REQUEST-TOKEN-LOOKUP-FN will be called with the request token key
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 (cdr (assoc "oauth_token" parameters :test #'equal)))
(verification-code (cdr (assoc "oauth_verifier" parameters :test #'equal))))
(unless token-key
(error "No token key passed"))
- (unless verification-code
- (error "No verification code passed"))
(let ((token (funcall request-token-lookup-fn token-key))
(user-parameters (remove-oauth-parameters parameters)))
(cond
@@ -131,56 +128,114 @@ Returns the authorized token or NIL if the token couldn't be found."
request-token)
-(defun obtain-access-token (uri consumer-token request-token
- &key (request-method :post)
- (version :1.0)
- (timestamp (get-unix-time))
- drakma-args
- (signature-method :hmac-sha1))
+(defun obtain-access-token (uri request-or-access-token &key
+ (consumer-token (token-consumer request-or-access-token))
+ (request-method :post)
+ (version :1.0)
+ (timestamp (get-unix-time))
+ 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
- ;; TODO mark request token as used, but only on success
- (assert (request-token-authorized-p request-token))
- (let* ((parameters `(("oauth_consumer_key" . ,(token-key consumer-token))
- ("oauth_token" . ,(url-decode (token-key request-token)))
- ("oauth_verifier" . ,(request-token-verification-code request-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))))
- (sbs (signature-base-string :uri uri :request-method request-method
- :parameters (sort-parameters (copy-alist parameters))))
- (key (hmac-key (token-secret consumer-token) (url-decode (token-secret request-token))))
- (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)
- (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 (remove-oauth-parameters response)))
- (assert key)
- (assert secret)
- (make-access-token :consumer consumer-token
- :key (url-decode key)
- :secret (url-decode secret)
- :user-data user-data))
- (error "Couldn't obtain access token: server returned status ~D" status)))))
-
-(defun access-protected-resource (uri access-token consumer-token
- &key
+ (let ((refresh-p (typep request-or-access-token 'access-token)))
+ (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)))
+ (if refresh-p
+ `(("oauth_session_handle" . ,(access-token-session-handle
+ request-or-access-token)))
+ (awhen (request-token-verification-code request-or-access-token)
+ `(("oauth_verifier" . ,it))))))
+ (sbs (signature-base-string :uri uri :request-method request-method
+ :parameters (sort-parameters (copy-alist parameters))))
+ (key (hmac-key (token-secret consumer-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)
+ (apply #'drakma:http-request uri :method request-method
+ :parameters signed-parameters
+ drakma-args)
+ (if (eql status 200)
+ (let ((response (query-string->alist 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))))))
+
+(defun refresh-access-token (access-token)
+ (obtain-access-token (access-token-origin-uri access-token) access-token))
+
+(defun maybe-refresh-access-token (access-token &optional on-refresh)
+ (if (access-token-expired-p access-token)
+ (let ((new-token (refresh-access-token access-token)))
+ (when on-refresh
+ (funcall on-refresh new-token))
+ new-token)
+ access-token))
+
+(defun get-problem-report-from-headers (headers)
+ (let ((authenticate-header (drakma:header-value :www-authenticate headers)))
+ (when authenticate-header
+ (assert (>= (length authenticate-header) 5))
+ (let ((type (subseq authenticate-header 0 5)))
+ (assert (equalp type "OAuth"))
+ (when (> (length authenticate-header) 5)
+ (let ((parameters (mapcar (lambda (token)
+ (destructuring-bind (name value)
+ (split-sequence #\= token)
+ (cons name value)))
+ (drakma:split-tokens
+ (subseq authenticate-header 6)))))
+ parameters))))))
+
+(defun get-problem-report (headers body)
+ (declare (ignore body)) ; TODO
+ (let ((from-headers (get-problem-report-from-headers headers)))
+ from-headers))
+
+(defun access-protected-resource (uri access-token &rest kwargs &key
+ (consumer-token (token-consumer access-token))
+ on-refresh
(timestamp (get-unix-time))
- user-parameters
- (version :1.0)
- drakma-args
- (request-method :get)
- (signature-method :hmac-sha1))
- "Additional parameters will be stored in the USER-DATA slot of the
-token."
- ;; TODO: support 1.0a too
+ user-parameters
+ (version :1.0)
+ drakma-args
+ (request-method :get)
+ (signature-method :hmac-sha1))
+ "Access the protected resource at URI using ACCESS-TOKEN.
+
+If the token contains OAuth Session information it will be checked for
+validity before the request is made. Should the server notify us that
+it has prematurely expired the token will be refresh as well and the
+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
@@ -195,19 +250,24 @@ token."
(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)))
- (multiple-value-bind (body status)
+ (multiple-value-bind (body status headers)
(http-request normalized-uri
:request-method request-method
:parameters signed-parameters
:drakma-args drakma-args)
(if (eql status 200)
- (values body status)
- (progn (warn "Server returned status ~D" status)
- (values body status)))))))
-
-
-;; test
-;(obtain-request-token "http://term.ie/oauth/example/request_token.php"
-; :GET (make-consumer-token) "HMAC-SHA1")
+ (values body status)
+ (let* ((problem-report (get-problem-report headers body))
+ (problem-hint (cdr (assoc "oauth_problem" problem-report)))
+ (problem-advice (cdr (assoc "oauth_problem_advice" problem-report))))
+ (cond
+ ((and (eql status 401)
+ (equalp problem-hint "token_expired"))
+ (format t "INFO: refreshing access token~%")
+ (let ((new-token (refresh-access-token access-token)))
+ (when on-refresh
+ (funcall on-refresh new-token))
+ (apply #'access-protected-resource uri new-token kwargs)))
+ (t
+ (values body status problem-hint problem-advice)))))))))
-;(obtain-access-token
View
38 src/core/tokens.lisp
@@ -79,16 +79,17 @@
;;; request tokens
(defclass request-token (token consumer-ref-mixin)
- ((callback-uri :type (or null puri:uri)
+ ((callback-uri :type (or puri:uri null)
:reader request-token-callback-uri
:initarg :callback-uri
:initform nil
:documentation "Callback URI for this request token.
NIL means oob.")
- (verification-code :type string
+ (verification-code :type (or string null)
:accessor request-token-verification-code
:initarg :verification-code
- :initform (random-verification-code))
+ :initform (random-verification-code)
+ :documentation "Might be NIL for OAuth 1.0")
(authorized-p :type boolean
:accessor request-token-authorized-p
:initform nil)))
@@ -99,8 +100,37 @@
;;; access tokens
(defclass access-token (token consumer-ref-mixin)
- ())
+ ((session-handle :type (or string null)
+ :reader access-token-session-handle
+ :initarg :session-handle
+ :initform nil)
+ (expires :type (or integer null)
+ :reader access-token-expires
+ :initarg :expires
+ :initform nil
+ :documentation "Universal time when this token expires.")
+ (authorization-expires
+ :type (or integer null)
+ :reader access-token-authorization-expires
+ :initarg :authorization-expires
+ :initform nil
+ :documentation "Universal time when this token's session expires.")
+ (origin-uri
+ :type (or puri:uri string null)
+ :reader access-token-origin-uri
+ :initarg :origin-uri
+ :initform nil
+ :documentation "URI this access token has been obtained from.
+ Needed for refresh.")))
+
(defun make-access-token (&rest args)
(apply #'make-instance 'access-token args))
+(defun access-token-expired-p (access-token)
+ (and (access-token-session-handle access-token)
+ (or (aand (access-token-expires access-token)
+ (> (get-universal-time) it))
+ (aand (access-token-authorization-expires access-token)
+ (> (get-universal-time) it)))))
+
View
4 src/package.lisp
@@ -46,6 +46,10 @@
#:access-token
#:make-access-token
+ #:access-token-session-handle
+ #:access-token-expires
+ #:access-token-authorization-expires
+ #:access-token-expired-p
;;; consumer functions
#:obtain-access-token
Please sign in to comment.
Something went wrong with that request. Please try again.