blob: 10544763a4d33f2752851dc002bd9e242d672a41 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
(ns mulk.benki.id
(:refer-clojure)
(:use [clojure core repl pprint]
[hiccup core page]
[mulk.benki config util db]
[clojure.core.match
:only [match]]
[noir core]
[clojure.java.jdbc :only [transaction do-commands]])
(:require [noir.session :as session]
[noir.response :as response]
[noir.request :as request]
[clojure.java.jdbc :as sql]
[com.twinql.clojure.http :as http])
(:import [org.openid4java.server ServerManager]
[org.openid4java.message ParameterList AuthRequest DirectError]))
(defonce manager
(doto (ServerManager.)
(.setOPEndpointUrl (str (:base-uri @benki-config) "/openid"))))
(def profile-base-uris #{(str (:base-uri @benki-config) "/id/")
(str (:base-uri @benki-config) "/~")})
(defn nickname-user [nickname]
(with-dbt
(:user (query1 "SELECT \"user\" FROM user_nicknames WHERE nickname = ?" nickname))))
(defn user-owns-nickname? [user nickname]
(= (nickname-user nickname) user))
(defn fail-authentication []
{:status 403, :type "text/plain", :body "Not authorized."})
(defn nickname-from-profile-uri [uri]
(some (fn [profile-base-uri]
(let [base-uri (.substring uri 0 (.length profile-base-uri))
nickname (.substring uri (.length profile-base-uri))]
(if (= base-uri profile-base-uri)
nickname
nil)))
profile-base-uris))
(defn format-openid-response [s]
{:status 200, :type "text/plain", :body s})
(defn verify-openid [paramlist]
(let [auth-request (AuthRequest/createAuthRequest paramlist (.getRealmVerifier manager))
claimed-id (or (.getClaimed auth-request)
(get (:query-params (request/ring-request)) "openid.identity"))
nickname (nickname-from-profile-uri claimed-id)
okay? (and *user* (user-owns-nickname? *user* nickname))
response (.authResponse manager paramlist nil claimed-id (boolean okay?) false)]
(if (isa? (class response) DirectError)
(fail-authentication)
(do
(.sign manager response)
(redirect (.getDestinationUrl response true))))))
(defn stringify-keys [m]
(into {} (map (fn [[k v]] [(name k) v]) m)))
(defn process-openid-request []
(let [query (:params (request/ring-request))
paramlist (ParameterList. (stringify-keys query))
mode (query "openid.mode")]
(match [mode]
["associate"]
(format-openid-response
(.keyValueFormEncoding (.associationRequest manager paramlist)))
["check_authentication"]
(format-openid-response
(.keyValueFormEncoding (.verify manager paramlist)))
["checkid_setup"]
(with-auth
(verify-openid paramlist))
["checkid_immediate"]
(verify-openid paramlist)
[x]
{:status 200, :headers {"Content-Type" "text/plain; charset=utf-8"}, :body (str "Whaaaat? What is “" x "” supposed to mean?? This is what you sent:" (request/ring-request)
)})))
(def profile-page {})
(defn find-user [uid]
(query1 "SELECT first_name, last_name FROM users WHERE id = ?" uid))
(defn show-profile-page [uid]
(with-dbt
(layout profile-page "A Profile Page"
[:div {:about "" :typeof "foaf:Person"}
[:div {:property "foaf:name"}
(:first_name (find-user uid)) " " (:last_name (find-user uid))]
[:div {:style "display: none"}
[:span {:property "foaf:givenName"}
(:first_name (find-user uid))]
[:span {:property "foaf:familyName"}
(:last_name (find-user uid))]]
[:h2 "Public Keys"]
(sql/with-query-results keys ["SELECT * FROM user_rsa_keys WHERE \"user\" = ?" uid]
(doall
(for [{modulus :modulus,
exponent :exponent}
keys]
(list
[:div {:rel "cert:key"}
[:div {:typeof "cert:RSAPublicKey"}
[:dl
[:dt "Modulus (hex)"]
[:dd {:property "cert:modulus"
:datatype "xsd:hexBinary"}
(fmt nil "~X" modulus)]
[:dt "Exponent"]
[:dd {:property "cert:exponent"
:datatype "xsd:integer"}
(fmt nil "~D" exponent)]]]]))))])))
(defn render-xrds [nickname]
{:status 200
:headers {"Content-Type" "application/xrds+xml; charset=UTF-8"}
:body
(clojure.string/replace
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<xrds:XRDS xmlns:xrds=\"xri://$xrds\" xmlns=\"xri://$xrd*($v*2.0)\">
<XRD>
<Service>
<Type>http://openid.net/signon/1.0</Type>
<URI>{base-uri}/openid/api</URI>
</Service>
</XRD>
</xrds:XRDS>"
"{base-uri}"
(:base-uri @benki-config))})
(defpage [:get "/openid/api"] {}
(process-openid-request))
(defpage [:post "/openid/api"] {}
(process-openid-request))
(defn render-profile-page [nickname]
(let [accept (get-in (request/ring-request) [:headers "accept"])]
(if (and accept
(re-find #"application/xrds\+xml"
(get-in (request/ring-request) [:headers "accept"])))
(render-xrds nickname)
(show-profile-page (nickname-user nickname)))))
(defpage [:get "/id/:nickname"] {nickname :nickname}
(render-profile-page nickname))
(defpage [:get "/~:nickname"] {nickname :nickname}
(render-profile-page nickname))
|
