Mercurial > openid
comparison src/ur/openid.ur @ 7:976121190b2d
Authentication verification almost working: signatures not computing correctly
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Tue, 28 Dec 2010 19:57:25 -0500 |
parents | 99496175078b |
children | 870d99055dd1 |
comparison
equal
deleted
inserted
replaced
6:99496175078b | 7:976121190b2d |
---|---|
32 | 32 |
33 datatype association = Association of {Handle : string, Key : string} | AssError of string | 33 datatype association = Association of {Handle : string, Key : string} | AssError of string |
34 | 34 |
35 fun association url = | 35 fun association url = |
36 secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key | 36 secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key |
37 FROM associations | 37 FROM associations |
38 WHERE associations.Endpoint = {[url]}); | 38 WHERE associations.Endpoint = {[url]}); |
39 case secret of | 39 case secret of |
40 Some r => return (Association r) | 40 Some r => return (Association r) |
41 | None => | 41 | None => |
42 is <- createInputs; | 42 is <- createInputs; |
43 OpenidFfi.addInput is "openid.mode" "associate"; | 43 OpenidFfi.addInput is "openid.mode" "associate"; |
44 OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256"; | 44 OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256"; |
45 OpenidFfi.addInput is "openid.session_type" "no-encryption"; | 45 OpenidFfi.addInput is "openid.session_type" "no-encryption"; |
46 | |
47 debug ("Contacting " ^ url); | |
46 | 48 |
47 os <- OpenidFfi.direct url is; | 49 os <- OpenidFfi.direct url is; |
48 case OpenidFfi.getOutput os "error" of | 50 case OpenidFfi.getOutput os "error" of |
49 Some v => return (AssError v) | 51 Some v => return (AssError v) |
50 | None => | 52 | None => |
55 | Some expires => | 57 | Some expires => |
56 tm <- now; | 58 tm <- now; |
57 dml (INSERT INTO associations (Endpoint, Handle, Key, Expires) | 59 dml (INSERT INTO associations (Endpoint, Handle, Key, Expires) |
58 VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]})); | 60 VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]})); |
59 return (Association {Handle = handle, Key = key})) | 61 return (Association {Handle = handle, Key = key})) |
62 | (None, _, _) => return (AssError "Missing assoc_handle") | |
63 | (_, None, _) => return (AssError "Missing mac_key") | |
60 | _ => return (AssError "Missing fields in response from OP") | 64 | _ => return (AssError "Missing fields in response from OP") |
61 | 65 |
62 fun eatFragment s = | 66 fun eatFragment s = |
63 case String.split s #"#" of | 67 case String.split s #"#" of |
64 Some (_, s') => s' | 68 Some (_, s') => s' |
65 | _ => s | 69 | _ => s |
66 | 70 |
67 datatype handle_result = HandleOk of string | HandleError of string | 71 datatype handle_result = HandleOk of {Endpoint : string, Key : string} | HandleError of string |
68 | 72 |
69 fun verifyHandle os id = | 73 fun verifyHandle os id = |
70 ep <- discover (eatFragment id); | 74 ep <- discover (eatFragment id); |
71 case ep of | 75 case ep of |
72 None => return (HandleError "Discovery failed on returned endpoint") | 76 None => return (HandleError "Discovery failed on returned endpoint") |
79 AssError s => return (HandleError s) | 83 AssError s => return (HandleError s) |
80 | Association assoc => | 84 | Association assoc => |
81 if assoc.Handle <> handle then | 85 if assoc.Handle <> handle then |
82 return (HandleError "Association handles don't match") | 86 return (HandleError "Association handles don't match") |
83 else | 87 else |
84 return (HandleOk ep) | 88 return (HandleOk {Endpoint = ep, Key = assoc.Key}) |
85 | 89 |
86 table nonces : { Endpoint : string, Nonce : string, Expires : time } | 90 table nonces : { Endpoint : string, Nonce : string, Expires : time } |
87 PRIMARY KEY (Endpoint, Nonce) | 91 PRIMARY KEY (Endpoint, Nonce) |
88 | 92 |
89 fun timeOfNonce s = | 93 fun timeOfNonce s = |
90 case String.split s #"T" of | 94 case String.split s #"T" of |
91 None => None | 95 None => None |
92 | Some (date, s) => | 96 | Some (date, s) => |
93 case String.split s #"Z" of | 97 case String.split s #"Z" of |
94 None => None | 98 None => None |
95 | Some (time, _) => read (date ^ " " ^ time) | 99 | Some (time, _) => readUtc (date ^ " " ^ time) |
96 | 100 |
97 fun verifyNonce os ep = | 101 fun verifyNonce os ep = |
98 case OpenidFfi.getOutput os "openid.response_nonce" of | 102 case OpenidFfi.getOutput os "openid.response_nonce" of |
99 None => return (Some "Missing nonce in OP response") | 103 None => return (Some "Missing nonce in OP response") |
100 | Some nonce => | 104 | Some nonce => |
112 AND nonces.Nonce = {[nonce]}); | 116 AND nonces.Nonce = {[nonce]}); |
113 | 117 |
114 if b then | 118 if b then |
115 return (Some "Duplicate nonce") | 119 return (Some "Duplicate nonce") |
116 else | 120 else |
121 debug ("Nonce expires: " ^ show exp); | |
117 dml (INSERT INTO nonces (Endpoint, Nonce, Expires) | 122 dml (INSERT INTO nonces (Endpoint, Nonce, Expires) |
118 VALUES ({[ep]}, {[nonce]}, {[exp]})); | 123 VALUES ({[ep]}, {[nonce]}, {[exp]})); |
119 return None | 124 return None |
120 | 125 |
121 fun verifySig os = | 126 fun verifySig os key = |
122 case OpenidFfi.getOutput os "openid.signed" of | 127 case OpenidFfi.getOutput os "openid.signed" of |
123 None => return (Some "Missing openid.signed in OP response") | 128 None => return (Some "Missing openid.signed in OP response") |
124 | Some signed => | 129 | Some signed => |
125 case OpenidFfi.getOutput os "openid.sig" of | 130 case OpenidFfi.getOutput os "openid.sig" of |
126 None => return (Some "Missing openid.sig in OP response") | 131 None => return (Some "Missing openid.sig in OP response") |
146 in | 151 in |
147 case gatherNvps signed "" of | 152 case gatherNvps signed "" of |
148 None => return (Some "openid.signed mentions missing field") | 153 None => return (Some "openid.signed mentions missing field") |
149 | Some nvps => | 154 | Some nvps => |
150 let | 155 let |
151 val sign' = OpenidFfi.sha256 nvps | 156 val sign' = OpenidFfi.sha256 key nvps |
152 in | 157 in |
153 debug ("Fields: " ^ signed); | 158 debug ("Fields: " ^ signed); |
154 debug ("Nvps: " ^ nvps); | 159 debug ("Nvps: " ^ nvps); |
160 debug ("Key: " ^ key); | |
155 debug ("His: " ^ sign); | 161 debug ("His: " ^ sign); |
156 debug ("Mine: " ^ sign'); | 162 debug ("Mine: " ^ sign'); |
157 if sign' = sign then | 163 if sign' = sign then |
158 return None | 164 return None |
159 else | 165 else |
179 None => error <xml>Missing identity in OP response</xml> | 185 None => error <xml>Missing identity in OP response</xml> |
180 | Some id => | 186 | Some id => |
181 errO <- verifyHandle os id; | 187 errO <- verifyHandle os id; |
182 case errO of | 188 case errO of |
183 HandleError s => error <xml>{[s]}</xml> | 189 HandleError s => error <xml>{[s]}</xml> |
184 | HandleOk ep => | 190 | HandleOk {Endpoint = ep, Key = key} => |
185 errO <- verifyReturnTo os; | 191 errO <- verifyReturnTo os; |
186 case errO of | 192 case errO of |
187 Some s => error <xml>{[s]}</xml> | 193 Some s => error <xml>{[s]}</xml> |
188 | None => | 194 | None => |
189 errO <- verifyNonce os ep; | 195 errO <- verifyNonce os ep; |
190 case errO of | 196 case errO of |
191 Some s => error <xml>{[s]}</xml> | 197 Some s => error <xml>{[s]}</xml> |
192 | None => | 198 | None => |
193 errO <- verifySig os; | 199 errO <- verifySig os key; |
194 case errO of | 200 case errO of |
195 Some s => error <xml>{[s]}</xml> | 201 Some s => error <xml>{[s]}</xml> |
196 | None => return <xml>Identity: {[id]}</xml>) | 202 | None => return <xml>Identity: {[id]}</xml>) |
197 | _ => error <xml>Unexpected <tt>openid.mode</tt>: <tt>{[mode]}</tt></xml> | 203 | _ => error <xml>Unexpected <tt>openid.mode</tt>: <tt>{[mode]}</tt></xml> |
198 | 204 |