/src/core/parameters.lisp
Lisp | 61 lines | 45 code | 10 blank | 6 comment | 3 complexity | fd6699dc26477af883fc35707220eedd MD5 | raw file
Possible License(s): LGPL-3.0
1 2(in-package :oauth) 3 4(export '(parameter sort-parameters normalized-parameters)) 5 6;; the cache allows us to call NORMALIZED-PARAMETERS repeatedly 7;; without excessive processing penalty. 8(defvar *parameters-cache* (tg:make-weak-hash-table :test #'eq :weakness :key) 9 "Per-request cache for parameters in OAuth requests.") 10 11(defvar *signature-cache* (tg:make-weak-hash-table :test #'eq :weakness :key) 12 ;; this is much more simple than maintaining multiple caches 13 ;; for different parameter list flavors. 14 "Per-request cache for signatures in OAuth requests.") 15 16(defun sort-parameters (parameters) 17 "Sort PARAMETERS according to the OAuth spec. This is a destructive operation." 18 (assert (not (assoc "oauth_signature" parameters :test #'equal))) 19 (sort parameters #'string< :key (lambda (x) 20 "Sort by key and value." 21 (concatenate 'string (princ-to-string (car x)) 22 (princ-to-string (cdr x)))))) 23 24(defun normalized-parameters (&key remove-duplicates-p) 25 "Collect request parameters and remove those excluded by the standard. See 9.1.1. 26 Note: REMOVE-DUPLICATES-P has no effect right now." 27 (declare (ignorable remove-duplicates-p)) 28 (or (gethash (request) *parameters-cache*) 29 (let ((parameters (append (remove "realm" (auth-parameters) 30 :key #'car :test #'equalp) ; TODO: http auth header parameters 31 (post-parameters) 32 (get-parameters)))) 33 ;; save the signature, we might need it later 34 (setf (gethash (request) *signature-cache*) 35 (cdr (assoc "oauth_signature" parameters :test #'equal))) 36 (let* ((parameters (remove "oauth_signature" parameters 37 :key #'car :test #'equal)) 38 (sorted-parameters (sort-parameters parameters))) 39 (setf (gethash (request) *parameters-cache*) sorted-parameters) 40 sorted-parameters 41 #+(or) ; disabled for now because it makes caching slightly more complex. 42 ; we just don't support elimination of duplicates right now. 43 (if remove-duplicates-p 44 (remove-duplicates sorted-parameters :key #'car :test #'string-equal :from-end t) 45 sorted-parameters))))) 46 47(defun parameter (name &key (test #'equal)) 48 "Note: OAuth parameters are case-sensitive per section 5. 49 The case of user-supplied parameters is not restricted." 50 (cdr (assoc name (normalized-parameters) :test test))) 51 52(defun oauth-parameter-p (parameter) 53 "Return T if PARAMETER starts with \"oauth_\". PARAMETER is a 54string denoting the parameter name." 55 (equal 56 (subseq (car (ensure-list parameter)) 0 (min 6 (length parameter))) 57 "oauth_" )) 58 59(defun remove-oauth-parameters (parameters) 60 (remove-if #'oauth-parameter-p parameters :key #'car)) 61