PageRenderTime 103ms CodeModel.GetById 60ms app.highlight 6ms RepoModel.GetById 34ms app.codeStats 0ms

/src/core/tokens.lisp

http://github.com/skypher/cl-oauth
Lisp | 137 lines | 100 code | 23 blank | 14 comment | 5 complexity | 7f29ce260275e75823387a86a6b4e0a9 MD5 | raw file
  1
  2(in-package :oauth)
  3
  4;;; section 6.
  5;;;
  6;;;  OAuth Authentication is done in three steps:
  7;;;
  8;;;    1. The Consumer obtains an unauthorized Request Token.
  9;;;    2. The User authorizes the Request Token.
 10;;;    3. The Consumer exchanges the Request Token for an Access Token.
 11;;;
 12
 13;;; TODO: token registry GC
 14
 15;;; default token values
 16(let ((random-state (make-random-state t)))
 17  (defun random-key ()
 18    (format nil "~36,25,'0r" (random (expt 36 25) random-state)))
 19
 20  (defun random-secret ()
 21    (format nil "~36,25,'0r" (random (expt 36 25) random-state)))
 22
 23  (defun random-verification-code ()
 24    (format nil "~36,25,'0r" (random (expt 36 25) random-state))))
 25
 26
 27;;; token base class
 28(defclass token ()
 29  ((key :type string
 30        :reader token-key
 31        :initarg :key
 32        :initform (random-key))
 33   (secret :type string
 34           :reader token-secret
 35           :initarg :secret
 36           :initform (random-secret))
 37   (user-data :type list
 38              :accessor token-user-data
 39              :initarg :user-data
 40              :initform nil
 41              :documentation "Application-specific data associated
 42              with this token; an alist.")))
 43
 44(defmethod print-object ((obj token) stream)
 45  "Faking STRUCT-like output. It would probably be better to use
 46  the pretty printer; the code for sb-kernel::%default-structure-pretty-print
 47  will be a useful template."
 48  (print-unreadable-object (obj stream :type t :identity (not *print-pretty*))
 49    (loop for slotname in (mapcar #'c2mop:slot-definition-name
 50                                  (c2mop:class-slots (class-of obj)))
 51          do (progn
 52               (terpri stream)
 53               (write "  " :stream stream :escape nil)
 54               (prin1 (intern (symbol-name slotname) :keyword) stream)
 55               (write " " :stream stream :escape nil)
 56               (prin1 (if (slot-boundp obj slotname)
 57                        (slot-value obj slotname)
 58                        "(unbound)")
 59                      stream)))))
 60
 61
 62;;; consumer tokens
 63(defclass consumer-token (token)
 64  ((last-timestamp :type integer
 65                   :accessor consumer-token-last-timestamp
 66                   :initform 0)))
 67
 68(defun make-consumer-token (&rest args)
 69  (apply #'make-instance 'consumer-token args))
 70
 71
 72(defclass consumer-ref-mixin ()
 73  ((consumer :type consumer-token
 74             :accessor token-consumer
 75             :initarg :consumer
 76             :documentation "The Consumer that originally requested this
 77             token."))
 78  (:documentation "Mixin for classes that refer to a consumer."))
 79
 80
 81;;; request tokens
 82(defclass request-token (token consumer-ref-mixin)
 83  ((callback-uri :type (or puri:uri null)
 84                 :reader request-token-callback-uri
 85                 :initarg :callback-uri
 86                 :initform nil
 87                 :documentation "Callback URI for this request token.
 88                 NIL means oob.")
 89   (verification-code :type (or string null)
 90                      :accessor request-token-verification-code
 91                      :initarg :verification-code
 92                      :initform (random-verification-code)
 93                      :documentation "Might be NIL for OAuth 1.0")
 94   (authorized-p :type boolean
 95                 :accessor request-token-authorized-p
 96                 :initform nil)))
 97
 98(defun make-request-token (&rest args)
 99  (apply #'make-instance 'request-token args))
100
101
102;;; access tokens
103(defclass access-token (token consumer-ref-mixin)
104  ((session-handle :type (or string null)
105                   :reader access-token-session-handle
106                   :initarg :session-handle
107                   :initform nil)
108   (expires :type (or integer null)
109            :reader access-token-expires
110            :initarg :expires
111            :initform nil
112            :documentation "Universal time when this token expires.")
113   (authorization-expires
114     :type (or integer null)
115     :reader access-token-authorization-expires
116     :initarg :authorization-expires
117     :initform nil
118     :documentation "Universal time when this token's session expires.")
119   (origin-uri
120     :type (or puri:uri string null)
121     :reader access-token-origin-uri
122     :initarg :origin-uri
123     :initform nil
124     :documentation "URI this access token has been obtained from.
125                     Needed for refresh.")))
126
127
128(defun make-access-token (&rest args)
129  (apply #'make-instance 'access-token args))
130
131(defun access-token-expired-p (access-token)
132  (and (access-token-session-handle access-token)
133       (or (aand (access-token-expires access-token)
134                 (> (get-universal-time) it))
135           (aand (access-token-authorization-expires access-token)
136                 (> (get-universal-time) it)))))
137