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
parent
ddebe8b804
commit
8bf98cf42b
3 changed files with 122 additions and 90 deletions
|
|
@ -30,12 +30,12 @@ let overview notes authenticated_as users =
|
|||
and users =
|
||||
String.concat ""
|
||||
("<h2>Users</h2><ul>" ::
|
||||
Hashtbl.fold (fun name keys acc ->
|
||||
Hashtbl.fold (fun id (name, keys) acc ->
|
||||
let credentials = List.map (fun (_, cid, _) ->
|
||||
Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet cid)
|
||||
keys
|
||||
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>" ])
|
||||
in
|
||||
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 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)
|
||||
.then(function (response) {
|
||||
if (!response.ok && response.status != 403) {
|
||||
|
|
@ -106,6 +106,7 @@ let register_view origin user =
|
|||
});
|
||||
}).catch(function (err) {
|
||||
alert("exception: " + err);
|
||||
window.location = "/";
|
||||
});
|
||||
});
|
||||
}
|
||||
|
|
@ -177,6 +178,7 @@ let authenticate_view challenge credentials user =
|
|||
});
|
||||
}).catch(function (err) {
|
||||
alert("exception: " + err);
|
||||
window.location = "/";
|
||||
});
|
||||
|} challenge
|
||||
(Yojson.to_string (`List
|
||||
|
|
|
|||
|
|
@ -1,6 +1,11 @@
|
|||
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
|
||||
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;
|
||||
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
|
||||
|
||||
|
|
@ -50,14 +75,16 @@ let add_routes t =
|
|||
|
||||
let registration_challenge req =
|
||||
let user = Dream.param "user" req in
|
||||
let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16)
|
||||
(* [userid] should be a random value *)
|
||||
and userid = Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet user in
|
||||
Hashtbl.replace registration_challenges user challenge;
|
||||
let credentials = match Hashtbl.find_opt users user with
|
||||
| None -> []
|
||||
| Some credentials -> List.map (fun (_, cid, _) -> cid) credentials
|
||||
let challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in
|
||||
let userid, credentials = match find_username user with
|
||||
| None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, []
|
||||
| Some (userid, (_, credentials)) -> userid, List.map (fun (_, cid, _) -> cid) credentials
|
||||
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 json = `Assoc [
|
||||
"challenge", `String challenge_b64 ;
|
||||
|
|
@ -74,95 +101,107 @@ let add_routes t =
|
|||
in
|
||||
|
||||
let register_finish req =
|
||||
let user = Dream.param "user" req in
|
||||
let userid = Dream.param "userid" req in
|
||||
Dream.body req >>= fun body ->
|
||||
Logs.info (fun m -> m "received body: %s" body);
|
||||
match Hashtbl.find_opt registration_challenges user with
|
||||
Logs.debug (fun m -> m "received body: %s" body);
|
||||
match Hashtbl.find_opt registration_challenges userid with
|
||||
| None ->
|
||||
Logs.warn (fun m -> m "no challenge found");
|
||||
Dream.respond ~status:`Bad_Request "Bad request."
|
||||
| Some challenge ->
|
||||
Hashtbl.remove registration_challenges user;
|
||||
match Webauthn.register_response t challenge body with
|
||||
| Some (username, challenges) ->
|
||||
match Webauthn.register_response t body with
|
||||
| Error e ->
|
||||
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
|
||||
let err = to_string e in
|
||||
Flash_message.put_flash "" ("Registration failed " ^ err) req;
|
||||
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) ->
|
||||
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);
|
||||
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);
|
||||
match Dream.session "authenticated_as" req, Hashtbl.find_opt users user with
|
||||
Logs.app (fun m -> m "challenge for user %S" username);
|
||||
match Dream.session "authenticated_as" req, Hashtbl.find_opt users userid with
|
||||
| _, None ->
|
||||
Logs.app (fun m -> m "registered %s: %S" user credential_id);
|
||||
Hashtbl.replace users user [ (pubkey, credential_id, attestation_cert) ];
|
||||
Logs.app (fun m -> m "registered %s: %S" username credential_id);
|
||||
Hashtbl.replace users userid (username, [ (pubkey, credential_id, attestation_cert) ]);
|
||||
Dream.invalidate_session req >>= fun () ->
|
||||
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;
|
||||
Dream.json "true"
|
||||
| Some session_user, Some keys ->
|
||||
Logs.app (fun m -> m "user %S session_user %S" user session_user);
|
||||
if String.equal user session_user then begin
|
||||
Logs.app (fun m -> m "registered %s: %S" user credential_id);
|
||||
Hashtbl.replace users user ((pubkey, credential_id, attestation_cert) :: keys) ;
|
||||
| Some session_user, Some (username', keys) ->
|
||||
Logs.app (fun m -> m "user %S session_user %S" username session_user);
|
||||
if String.equal username session_user && String.equal username username' then begin
|
||||
Logs.app (fun m -> m "registered %s: %S" username credential_id);
|
||||
Hashtbl.replace users userid (username, ((pubkey, credential_id, attestation_cert) :: keys)) ;
|
||||
Dream.invalidate_session req >>= fun () ->
|
||||
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;
|
||||
Dream.json "true"
|
||||
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")
|
||||
| None, Some _keys ->
|
||||
Logs.app (fun m -> m "no session user");
|
||||
Dream.json ~status:`Forbidden "false"
|
||||
end
|
||||
in
|
||||
|
||||
let authenticate req =
|
||||
let user = Dream.param "user" req in
|
||||
match Hashtbl.find_opt users user with
|
||||
let userid = Dream.param "userid" req in
|
||||
match Hashtbl.find_opt users userid with
|
||||
| None ->
|
||||
Logs.warn (fun m -> m "no user found");
|
||||
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 challenge = Cstruct.to_string (Mirage_crypto_rng.generate 16) in
|
||||
Hashtbl.replace authentication_challenges user challenge;
|
||||
Dream.html (Template.authenticate_view (Base64.encode_string challenge) credentials user)
|
||||
let challenges = Option.value ~default:[] (Hashtbl.find_opt authentication_challenges userid) in
|
||||
Hashtbl.replace authentication_challenges userid (challenge :: challenges);
|
||||
Dream.html (Template.authenticate_view (Base64.encode_string challenge) credentials username)
|
||||
in
|
||||
|
||||
let authenticate_finish req =
|
||||
let user = Dream.param "user" req in
|
||||
let userid = Dream.param "userid" req in
|
||||
Dream.body req >>= fun body ->
|
||||
Logs.info (fun m -> m "received body: %s" body);
|
||||
match Hashtbl.find_opt authentication_challenges user with
|
||||
Logs.debug (fun m -> m "received body: %s" body);
|
||||
match Hashtbl.find_opt authentication_challenges userid with
|
||||
| None -> Dream.respond ~status:`Internal_Server_Error "Internal server error."
|
||||
| Some challenge ->
|
||||
Hashtbl.remove authentication_challenges user;
|
||||
match Hashtbl.find_opt users user with
|
||||
| Some challenges ->
|
||||
match Hashtbl.find_opt users userid with
|
||||
| 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."
|
||||
| Some keys ->
|
||||
| Some (username, keys) ->
|
||||
let cid_keys = List.map (fun (key, credential_id, _) -> credential_id, key) keys in
|
||||
match Webauthn.authentication_response t cid_keys challenge body with
|
||||
| Ok (credential, _client_extensions, _user_present, _user_verified, counter, _authenticator_extensions) ->
|
||||
match Webauthn.authentication_response t cid_keys body with
|
||||
| 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
|
||||
then begin
|
||||
Flash_message.put_flash "" "Successfully authenticated" req;
|
||||
Dream.put_session "user" user req >>= fun () ->
|
||||
Dream.put_session "authenticated_as" user req >>= fun () ->
|
||||
Dream.put_session "authenticated_as" username req >>= fun () ->
|
||||
Dream.json "true"
|
||||
end else begin
|
||||
Logs.warn (fun m -> m "credential %S for user %S: counter not strictly increasing! \
|
||||
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;
|
||||
Dream.json "false"
|
||||
end
|
||||
end
|
||||
| Error e ->
|
||||
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
|
||||
let err = to_string e in
|
||||
|
|
@ -184,9 +223,9 @@ let add_routes t =
|
|||
Dream.get "/" main;
|
||||
Dream.get "/register" register;
|
||||
Dream.get "/registration-challenge/:user" registration_challenge;
|
||||
Dream.post "/register_finish/:user" register_finish;
|
||||
Dream.get "/authenticate/:user" authenticate;
|
||||
Dream.post "/authenticate_finish/:user" authenticate_finish;
|
||||
Dream.post "/register_finish/:userid" register_finish;
|
||||
Dream.get "/authenticate/:userid" authenticate;
|
||||
Dream.post "/authenticate_finish/:userid" authenticate_finish;
|
||||
Dream.post "/logout" logout;
|
||||
Dream.get "/static/base64.js" base64;
|
||||
]
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@ type key_handle = string
|
|||
type error = [
|
||||
| `Json_decoding of string * string * string
|
||||
| `Base64_decoding of string * string * string
|
||||
| `Challenge_mismatch of string * string
|
||||
| `Client_data_type_mismatch of string
|
||||
| `Origin_mismatch of string * 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
|
||||
| `Base64_decoding (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 ->
|
||||
Fmt.pf ppf "client data type mismatch: received %s" is
|
||||
| `Origin_mismatch (should, is) ->
|
||||
|
|
@ -36,8 +33,6 @@ type t = {
|
|||
|
||||
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 lift_err f = function Ok _ as a -> a | Error x -> Error (f x)
|
||||
|
|
@ -231,7 +226,7 @@ let rpid t =
|
|||
| [ _protocol ; "" ; host ] -> host
|
||||
| _ -> 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 ->
|
||||
(* XXX: credential.getClientExtensionResults() *)
|
||||
let response = credential.response in
|
||||
|
|
@ -245,10 +240,8 @@ let register_response t challenge data =
|
|||
(function
|
||||
| "webauthn.create" -> Ok ()
|
||||
| wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () ->
|
||||
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge' ->
|
||||
b64_dec "response.ClientDataJSON.challenge" challenge' >>= fun challenge' ->
|
||||
guard (String.equal challenge challenge')
|
||||
(`Challenge_mismatch (challenge, challenge')) >>= fun () ->
|
||||
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge ->
|
||||
b64_dec "response.ClientDataJSON.challenge" challenge >>= fun challenge ->
|
||||
json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
|
||||
guard (String.equal t.origin origin)
|
||||
(`Origin_mismatch (t.origin, origin)) >>= fun () ->
|
||||
|
|
@ -276,7 +269,7 @@ let register_response t challenge data =
|
|||
end >>= fun cert ->
|
||||
(* check attestation cert, maybe *)
|
||||
(* 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 = {
|
||||
authenticator_data : base64url_string [@key "authenticatorData"];
|
||||
|
|
@ -292,7 +285,7 @@ type auth_assertion_raw = {
|
|||
response : auth_response_raw;
|
||||
} [@@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 ->
|
||||
let response = assertion.response in
|
||||
let client_data_hash = Mirage_crypto.Hash.SHA256.digest
|
||||
|
|
@ -305,10 +298,8 @@ let authentication_response t cid_keys challenge data =
|
|||
(function
|
||||
| "webauthn.get" -> Ok ()
|
||||
| wrong_typ -> Error (`Client_data_type_mismatch wrong_typ)) >>= fun () ->
|
||||
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge' ->
|
||||
b64_dec "response.ClientDataJSON.challenge" challenge' >>= fun challenge' ->
|
||||
guard (String.equal challenge challenge')
|
||||
(`Challenge_mismatch (challenge, challenge')) >>= fun () ->
|
||||
json_get "challenge" client_data >>= json_string "challenge" >>= fun challenge ->
|
||||
b64_dec "response.ClientDataJSON.challenge" challenge >>= fun challenge ->
|
||||
json_get "origin" client_data >>= json_string "origin" >>= fun origin ->
|
||||
guard (String.equal t.origin origin)
|
||||
(`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
|
||||
in
|
||||
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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue