Browse code
Cleaning up the code base
- Replace the plethora of global variables with objects
- Move most of the app-specific code to the very end
- Still need to separate Google/Facebook app secrets out
Showing 3 changed files
... | ... |
@@ -1,11 +1,20 @@ |
1 | 1 |
;;;; cl-oid-connect.asd |
2 | 2 |
|
3 | 3 |
(asdf:defsystem :cl-oid-connect |
4 |
- :description "Describe cl-oid-connect here" |
|
5 |
- :author "Your Name <your.name@example.com>" |
|
6 |
- :license "Specify license here" |
|
7 |
- :depends-on (#:drakma) |
|
4 |
+ :description "A Common Lisp Implementation of Various OAuth2 Authentication Protocols" |
|
5 |
+ :author "Ed L <(format nil \"~a@~a\" \"el-projects\" \"howit.is\")>" |
|
6 |
+ :license "2=Clause BSD" |
|
7 |
+ :depends-on (:drakma |
|
8 |
+ :ningle |
|
9 |
+ :clack |
|
10 |
+ :cljwt |
|
11 |
+ :cl-json |
|
12 |
+ :anaphora |
|
13 |
+ :alexandria |
|
14 |
+ :lack-middleware-session |
|
15 |
+ :cl-who) |
|
8 | 16 |
:serial t |
9 | 17 |
:components ((:file "package") |
10 | 18 |
(:file "cl-oid-connect"))) |
11 | 19 |
|
20 |
+ |
... | ... |
@@ -1,97 +1,143 @@ |
1 | 1 |
;;;; cl-oid-connect.lisp |
2 | 2 |
#| |
3 |
- |Copyright (c) 2015 Edward Langley |
|
4 |
- |All rights reserved. |
|
5 |
- | |
|
6 |
- |Redistribution and use in source and binary forms, with or without |
|
7 |
- |modification, are permitted provided that the following conditions |
|
8 |
- |are met: |
|
9 |
- | |
|
10 |
- |Redistributions of source code must retain the above copyright notice, |
|
11 |
- |this list of conditions and the following disclaimer. |
|
12 |
- | |
|
13 |
- |Redistributions in binary form must reproduce the above copyright |
|
14 |
- |notice, this list of conditions and the following disclaimer in the |
|
15 |
- |documentation and/or other materials provided with the distribution. |
|
16 |
- | |
|
17 |
- |Neither the name of the project's author nor the names of its |
|
18 |
- |contributors may be used to endorse or promote products derived from |
|
19 |
- |this software without specific prior written permission. |
|
20 |
- | |
|
21 |
- |THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
|
22 |
- |"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
|
23 |
- |LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS |
|
24 |
- |FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
|
25 |
- |HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
26 |
- |SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES INCLUDING, BUT NOT LIMITED |
|
27 |
- |TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
|
28 |
- |PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
|
29 |
- |LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
|
30 |
- |NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
|
31 |
- |SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
32 |
- | |
|
33 |
- |# |
|
3 |
+|Copyright (c) 2015 Edward Langley |
|
4 |
+|All rights reserved. |
|
5 |
+| |
|
6 |
+|Redistribution and use in source and binary forms, with or without |
|
7 |
+|modification, are permitted provided that the following conditions |
|
8 |
+|are met: |
|
9 |
+| |
|
10 |
+|Redistributions of source code must retain the above copyright notice, |
|
11 |
+|this list of conditions and the following disclaimer. |
|
12 |
+| |
|
13 |
+|Redistributions in binary form must reproduce the above copyright |
|
14 |
+|notice, this list of conditions and the following disclaimer in the |
|
15 |
+|documentation and/or other materials provided with the distribution. |
|
16 |
+| |
|
17 |
+|Neither the name of the project's author nor the names of its |
|
18 |
+|contributors may be used to endorse or promote products derived from |
|
19 |
+|this software without specific prior written permission. |
|
20 |
+| |
|
21 |
+|THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
|
22 |
+|"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
|
23 |
+|LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS |
|
24 |
+|FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
|
25 |
+|HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
26 |
+|SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES INCLUDING, BUT NOT LIMITED |
|
27 |
+|TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
|
28 |
+|PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
|
29 |
+|LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
|
30 |
+|NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
|
31 |
+|SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
32 |
+| |
|
33 |
+|# |
|
34 | 34 |
|
35 | 35 |
(in-package :cl-oid-connect) |
36 |
-(setq drakma:*text-content-types* (cons '("application" . "json") drakma:*text-content-types*)) |
|
37 |
- |
|
38 |
-(with-open-file (fbook-info #P"facebook-secrets.json") |
|
39 |
- (let* ((data (yason:parse fbook-info)) |
|
40 |
- (client-id (gethash "client-id" data)) |
|
41 |
- (secret (gethash "secret" data))) |
|
42 |
- (defvar *FBOOK-CLIENT-ID* client-id) |
|
43 |
- (defvar *FBOOK-CLIENT-SECRET* secret))) |
|
44 |
- |
|
45 |
-(with-open-file (goog-info #P"google-secrets.json") |
|
46 |
- (let* ((data (yason:parse goog-info)) |
|
47 |
- (client-id (gethash "client-id" data)) |
|
48 |
- (secret (gethash "secret" data))) |
|
49 |
- (defvar *GOOG-CLIENT-ID* client-id) |
|
50 |
- (defvar *GOOG-CLIENT-SECRET* secret))) |
|
51 |
- |
|
52 |
-;;; "cl-oid-connect" goes here. Hacks and glory await! |
|
53 |
-(defvar *app* (make-instance 'ningle:<app>)) |
|
54 |
-(defvar *state* nil) |
|
55 |
- |
|
56 |
-;; These tokens specify the auth endpoint. These are autodiscovered, if the relevant |
|
57 |
-;; functions are wrapped with the "with-goog-endpoints" macro. |
|
58 |
-(defvar *auth-endpoint* nil) |
|
59 |
-(defvar *token-endpoint* nil) |
|
60 |
-(defvar *client-id* nil) |
|
61 |
-(defvar *client-secret* nil) |
|
62 |
-(defvar *user-info-cb* (lambda ())) |
|
63 |
-(defvar *get-access-token* (lambda ())) |
|
64 |
-(defvar *redirect-uri* nil) |
|
36 |
+; Should this be here? |
|
37 |
+(setf drakma:*text-content-types* (cons '("application" . "json") drakma:*text-content-types*)) |
|
38 |
+ |
|
39 |
+(sheeple:defproto =service-info= () |
|
40 |
+ ((client-id nil :accessor t) |
|
41 |
+ (secret nil :accessor t))) |
|
42 |
+ |
|
43 |
+(defvar *FBOOK-INFO* (sheeple:clone =service-info=)) |
|
44 |
+(defun load-facebook-info (loadfrom) |
|
45 |
+ (setf *FBOOK-INFO* |
|
46 |
+ (with-open-file (fbook-info (truename loadfrom)) |
|
47 |
+ (let* ((data (yason:parse fbook-info)) |
|
48 |
+ (client-id (gethash "client-id" data)) |
|
49 |
+ (secret (gethash "secret" data))) |
|
50 |
+ (sheeple:defobject (=service-info=) |
|
51 |
+ ((client-id client-id) |
|
52 |
+ (secret secret))))))) |
|
53 |
+ |
|
54 |
+(defvar *GOOG-INFO* (sheeple:clone =service-info=)) |
|
55 |
+(defun load-google-info (loadfrom) |
|
56 |
+ (setf *GOOG-INFO* |
|
57 |
+ (with-open-file (goog-info (truename loadfrom)) |
|
58 |
+ (let* ((data (yason:parse goog-info)) |
|
59 |
+ (client-id (gethash "client-id" data)) |
|
60 |
+ (secret (gethash "secret" data))) |
|
61 |
+ (sheeple:defobject (=service-info=) |
|
62 |
+ ((client-id client-id) |
|
63 |
+ (secret secret))))))) |
|
64 |
+ |
|
65 |
+(load-facebook-info #p"facebook-secrets.json") |
|
66 |
+(load-google-info #p"google-secrets.json") |
|
65 | 67 |
|
66 | 68 |
(defmacro string-assoc (key alist) `(assoc ,key ,alist :test #'equal)) |
67 | 69 |
(defmacro assoc-cdr (key alist) `(cdr (assoc ,key ,alist))) |
68 | 70 |
|
69 |
-(defmacro with-goog-endpoints (&body body) |
|
70 |
- (alexandria:with-gensyms (discovery-document) |
|
71 |
- `(let* ((,discovery-document |
|
72 |
- (cl-json:decode-json-from-string |
|
73 |
- (drakma:http-request "https://accounts.google.com/.well-known/openid-configuration"))) |
|
74 |
- (*auth-endpoint* (assoc-cdr :authorization--endpoint ,discovery-document)) |
|
75 |
- (*token-endpoint* (assoc-cdr :token--endpoint ,discovery-document)) |
|
76 |
- (*client-id* *GOOG-CLIENT-ID*) |
|
77 |
- (*client-secret* *GOOG-CLIENT-SECRET*) |
|
78 |
- (*redirect-uri* "http://srv2.elangley.org:9090/oidc_callback/google") |
|
79 |
- ) |
|
80 |
- ,@body))) |
|
81 |
- |
|
82 |
- |
|
83 |
-(defmacro with-fbook-endpoints (&body body) |
|
84 |
- `(let* ((*auth-endpoint* "https://www.facebook.com/dialog/oauth") |
|
85 |
- (*token-endpoint* "https://graph.facebook.com/v2.3/oauth/access_token") |
|
86 |
- (*client-id* *FBOOK-CLIENT-ID*) |
|
87 |
- (*client-secret* *FBOOK-CLIENT-SECRET*) |
|
88 |
- (*user-info-cb* #'fb-get-userinfo) |
|
89 |
- (*get-access-token* #'fb-get-access-token) |
|
90 |
- (*redirect-uri* "http://srv2.elangley.org:9090/oidc_callback/facebook")) |
|
91 |
- ,@body)) |
|
92 |
- |
|
93 |
-(defun fb-get-userinfo (access-token) |
|
94 |
- (let ((endpoint "https://graph.facebook.com/v2.3/me")) |
|
71 |
+(sheeple:defproto =endpoint-schema= () |
|
72 |
+ ((auth-endpoint nil :accessor t) |
|
73 |
+ (token-endpoint nil :accessor t) |
|
74 |
+ (redirect-uri nil :accessor t))) |
|
75 |
+(sheeple:defmessage get-user-info (a b)) |
|
76 |
+(sheeple:defmessage get-access-token (a b)) |
|
77 |
+ |
|
78 |
+(sheeple:defreply get-user-info ((a =endpoint-schema=) (b sheeple:=string=))) |
|
79 |
+(sheeple:defreply get-access-token ((a =endpoint-schema=) (b sheeple:=string=))) |
|
80 |
+ |
|
81 |
+(defun discover-endpoints (service-info discovery-doc-url &key (gat nil gat-p) (gui nil gui-p)) |
|
82 |
+ (let ((discovery-document (cl-json:decode-json-from-string (drakma:http-request discovery-doc-url))) |
|
83 |
+ (schema (sheeple:object :parents `(,=endpoint-schema= ,service-info)))) |
|
84 |
+ |
|
85 |
+ (setf (auth-endpoint schema) (assoc-cdr :authorization--endpoint discovery-document)) |
|
86 |
+ (setf (token-endpoint schema) (assoc-cdr :token--endpoint discovery-document)) |
|
87 |
+ |
|
88 |
+ (if gui-p (sheeple:defreply get-user-info ((a schema)) (funcall gui a))) |
|
89 |
+ (if gat-p (sheeple:defreply get-access-token ((a schema) (b sheeple:=string=)) |
|
90 |
+ (funcall gat a b))) |
|
91 |
+ |
|
92 |
+ schema)) |
|
93 |
+ |
|
94 |
+; This probably should eventually go? |
|
95 |
+(defvar *endpoint-schema* nil) |
|
96 |
+(defmacro with-endpoints (endpoint-schema &body body) |
|
97 |
+ `(let* ((*endpoint-schema* ,endpoint-schema)) |
|
98 |
+ ,@body)) |
|
99 |
+ |
|
100 |
+(defun goog-get-access-token (endpoint-schema code) |
|
101 |
+ (cl-json:decode-json-from-string |
|
102 |
+ (drakma:http-request (token-endpoint endpoint-schema) |
|
103 |
+ :method :post |
|
104 |
+ :redirect nil |
|
105 |
+ :parameters `(("code" . ,code) |
|
106 |
+ ("client_id" . ,(client-id endpoint-schema)) |
|
107 |
+ ("client_secret" . ,(secret endpoint-schema)) |
|
108 |
+ ("redirect_uri" . ,(redirect-uri endpoint-schema)) |
|
109 |
+ ("grant_type" . "authorization_code"))))) |
|
110 |
+ |
|
111 |
+; goog is well behaved |
|
112 |
+(defvar *goog-endpoint-schema* |
|
113 |
+ (discover-endpoints *GOOG-INFO* "https://accounts.google.com/.well-known/openid-configuration" |
|
114 |
+ :gat #'goog-get-access-token)) |
|
115 |
+(setf (redirect-uri *goog-endpoint-schema*) "http://srv2.elangley.org:9090/oidc_callback/google") |
|
116 |
+ |
|
117 |
+ |
|
118 |
+; fbook needs personal attention |
|
119 |
+(defproto *fbook-endpoint-schema* (=endpoint-schema= *fbook-info*) |
|
120 |
+ ((auth-endpoint "https://www.facebook.com/dialog/oauth") |
|
121 |
+ (token-endpoint "https://graph.facebook.com/v2.3/oauth/access_token") |
|
122 |
+ (userinfo-endpoint "https://graph.facebook.com/v2.3/me" :accessor t) |
|
123 |
+ (redirect-uri "http://srv2.elangley.org:9090/oidc_callback/facebook"))) |
|
124 |
+ |
|
125 |
+(sheeple:defreply get-access-token ((endpoint-schema *fbook-endpoint-schema*) (code sheeple:=string=)) |
|
126 |
+ (cl-json:decode-json-from-string |
|
127 |
+ (drakma:http-request (token-endpoint endpoint-schema) |
|
128 |
+ :method :post |
|
129 |
+ :redirect nil |
|
130 |
+ :parameters `(("code" . ,code) |
|
131 |
+ ("client_id" . ,(client-id endpoint-schema)) |
|
132 |
+ ("app_id" . ,(client-id endpoint-schema)) |
|
133 |
+ ("client_secret" . ,(secret endpoint-schema)) |
|
134 |
+ ("redirect_uri" . ,(redirect-uri endpoint-schema)) |
|
135 |
+ ("grant_type" . "authorization_code") |
|
136 |
+ ("") |
|
137 |
+ )))) |
|
138 |
+ |
|
139 |
+(sheeple:defreply get-user-info ((endpoint-schema *fbook-endpoint-schema*) (access-token sheeple:=string=)) |
|
140 |
+ (let ((endpoint (userinfo-endpoint endpoint-schema))) |
|
95 | 141 |
(cl-json:decode-json-from-string |
96 | 142 |
(drakma:http-request endpoint |
97 | 143 |
:parameters `(("access_token" . ,access-token)))))) |
... | ... |
@@ -109,27 +155,15 @@ |
109 | 155 |
(with-goog-endpoints |
110 | 156 |
(funcall app env))))) |
111 | 157 |
|
112 |
-(defun get-access-token (code) |
|
113 |
- (cl-json:decode-json-from-string |
|
114 |
- (drakma:http-request *token-endpoint* |
|
115 |
- :method :post |
|
116 |
- :redirect nil |
|
117 |
- :parameters `(("code" . ,code) |
|
118 |
- ("client_id" . ,*client-id*) |
|
119 |
- ("app_id" . ,*client-id*) |
|
120 |
- ("client_secret" . ,*client-secret*) |
|
121 |
- ("redirect_uri" . ,*redirect-uri*) |
|
122 |
- ("grant_type" . "authorization_code"))))) |
|
123 |
- |
|
124 |
-(defun do-auth-request (state) |
|
125 |
- (format t "~%client-id: ~a~%" *client-id*) |
|
126 |
- (drakma:http-request *auth-endpoint* |
|
158 |
+(defun do-auth-request (endpoint-schema state) |
|
159 |
+ (format t "~%client-id: ~a~%" (auth-endpoint endpoint-schema)) |
|
160 |
+ (drakma:http-request (auth-endpoint endpoint-schema) |
|
127 | 161 |
:redirect nil |
128 |
- :parameters `(("client_id" . ,*client-id*) |
|
129 |
- ("app_id" . ,*client-id*) |
|
162 |
+ :parameters `(("client_id" . ,(client-id endpoint-schema)) |
|
163 |
+ ("app_id" . ,(client-id endpoint-schema)) |
|
130 | 164 |
("response_type" . "code") |
131 | 165 |
("scope" . "email") |
132 |
- ("redirect_uri" . ,*redirect-uri*) |
|
166 |
+ ("redirect_uri" . ,(redirect-uri endpoint-schema)) |
|
133 | 167 |
("state" . ,state)))) |
134 | 168 |
|
135 | 169 |
(defun gen-state (len) |
... | ... |
@@ -138,6 +172,7 @@ |
138 | 172 |
(loop repeat len |
139 | 173 |
do (princ (random 36) stream))))) |
140 | 174 |
|
175 |
+(defvar *app* (make-instance 'ningle:<app>)) |
|
141 | 176 |
(defmacro def-route (url args &body body) |
142 | 177 |
`(setf (ningle:route *app* ,url) |
143 | 178 |
#'(lambda ,args |
... | ... |
@@ -158,29 +193,22 @@ |
158 | 193 |
(if (not (eql nil (gethash :userinfo ,session))) |
159 | 194 |
(progn |
160 | 195 |
,@body) |
161 |
- '(302 (:location "/login")))))) |
|
196 |
+ (progn |
|
197 |
+ (setf (gethash :next-page session) (lack.request:request-path-info *request*)) |
|
198 |
+ '(302 (:location "/login"))))))) |
|
162 | 199 |
|
163 | 200 |
(defmacro with-session ((var) &body body) |
164 | 201 |
`(let ((,var (context :session))) |
165 | 202 |
,@body)) |
166 | 203 |
|
167 | 204 |
|
168 |
-(def-route "/login" (params) |
|
169 |
- (cl-who:with-html-output-to-string (s) |
|
170 |
- (:html |
|
171 |
- (:head |
|
172 |
- (:title "Login")) |
|
173 |
- (:body |
|
174 |
- (:div (:a :href "/login/facebook" "Facebook")) |
|
175 |
- (:div (:a :href "/login/google" "Google")))))) |
|
176 |
- |
|
177 |
- |
|
178 | 205 |
(def-route "/login/google" (params) |
179 | 206 |
(with-session (session) |
180 | 207 |
(let ((state (gen-state 36))) |
181 | 208 |
(setf (gethash :state session) state) |
182 |
- (with-goog-endpoints |
|
183 |
- (multiple-value-bind (content rcode headers) (do-auth-request state) |
|
209 |
+ (with-endpoints *goog-endpoint-schema* |
|
210 |
+ (setf (gethash :endpoint-schema session) *goog-endpoint-schema*) |
|
211 |
+ (multiple-value-bind (content rcode headers) (do-auth-request *goog-endpoint-schema* state) |
|
184 | 212 |
(if (< rcode 400) |
185 | 213 |
`(302 (:location ,(cdr (assoc :location headers)))) |
186 | 214 |
content)))))) |
... | ... |
@@ -190,28 +218,21 @@ |
190 | 218 |
(with-session (session) |
191 | 219 |
(let ((state (gen-state 36))) |
192 | 220 |
(setf (gethash :state session) state) |
193 |
- (with-fbook-endpoints |
|
194 |
- (multiple-value-bind (content rcode headers uri) (do-auth-request state) |
|
221 |
+ (with-endpoints *fbook-endpoint-schema* |
|
222 |
+ (setf (gethash :endpoint-schema session) *fbook-endpoint-schema*) |
|
223 |
+ (multiple-value-bind (content rcode headers uri) (do-auth-request *fbook-endpoint-schema* state) |
|
195 | 224 |
(if (< rcode 400) |
196 | 225 |
`(302 (:location ,(format nil "~a" uri))) |
197 | 226 |
content)))))) |
198 | 227 |
|
199 |
-;(def-route "/oidc_callback" (params) |
|
200 |
-; (let ((received-state (cdr (string-assoc "state" params))) |
|
201 |
-; (code (cdr (string-assoc "code" params)))) |
|
202 |
-; (with-fbook-endpoints |
|
203 |
-; (check-state received-state |
|
204 |
-; (let* ((a-t (get-access-token code))) |
|
205 |
-; (format nil "~s" a-t)) |
|
206 |
-; '(403 '() "Out, vile imposter!"))))) |
|
207 |
- |
|
208 | 228 |
(def-route "/oidc_callback/google" (params) |
209 | 229 |
(let ((received-state (cdr (string-assoc "state" params))) |
210 | 230 |
(code (cdr (string-assoc "code" params)))) |
211 | 231 |
(check-state received-state |
212 | 232 |
(with-session (session) |
213 |
- (with-goog-endpoints |
|
214 |
- (let* ((a-t (get-access-token code)) (id-token (assoc-cdr :id--token a-t)) |
|
233 |
+ (with-endpoints *goog-endpoint-schema* |
|
234 |
+ (let* ((a-t (get-access-token *goog-endpoint-schema* code)) |
|
235 |
+ (id-token (assoc-cdr :id--token a-t)) |
|
215 | 236 |
(decoded (cljwt:decode id-token :fail-if-unsupported nil))) |
216 | 237 |
(setf (gethash :userinfo session) decoded) |
217 | 238 |
'(302 (:location "/"))))) |
... | ... |
@@ -221,19 +242,19 @@ |
221 | 242 |
(def-route "/oidc_callback/facebook" (params) |
222 | 243 |
(let ((received-state (cdr (string-assoc "state" params))) |
223 | 244 |
(code (cdr (string-assoc "code" params)))) |
224 |
- (with-fbook-endpoints |
|
245 |
+ (with-endpoints *fbook-endpoint-schema* |
|
225 | 246 |
(check-state received-state |
226 | 247 |
(with-session (session) |
227 |
- (let* ((a-t (get-access-token code)) |
|
248 |
+ (let* ((a-t (get-access-token *fbook-endpoint-schema* code)) |
|
228 | 249 |
(id-token (assoc-cdr :access--token a-t))) |
229 |
- (setf (gethash :userinfo session) (funcall *user-info-cb* id-token)) |
|
250 |
+ (setf (gethash :userinfo session) (get-user-info *fbook-endpoint-schema* id-token)) |
|
230 | 251 |
'(302 (:location "/")))) |
231 | 252 |
'(403 '() "Out, vile imposter!"))))) |
232 | 253 |
|
233 | 254 |
(def-route "/userinfo.json" (params) |
234 | 255 |
(with-session (session) |
235 | 256 |
(require-login |
236 |
- (with-fbook-endpoints |
|
257 |
+ (with-endpoints (gethash :endpoint-schema session) |
|
237 | 258 |
(cl-json:encode-json-to-string (gethash :userinfo session)))))) |
238 | 259 |
|
239 | 260 |
(def-route "/logout" (params) |
... | ... |
@@ -241,16 +262,25 @@ |
241 | 262 |
(setf (gethash :userinfo session) nil) |
242 | 263 |
'(302 (:location "/")))) |
243 | 264 |
|
265 |
+(def-route "/login" (params) |
|
266 |
+ (cl-who:with-html-output-to-string (s) |
|
267 |
+ (:html |
|
268 |
+ (:head |
|
269 |
+ (:title "Login")) |
|
270 |
+ (:body |
|
271 |
+ (:div (:a :href "/login/facebook" "Facebook")) |
|
272 |
+ (:div (:a :href "/login/google" "Google")))))) |
|
273 |
+ |
|
244 | 274 |
(def-route "/" (params) |
245 | 275 |
(with-session (session) |
246 |
- (require-login |
|
247 |
- (anaphora:sunless (gethash :counter session) (setf anaphora:it 0)) |
|
248 |
- (format nil "~Ath visit<br/>~a<br/><br/>~S<br/>" |
|
249 |
- (gethash :counter session) |
|
250 |
- (alexandria:hash-table-alist session) |
|
251 |
- (alexandria:hash-table-alist (context :session)))))) |
|
252 |
- |
|
253 |
- |
|
276 |
+ (if (not (null (gethash :next-page session))) |
|
277 |
+ `(302 (:location ,(gethash :next-page session))) |
|
278 |
+ (require-login |
|
279 |
+ (anaphora:sunless (gethash :counter session) (setf anaphora:it 0)) |
|
280 |
+ (format nil "~Ath visit<br/>~a<br/><br/>~S<br/>" |
|
281 |
+ (gethash :counter session) |
|
282 |
+ (alexandria:hash-table-alist session) |
|
283 |
+ (alexandria:hash-table-alist (context :session))))))) |
|
254 | 284 |
|
255 | 285 |
(setf *handler* (clack:clackup (lack.builder:builder :session *app*) :port 9090)) |
256 | 286 |
|
... | ... |
@@ -7,7 +7,9 @@ |
7 | 7 |
(ql:quickload :anaphora) |
8 | 8 |
(ql:quickload :alexandria) |
9 | 9 |
(ql:quickload :lack-middleware-session) |
10 |
+(ql:quickload :cl-who) |
|
11 |
+(ql:quickload :sheeple) |
|
10 | 12 |
|
11 | 13 |
(defpackage :cl-oid-connect |
12 |
- (:use #:cl #:drakma #:ningle #:clack #:cljwt #:anaphora #:alexandria)) |
|
14 |
+ (:use #:cl #:drakma #:ningle #:clack #:cljwt #:anaphora #:alexandria #:sheeple)) |
|
13 | 15 |
|