blob: efff197f0f41da8d5d9d331391c36a8cf3ac3d6d (
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
|
(ns mulk.benki.id
(:refer-clojure)
(:use [clojure core repl pprint]
[hiccup core page-helpers]
[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-uri (str (:base-uri @benki-config) "/id/"))
(defn user-owns-nickname? [user nickname]
(with-dbt
(sql/with-query-results results
["SELECT 't' FROM user_nicknames WHERE nickname = ? AND \"user\" = ?"
nickname *user*]
(doall (seq results)))))
(defn fail-authentication []
{:status 403, :type "text/plain", :body "Not authorized."})
(defn nickname-from-profile-uri [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)))
(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 show-profile-page []
(layout profile-page "A Profile Page"
[:p "This is a profile page."]))
(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))
(defpage [:get "/id/:nickname"] {nickname :nickname}
(if (re-find #"application/xrds\+xml"
(get-in (request/ring-request) [:headers "accept"]))
(render-xrds nickname)
(show-profile-page)))
|