demo-app: use userid instead of username as keys into hashtables

pass challenge as output of Webauthn instead of input (to support multiple challenges)
This commit is contained in:
Robur 2021-10-05 13:09:35 +00:00
parent ddebe8b804
commit 8bf98cf42b
3 changed files with 122 additions and 90 deletions

View file

@ -30,12 +30,12 @@ let overview notes authenticated_as users =
and users = and users =
String.concat "" String.concat ""
("<h2>Users</h2><ul>" :: ("<h2>Users</h2><ul>" ::
Hashtbl.fold (fun name keys acc -> Hashtbl.fold (fun id (name, keys) acc ->
let credentials = List.map (fun (_, cid, _) -> let credentials = List.map (fun (_, cid, _) ->
Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet cid) Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet cid)
keys keys
in in
(Printf.sprintf "<li>%s [<a href=/authenticate/%s>authenticate</a>] (%s)</li>" name name (String.concat ", " credentials)) :: acc) (Printf.sprintf "<li>%s [<a href=/authenticate/%s>authenticate</a>] (%s)</li>" name id (String.concat ", " credentials)) :: acc)
users [] @ [ "</ul>" ]) users [] @ [ "</ul>" ])
in in
page "" (String.concat "" (notes @ [authenticated_as;links;users])) page "" (String.concat "" (notes @ [authenticated_as;links;users]))
@ -92,7 +92,7 @@ let register_view origin user =
let headers = {'Content-type': "application/json; charset=utf-8"}; let headers = {'Content-type': "application/json; charset=utf-8"};
let request = new Request('/register_finish/'+username, { method: 'POST', body: body, headers: headers } ); let request = new Request('/register_finish/'+challengeData.user.id, { method: 'POST', body: body, headers: headers } );
fetch(request) fetch(request)
.then(function (response) { .then(function (response) {
if (!response.ok && response.status != 403) { if (!response.ok && response.status != 403) {
@ -106,6 +106,7 @@ let register_view origin user =
}); });
}).catch(function (err) { }).catch(function (err) {
alert("exception: " + err); alert("exception: " + err);
window.location = "/";
}); });
}); });
} }
@ -177,6 +178,7 @@ let authenticate_view challenge credentials user =
}); });
}).catch(function (err) { }).catch(function (err) {
alert("exception: " + err); alert("exception: " + err);
window.location = "/";
}); });
|} challenge |} challenge
(Yojson.to_string (`List (Yojson.to_string (`List

View file

@ -1,6 +1,11 @@
open Lwt.Infix open Lwt.Infix
let users : (string, (Mirage_crypto_ec.P256.Dsa.pub * string * X509.Certificate.t option) list) Hashtbl.t = Hashtbl.create 7 let users : (string, string * (Mirage_crypto_ec.P256.Dsa.pub * string * X509.Certificate.t option) list) Hashtbl.t = Hashtbl.create 7
let find_username username =
Hashtbl.fold (fun id v r ->
if String.equal (fst v) username then Some (id, v) else r)
users None
module KhPubHashtbl = Hashtbl.Make(struct module KhPubHashtbl = Hashtbl.Make(struct
type t = Webauthn.key_handle * Mirage_crypto_ec.P256.Dsa.pub type t = Webauthn.key_handle * Mirage_crypto_ec.P256.Dsa.pub
@ -22,9 +27,29 @@ let check_counter kh_pub counter =
then KhPubHashtbl.replace counters kh_pub counter; then KhPubHashtbl.replace counters kh_pub counter;
r r
let registration_challenges : (string, string) Hashtbl.t = Hashtbl.create 7 let registration_challenges : (string, string * string list) Hashtbl.t = Hashtbl.create 7
let authentication_challenges : (string, string) Hashtbl.t = Hashtbl.create 7 let remove_registration_challenge userid challenge =
match Hashtbl.find_opt registration_challenges userid with
| None -> ()
| Some (username, challenges) ->
let challenges = List.filter (fun c -> not (String.equal c challenge)) challenges in
if challenges = [] then
Hashtbl.remove registration_challenges userid
else
Hashtbl.replace registration_challenges userid (username, challenges)
let authentication_challenges : (string, string list) Hashtbl.t = Hashtbl.create 7
let remove_authentication_challenge userid challenge =
match Hashtbl.find_opt authentication_challenges userid with
| None -> ()
| Some challenges ->
let challenges = List.filter (fun c -> not (String.equal c challenge)) challenges in
if challenges = [] then
Hashtbl.remove authentication_challenges userid
else
Hashtbl.replace authentication_challenges userid challenges
let to_string err = Format.asprintf "%a" Webauthn.pp_error err let to_string err = Format.asprintf "%a" Webauthn.pp_error err
@ -50,14 +75,16 @@ let add_routes t =
let registration_challenge req = let registration_challenge req =
let user = Dream.param "user" req in let user = Dream.param "user" req in
let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in
(* [userid] should be a random value *) let userid, credentials = match find_username user with
and userid = Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet user in | None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, []
Hashtbl.replace registration_challenges user challenge; | Some (userid, (_, credentials)) -> userid, List.map (fun (_, cid, _) -> cid) credentials
let credentials = match Hashtbl.find_opt users user with
| None -> []
| Some credentials -> List.map (fun (_, cid, _) -> cid) credentials
in in
let challenges =
Option.map snd (Hashtbl.find_opt registration_challenges userid) |>
Option.value ~default:[]
in
Hashtbl.replace registration_challenges userid (user, challenge :: challenges);
let challenge_b64 = (Base64.encode_string challenge) in let challenge_b64 = (Base64.encode_string challenge) in
let json = `Assoc [ let json = `Assoc [
"challenge", `String challenge_b64 ; "challenge", `String challenge_b64 ;
@ -74,95 +101,107 @@ let add_routes t =
in in
let register_finish req = let register_finish req =
let user = Dream.param "user" req in let userid = Dream.param "userid" req in
Dream.body req >>= fun body -> Dream.body req >>= fun body ->
Logs.info (fun m -> m "received body: %s" body); Logs.debug (fun m -> m "received body: %s" body);
match Hashtbl.find_opt registration_challenges user with match Hashtbl.find_opt registration_challenges userid with
| None -> | None ->
Logs.warn (fun m -> m "no challenge found"); Logs.warn (fun m -> m "no challenge found");
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some challenge -> | Some (username, challenges) ->
Hashtbl.remove registration_challenges user; match Webauthn.register_response t body with
match Webauthn.register_response t challenge body with
| Error e -> | Error e ->
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
let err = to_string e in let err = to_string e in
Flash_message.put_flash "" ("Registration failed " ^ err) req; Flash_message.put_flash "" ("Registration failed " ^ err) req;
Dream.json "false" Dream.json "false"
| Ok (_aaguid, credential_id, pubkey, _client_extensions, user_present, | Ok (challenge, _aaguid, credential_id, pubkey, _client_extensions, user_present,
user_verified, sig_count, _authenticator_extensions, attestation_cert) -> user_verified, sig_count, _authenticator_extensions, attestation_cert) ->
if not (List.mem challenge challenges) then begin
Logs.warn (fun m -> m "challenge invalid");
Flash_message.put_flash "" "Registration failed: invalid challenge" req;
Dream.json "false"
end else begin
remove_registration_challenge userid challenge;
ignore (check_counter (credential_id, pubkey) sig_count); ignore (check_counter (credential_id, pubkey) sig_count);
Logs.info (fun m -> m "user present %B user verified %B" user_present user_verified); Logs.info (fun m -> m "user present %B user verified %B" user_present user_verified);
Logs.app (fun m -> m "challenge for user %S" user); Logs.app (fun m -> m "challenge for user %S" username);
match Dream.session "authenticated_as" req, Hashtbl.find_opt users user with match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with
| _, None -> | _, None ->
Logs.app (fun m -> m "registered %s: %S" user credential_id); Logs.app (fun m -> m "registered %s: %S" username credential_id);
Hashtbl.replace users user [ (pubkey, credential_id, attestation_cert) ]; Hashtbl.replace users userid (username, [ (pubkey, credential_id, attestation_cert) ]);
Dream.invalidate_session req >>= fun () -> Dream.invalidate_session req >>= fun () ->
Flash_message.put_flash "" Flash_message.put_flash ""
(Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" user user) (Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" username userid)
req; req;
Dream.json "true" Dream.json "true"
| Some session_user, Some keys -> | Some session_user, Some (username', keys) ->
Logs.app (fun m -> m "user %S session_user %S" user session_user); Logs.app (fun m -> m "user %S session_user %S" username session_user);
if String.equal user session_user then begin if String.equal username session_user && String.equal username username' then begin
Logs.app (fun m -> m "registered %s: %S" user credential_id); Logs.app (fun m -> m "registered %s: %S" username credential_id);
Hashtbl.replace users user ((pubkey, credential_id, attestation_cert) :: keys) ; Hashtbl.replace users userid (username, ((pubkey, credential_id, attestation_cert) :: keys)) ;
Dream.invalidate_session req >>= fun () -> Dream.invalidate_session req >>= fun () ->
Flash_message.put_flash "" Flash_message.put_flash ""
(Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" user user) (Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" username userid)
req; req;
Dream.json "true" Dream.json "true"
end else end else
(Logs.info (fun m -> m "session_user %s, user %s" session_user user); (Logs.info (fun m -> m "session_user %s, user %s (user in users table %s)" session_user username username');
Dream.json ~status:`Forbidden "false") Dream.json ~status:`Forbidden "false")
| None, Some _keys -> | None, Some _keys ->
Logs.app (fun m -> m "no session user"); Logs.app (fun m -> m "no session user");
Dream.json ~status:`Forbidden "false" Dream.json ~status:`Forbidden "false"
end
in in
let authenticate req = let authenticate req =
let user = Dream.param "user" req in let userid = Dream.param "userid" req in
match Hashtbl.find_opt users user with match Hashtbl.find_opt users userid with
| None -> | None ->
Logs.warn (fun m -> m "no user found"); Logs.warn (fun m -> m "no user found");
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some keys -> | Some (username, keys) ->
let credentials = List.map (fun (_, c, _) -> Base64.encode_string c) keys in let credentials = List.map (fun (_, c, _) -> Base64.encode_string c) keys in
let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in
Hashtbl.replace authentication_challenges user challenge; let challenges = Option.value ~default:[] (Hashtbl.find_opt authentication_challenges userid) in
Dream.html (Template.authenticate_view (Base64.encode_string challenge) credentials user) Hashtbl.replace authentication_challenges userid (challenge :: challenges);
Dream.html (Template.authenticate_view (Base64.encode_string challenge) credentials username)
in in
let authenticate_finish req = let authenticate_finish req =
let user = Dream.param "user" req in let userid = Dream.param "userid" req in
Dream.body req >>= fun body -> Dream.body req >>= fun body ->
Logs.info (fun m -> m "received body: %s" body); Logs.debug (fun m -> m "received body: %s" body);
match Hashtbl.find_opt authentication_challenges user with match Hashtbl.find_opt authentication_challenges userid with
| None -> Dream.respond ~status:`Internal_Server_Error "Internal server error." | None -> Dream.respond ~status:`Internal_Server_Error "Internal server error."
| Some challenge -> | Some challenges ->
Hashtbl.remove authentication_challenges user; match Hashtbl.find_opt users userid with
match Hashtbl.find_opt users user with
| None -> | None ->
Logs.warn (fun m -> m "no user found, using empty"); Logs.warn (fun m -> m "no user found with id %s" userid);
Dream.respond ~status:`Bad_Request "Bad request." Dream.respond ~status:`Bad_Request "Bad request."
| Some keys -> | Some (username, keys) ->
let cid_keys = List.map (fun (key, credential_id, _) -> credential_id, key) keys in let cid_keys = List.map (fun (key, credential_id, _) -> credential_id, key) keys in
match Webauthn.authentication_response t cid_keys challenge body with match Webauthn.authentication_response t cid_keys body with
| Ok (credential, _client_extensions, _user_present, _user_verified, counter, _authenticator_extensions) -> | Ok (challenge, credential, _client_extensions, _user_present, _user_verified, counter, _authenticator_extensions) ->
if not (List.mem challenge challenges) then begin
Logs.warn (fun m -> m "invalid challenge");
Flash_message.put_flash "" "Authentication failure: invalid challenge" req;
Dream.json "false"
end else begin
remove_authentication_challenge userid challenge;
if check_counter credential counter if check_counter credential counter
then begin then begin
Flash_message.put_flash "" "Successfully authenticated" req; Flash_message.put_flash "" "Successfully authenticated" req;
Dream.put_session "user" user req >>= fun () -> Dream.put_session "authenticated_as" username req >>= fun () ->
Dream.put_session "authenticated_as" user req >>= fun () ->
Dream.json "true" Dream.json "true"
end else begin end else begin
Logs.warn (fun m -> m "credential %S for user %S: counter not strictly increasing! \ Logs.warn (fun m -> m "credential %S for user %S: counter not strictly increasing! \
Got %ld, expected >%ld. webauthn device compromised?" Got %ld, expected >%ld. webauthn device compromised?"
(fst credential) user counter (KhPubHashtbl.find counters credential)); (fst credential) username counter (KhPubHashtbl.find counters credential));
Flash_message.put_flash "" "Authentication failure: key compromised?" req; Flash_message.put_flash "" "Authentication failure: key compromised?" req;
Dream.json "false" Dream.json "false"
end end
end
| Error e -> | Error e ->
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e); Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
let err = to_string e in let err = to_string e in
@ -184,9 +223,9 @@ let add_routes t =
Dream.get "/" main; Dream.get "/" main;
Dream.get "/register" register; Dream.get "/register" register;
Dream.get "/registration-challenge/:user" registration_challenge; Dream.get "/registration-challenge/:user" registration_challenge;
Dream.post "/register_finish/:user" register_finish; Dream.post "/register_finish/:userid" register_finish;
Dream.get "/authenticate/:user" authenticate; Dream.get "/authenticate/:userid" authenticate;
Dream.post "/authenticate_finish/:user" authenticate_finish; Dream.post "/authenticate_finish/:userid" authenticate_finish;
Dream.post "/logout" logout; Dream.post "/logout" logout;
Dream.get "/static/base64.js" base64; Dream.get "/static/base64.js" base64;
] ]

View file

@ -3,7 +3,6 @@ type key_handle = string
type error = [ type error = [
| `Json_decoding of string * string * string | `Json_decoding of string * string * string
| `Base64_decoding of string * string * string | `Base64_decoding of string * string * string
| `Challenge_mismatch of string * string
| `Client_data_type_mismatch of string | `Client_data_type_mismatch of string
| `Origin_mismatch of string * string | `Origin_mismatch of string * string
| `Attestation_object of string | `Attestation_object of string
@ -17,8 +16,6 @@ let pp_error ppf = function
Fmt.pf ppf "json decoding error in %s: %s (json: %s)" ctx msg json Fmt.pf ppf "json decoding error in %s: %s (json: %s)" ctx msg json
| `Base64_decoding (ctx, msg, json) -> | `Base64_decoding (ctx, msg, json) ->
Fmt.pf ppf "base64 decoding error in %s: %s (json: %s)" ctx msg json Fmt.pf ppf "base64 decoding error in %s: %s (json: %s)" ctx msg json
| `Challenge_mismatch (should, is) ->
Fmt.pf ppf "challenge mismatch: expected %s, received %s" should is
| `Client_data_type_mismatch is -> | `Client_data_type_mismatch is ->
Fmt.pf ppf "client data type mismatch: received %s" is Fmt.pf ppf "client data type mismatch: received %s" is
| `Origin_mismatch (should, is) -> | `Origin_mismatch (should, is) ->
@ -36,8 +33,6 @@ type t = {
type challenge = string type challenge = string
let reynir = {|{"id":"dpI-yUZhgjMkU3jOmFMkwKx1nDRRruT8W647kk5FY-UO3qmlCsctLqtn7D369ovpj1Ki-0bFcfWY0xJTb0ZV3Q","rawId":"dpI-yUZhgjMkU3jOmFMkwKx1nDRRruT8W647kk5FY-UO3qmlCsctLqtn7D369ovpj1Ki-0bFcfWY0xJTb0ZV3Q","type":"public-key","response":{"attestationObject":"o2NmbXRkbm9uZWdhdHRTdG10oGhhdXRoRGF0YVjEVKwkUFODts743j3E4-Pod_krx_x1yPj5MkxzdU0D1ABBAAAAAAAAAAAAAAAAAAAAAAAAAAAAQHaSPslGYYIzJFN4zphTJMCsdZw0Ua7k_FuuO5JORWPlDt6ppQrHLS6rZ-w9-vaL6Y9SovtGxXH1mNMSU29GVd2lAQIDJiABIVgg9W7_s-sr8SP-S6rTbCAtCSeocIY2SYqAFB-WE2S5OnUiWCBWteq4vgVJYTyplxTWiGZePPPREadDxNuYOn5kZFawVQ","clientDataJSON":"eyJjaGFsbGVuZ2UiOiJPaEhCZldGN2RLcjN0VVBfTmZSUzRnIiwiY2xpZW50RXh0ZW5zaW9ucyI6e30sImhhc2hBbGdvcml0aG0iOiJTSEEtMjU2Iiwib3JpZ2luIjoiaHR0cHM6Ly93ZWJhdXRobi1kZW1vLnJvYnVyLmNvb3AiLCJ0eXBlIjoid2ViYXV0aG4uY3JlYXRlIn0"}}|}
let b64_enc = Base64.(encode_string ~pad:false ~alphabet:uri_safe_alphabet) let b64_enc = Base64.(encode_string ~pad:false ~alphabet:uri_safe_alphabet)
let lift_err f = function Ok _ as a -> a | Error x -> Error (f x) let lift_err f = function Ok _ as a -> a | Error x -> Error (f x)
@ -231,7 +226,7 @@ let rpid t =
| [ _protocol ; "" ; host ] -> host | [ _protocol ; "" ; host ] -> host
| _ -> assert false | _ -> assert false
let register_response t challenge data = let register_response t data =
of_json "response" public_key_credential_raw_of_yojson data >>= fun credential -> of_json "response" public_key_credential_raw_of_yojson data >>= fun credential ->
(* XXX: credential.getClientExtensionResults() *) (* XXX: credential.getClientExtensionResults() *)
let response = credential.response in let response = credential.response in
@ -245,10 +240,8 @@ let register_response t challenge data =
(function (function
| "webauthn.create" -> Ok () | "webauthn.create" -> Ok ()
| wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () -> | wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () ->
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge' -> json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge ->
b64_dec "response.ClientDataJSON.challenge" challenge' >>= fun challenge' -> b64_dec "response.ClientDataJSON.challenge" challenge >>= fun challenge ->
guard (String.equal challenge challenge')
(`Challenge_mismatch (challenge, challenge')) >>= fun () ->
json_get "origin" client_data >>= json_string "origin" >>= fun origin -> json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
guard (String.equal t.origin origin) guard (String.equal t.origin origin)
(`Origin_mismatch (t.origin, origin)) >>= fun () -> (`Origin_mismatch (t.origin, origin)) >>= fun () ->
@ -276,7 +269,7 @@ let register_response t challenge data =
end >>= fun cert -> end >>= fun cert ->
(* check attestation cert, maybe *) (* check attestation cert, maybe *)
(* check auth_data.attested_credential_data.credential_id is not registered ? *) (* check auth_data.attested_credential_data.credential_id is not registered ? *)
Ok (aaguid, Cstruct.to_string credential_id, pubkey, client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data, cert) Ok (challenge, aaguid, Cstruct.to_string credential_id, pubkey, client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data, cert)
type auth_response_raw = { type auth_response_raw = {
authenticator_data : base64url_string [@key "authenticatorData"]; authenticator_data : base64url_string [@key "authenticatorData"];
@ -292,7 +285,7 @@ type auth_assertion_raw = {
response : auth_response_raw; response : auth_response_raw;
} [@@deriving of_yojson] } [@@deriving of_yojson]
let authentication_response t cid_keys challenge data = let authentication_response t cid_keys data =
of_json "response" auth_assertion_raw_of_yojson data >>= fun assertion -> of_json "response" auth_assertion_raw_of_yojson data >>= fun assertion ->
let response = assertion.response in let response = assertion.response in
let client_data_hash = Mirage_crypto.Hash.SHA256.digest let client_data_hash = Mirage_crypto.Hash.SHA256.digest
@ -305,10 +298,8 @@ let authentication_response t cid_keys challenge data =
(function (function
| "webauthn.get" -> Ok () | "webauthn.get" -> Ok ()
| wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () -> | wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () ->
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge' -> json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge ->
b64_dec "response.ClientDataJSON.challenge" challenge' >>= fun challenge' -> b64_dec "response.ClientDataJSON.challenge" challenge >>= fun challenge ->
guard (String.equal challenge challenge')
(`Challenge_mismatch (challenge, challenge')) >>= fun () ->
json_get "origin" client_data >>= json_string "origin" >>= fun origin -> json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
guard (String.equal t.origin origin) guard (String.equal t.origin origin)
(`Origin_mismatch (t.origin, origin)) >>= fun () -> (`Origin_mismatch (t.origin, origin)) >>= fun () ->
@ -324,4 +315,4 @@ let authentication_response t cid_keys challenge data =
and signature = Cstruct.of_string response.signature and signature = Cstruct.of_string response.signature
in in
X509.Public_key.verify `SHA256 ~signature (`P256 pubkey) (`Message sigdata) >>= fun () -> X509.Public_key.verify `SHA256 ~signature (`P256 pubkey) (`Message sigdata) >>= fun () ->
Ok ((assertion.raw_id, pubkey), client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data) Ok (challenge, (assertion.raw_id, pubkey), client_extensions, auth_data.user_present, auth_data.user_verified, auth_data.sign_count, auth_data.extension_data)