PageRenderTime 124ms CodeModel.GetById 60ms app.highlight 17ms RepoModel.GetById 44ms app.codeStats 0ms

/src/core/service-provider.lisp

http://github.com/skypher/cl-oauth
Lisp | 264 lines | 195 code | 43 blank | 26 comment | 2 complexity | 5dc6aca298ce5fd99076bdd16cbeaf61 MD5 | raw file
  1
  2(in-package :oauth)
  3
  4(defvar *protocol-version* :1.0)
  5
  6;;;; Service provider infrastructure
  7
  8;;;; TODO: need to store application-specific data somewhere.
  9
 10
 11(defun finalize-callback-uri (request-token)
 12  "Prepares the callback URI of REQUEST-TOKEN for
 13  redirection."
 14  (let ((uri (request-token-callback-uri request-token)))
 15    (setf (puri:uri-query uri)
 16          (concatenate 'string (or (puri:uri-query uri) "")
 17                       (if (puri:uri-query uri) "&" "")
 18                       "oauth_token="
 19                         (url-encode (token-key request-token))
 20                       "&oauth_verifier="
 21                         (url-encode (request-token-verification-code request-token))))
 22    uri))
 23
 24
 25;;; Consumer management
 26(defvar *registered-consumers* (make-hash-table :test #'equalp))
 27
 28(defmethod register-token ((token consumer-token))
 29  (setf (gethash (token-key token) *registered-consumers*) token)
 30  token)
 31
 32(defmethod unregister-token ((token consumer-token))
 33  (remhash (token-key token) *registered-consumers*))
 34
 35(defun get-consumer-token (key)
 36  (gethash key *registered-consumers*))
 37
 38(defmacro ignore-oauth-errors (&body body)
 39  `(handler-case (progn ,@body)
 40     (http-error (condition) (values nil condition))))
 41
 42;;; signature checking
 43(defun check-signature ()
 44  (unless (equalp (parameter "oauth_signature_method") "HMAC-SHA1")
 45    (raise-error 'bad-request "Signature method not passed or different from HMAC-SHA1"))
 46  (let* ((supplied-signature (gethash (request) *signature-cache*))
 47         ;; TODO: do not bluntly ignore all errors. Factor out into GET-TOKEN
 48         (consumer-secret (ignore-errors
 49                            (token-secret
 50                              (get-consumer-token (parameter "oauth_consumer_key")))))
 51         (token-secret (ignore-errors
 52                         (token-secret (or (ignore-oauth-errors (get-supplied-request-token))
 53                                           (ignore-oauth-errors (get-supplied-access-token)))))))
 54    (unless supplied-signature
 55      (raise-error 'bad-request "This request is not signed"))
 56    (unless consumer-secret
 57      (raise-error 'unauthorized "Invalid consumer"))
 58    ;; now calculate the signature and check for match
 59    (let* ((signature-base-string (signature-base-string))
 60           (hmac-key (hmac-key consumer-secret token-secret))
 61           (signature (hmac-sha1 signature-base-string hmac-key))
 62           (encoded-signature (encode-signature signature nil)))
 63      (unless (equal encoded-signature supplied-signature)
 64        (format t "calculated: ~S / supplied: ~S~%" encoded-signature supplied-signature)
 65        (raise-error 'unauthorized "Invalid signature")))
 66    t))
 67
 68
 69;;; nonce and timestamp checking
 70(defun check-nonce-and-timestamp (consumer-token)
 71  ;; TODO: nonce checking
 72  (unless (parameter "oauth_timestamp")
 73      (raise-error 'bad-request "Missing Timestamp"))
 74  (let ((timestamp (ignore-errors (parse-integer (parameter "oauth_timestamp"))))
 75        (nonce (parameter "oauth_nonce")))
 76    (unless timestamp
 77      (raise-error 'unauthorized "Malformed Timestamp"))
 78    (unless nonce
 79      (raise-error 'bad-request "Missing nonce"))
 80    (unless (>= timestamp (consumer-token-last-timestamp consumer-token))
 81      (raise-error 'unauthorized "Invalid timestamp"))
 82    t))
 83
 84
 85;;; version checking
 86(defun check-version ()
 87  (let ((version (parameter "oauth_version")))
 88    (unless (member version '("1.0" nil) :test #'equalp)
 89      (raise-error 'bad-request "Not prepared to handle OAuth version other than 1.0" version))
 90    t))
 91
 92
 93;;; verification code checking
 94(defun check-verification-code ()
 95  (unless (equal (parameter "oauth_verifier")
 96                 (request-token-verification-code (get-supplied-request-token)))
 97    (raise-error 'unauthorized "Invalid verification code"))
 98  t)
 99
100
101;;; misc
102(defun get-supplied-consumer-token ()
103  (let ((consumer-key (parameter "oauth_consumer_key")))
104    (unless consumer-key
105      (raise-error 'bad-request "Consumer key not supplied"))
106    (let ((consumer-token (get-consumer-token consumer-key)))
107      (unless consumer-token
108        (raise-error 'unauthorized "Can't identify Consumer"))
109      consumer-token)))
110
111
112(defun get-supplied-callback-uri (&key allow-oob-callback-p
113                                       (allow-none (eq *protocol-version* :1.0)))
114  (let ((callback (parameter "oauth_callback")))
115    (cond
116      ((and (not allow-none) (not callback))
117       (raise-error 'bad-request "No callback supplied"))
118      ((and (not allow-oob-callback-p) (equal callback "oob"))
119       (raise-error 'bad-request "Not prepared for an OOB callback setup!"))
120      (t
121       callback))))
122
123
124;;; request token management
125(defvar *issued-request-tokens* (make-hash-table :test #'equalp))
126
127(defmethod register-token ((token request-token))
128  ;; TODO: already registered?
129  (setf (gethash (token-key token) *issued-request-tokens*) token))
130
131(defmethod unregister-token ((token request-token))
132  (remhash (token-key token) *issued-request-tokens*))
133
134(defun invalidate-request-token (request-token)
135  (remhash (token-key request-token) *issued-request-tokens*))
136
137(defun make-response (alist)
138  "[5.3]"
139  (alist->query-string
140    (mapcar (lambda (cons)
141              (cons (url-encode (car cons))
142                    (url-encode (cdr cons))))
143            alist)
144    :include-leading-ampersand nil))
145
146(defun request-token-response (request-token &rest additional-parameters)
147  "Respond to a valid request token request. [6.1.2]"
148  (assert (notany #'oauth-parameter-p additional-parameters))
149  (make-response
150    (append
151      `(("oauth_token" . ,(token-key request-token))
152        ("oauth_token_secret" . ,(token-secret request-token))
153        ("oauth_callback_confirmed" . "true"))
154      additional-parameters)))
155
156(defun validate-request-token-request (&key (request-token-ctor #'make-request-token)
157                                            allow-oob-callback-p)
158  "Check whether REQUEST is a valid request token request.
159  
160  Returns the supplied Consumer callback (a PURI:URI) or NIL if
161  the callback is supposed to be transferred oob. [6.1.1]"
162  (protocol-assert (>= (length (normalized-parameters))
163                       (case *protocol-version*
164                         ;; callbacks were introduced in 1.0a
165                         (1.0 4)
166                         (t 6 5))))
167  (check-version)
168  (check-signature)
169  (let ((consumer-token (get-supplied-consumer-token)))
170    (check-nonce-and-timestamp consumer-token)
171    (let* ((callback-uri (get-supplied-callback-uri :allow-oob-callback-p allow-oob-callback-p
172                                                    :allow-none t))
173           (request-token (funcall request-token-ctor :consumer consumer-token
174                                   :callback-uri (when callback-uri
175                                                   (puri:parse-uri callback-uri))
176                                   :user-data (remove-oauth-parameters (normalized-parameters)))))
177      (register-token request-token)
178      request-token)))
179
180(defun get-supplied-request-token (&key check-verification-code-p)
181  "Utility function that extracts the Consumer-supplied request token
182  from a list of normalized parameters. Guards against non-existing
183  and unknown tokens. Returns the request token on success."
184  ;; TODO: check whether the supplied token matches the Consumer key
185  (let ((request-token-key (parameter "oauth_token")))
186    ;; check if the Consumer supplied a request token
187    (unless request-token-key
188      (raise-error 'bad-request "Missing request token"))
189    ;; check if the supplied request token is known to us
190    (let ((request-token (gethash request-token-key *issued-request-tokens*)))
191      (unless request-token
192        (raise-error 'unauthorized "Invalid request token"))
193      (when check-verification-code-p
194        (check-verification-code))
195      ;; everything's looking good
196      request-token)))
197
198
199;;; access token management
200(defvar *issued-access-tokens* (make-hash-table :test #'equalp))
201
202(defmethod register-token ((token access-token))
203  (setf (gethash (token-key token) *issued-access-tokens*) token))
204
205(defmethod unregister-token ((token access-token))
206  (remhash (token-key token) *issued-access-tokens*))
207
208(defun validate-access-token-request (&key (access-token-ctor #'make-access-token))
209  ;; no user-supplied parameters allowed here, and the
210  ;; spec forbids duplicate oauth args per section 5.
211  ;; moreover we don't count the oauth_signature parameter as it isn't
212  ;; part of the normalized parameter list.
213  (protocol-assert (multiple-value-call #'between (length (normalized-parameters))
214             (case *protocol-version*
215               (1.0 (values 5 6))
216               (t 6 (values 6 7)))))
217  (format t "foo~%")
218  (protocol-assert (null (remove-oauth-parameters (normalized-parameters))))
219  (format t "bar~%")
220  (check-version)
221  (check-signature)
222  (let* ((request-token (get-supplied-request-token
223                          :check-verification-code-p (not (eq *protocol-version* :1.0))))
224         (consumer (token-consumer request-token)))
225    (check-nonce-and-timestamp consumer)
226    (let ((access-token (funcall access-token-ctor :consumer consumer)))
227      (register-token access-token)
228      (prog1
229          access-token
230        (invalidate-request-token request-token)))))
231
232(defun access-token-response (access-token &rest additional-parameters)
233  (declare (ignore additional-parameters)) ; TODO not supported yet
234  (url-encode (alist->query-string
235                `(("oauth_token" . ,(token-key access-token))
236                  ("oauth_token_secret" . ,(token-secret access-token))))))
237
238
239;;; protected resource access management [7]
240(defun get-supplied-access-token ()
241  "Utility function that extracts the Consumer-supplied request token
242  from a list of normalized parameters. Guards against non-existing
243  and unknown tokens. Returns the request token on success."
244  ;; TODO: check whether the supplied token matches the Consumer key
245  (let ((access-token-key (parameter "oauth_token")))
246    (unless access-token-key
247      (raise-error 'bad-request "Missing access token"))
248    ;; check if the supplied access token is known to us
249    (let ((access-token (gethash access-token-key *issued-access-tokens*)))
250      (unless access-token
251        (raise-error 'unauthorized "Invalid access token"))
252      access-token)))
253
254(defun validate-access-token ()
255  (protocol-assert (>= (length (normalized-parameters)) 6))
256  (check-version)
257  (check-signature)
258  (let ((consumer-token (get-supplied-consumer-token)))
259    (check-nonce-and-timestamp consumer-token)
260    (let ((access-token (get-supplied-access-token)))
261      (unless (eq consumer-token (token-consumer access-token))
262        (raise-error 'unauthorized "Access token ~S wasn't issued for Consumer ~S" access-token consumer-token))
263      t)))
264