Mercurial > openid

comparison src/ur/openid.ur @ 7:976121190b2d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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