WIP
This commit is contained in:
Robur
commit
55bb364b72
11 changed files with 615 additions and 0 deletions
118
bin/base64.js
Normal file
118
bin/base64.js
Normal file
|
|
@ -0,0 +1,118 @@
|
||||||
|
var lookup = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'
|
||||||
|
|
||||||
|
;(function (exports) {
|
||||||
|
'use strict'
|
||||||
|
|
||||||
|
var Arr = (typeof Uint8Array !== 'undefined')
|
||||||
|
? Uint8Array
|
||||||
|
: Array
|
||||||
|
|
||||||
|
var PLUS = '+'.charCodeAt(0)
|
||||||
|
var SLASH = '/'.charCodeAt(0)
|
||||||
|
var NUMBER = '0'.charCodeAt(0)
|
||||||
|
var LOWER = 'a'.charCodeAt(0)
|
||||||
|
var UPPER = 'A'.charCodeAt(0)
|
||||||
|
var PLUS_URL_SAFE = '-'.charCodeAt(0)
|
||||||
|
var SLASH_URL_SAFE = '_'.charCodeAt(0)
|
||||||
|
|
||||||
|
function decode (elt) {
|
||||||
|
var code = elt.charCodeAt(0)
|
||||||
|
if (code === PLUS || code === PLUS_URL_SAFE) return 62 // '+'
|
||||||
|
if (code === SLASH || code === SLASH_URL_SAFE) return 63 // '/'
|
||||||
|
if (code < NUMBER) return -1 // no match
|
||||||
|
if (code < NUMBER + 10) return code - NUMBER + 26 + 26
|
||||||
|
if (code < UPPER + 26) return code - UPPER
|
||||||
|
if (code < LOWER + 26) return code - LOWER + 26
|
||||||
|
}
|
||||||
|
|
||||||
|
function b64ToByteArray (b64) {
|
||||||
|
var i, j, l, tmp, placeHolders, arr
|
||||||
|
|
||||||
|
if (b64.length % 4 > 0) {
|
||||||
|
throw new Error('Invalid string. Length must be a multiple of 4')
|
||||||
|
}
|
||||||
|
|
||||||
|
// the number of equal signs (place holders)
|
||||||
|
// if there are two placeholders, than the two characters before it
|
||||||
|
// represent one byte
|
||||||
|
// if there is only one, then the three characters before it represent 2 bytes
|
||||||
|
// this is just a cheap hack to not do indexOf twice
|
||||||
|
var len = b64.length
|
||||||
|
placeHolders = b64.charAt(len - 2) === '=' ? 2 : b64.charAt(len - 1) === '=' ? 1 : 0
|
||||||
|
|
||||||
|
// base64 is 4/3 + up to two characters of the original data
|
||||||
|
arr = new Arr(b64.length * 3 / 4 - placeHolders)
|
||||||
|
|
||||||
|
// if there are placeholders, only get up to the last complete 4 chars
|
||||||
|
l = placeHolders > 0 ? b64.length - 4 : b64.length
|
||||||
|
|
||||||
|
var L = 0
|
||||||
|
|
||||||
|
function push (v) {
|
||||||
|
arr[L++] = v
|
||||||
|
}
|
||||||
|
|
||||||
|
for (i = 0, j = 0; i < l; i += 4, j += 3) {
|
||||||
|
tmp = (decode(b64.charAt(i)) << 18) | (decode(b64.charAt(i + 1)) << 12) | (decode(b64.charAt(i + 2)) << 6) | decode(b64.charAt(i + 3))
|
||||||
|
push((tmp & 0xFF0000) >> 16)
|
||||||
|
push((tmp & 0xFF00) >> 8)
|
||||||
|
push(tmp & 0xFF)
|
||||||
|
}
|
||||||
|
|
||||||
|
if (placeHolders === 2) {
|
||||||
|
tmp = (decode(b64.charAt(i)) << 2) | (decode(b64.charAt(i + 1)) >> 4)
|
||||||
|
push(tmp & 0xFF)
|
||||||
|
} else if (placeHolders === 1) {
|
||||||
|
tmp = (decode(b64.charAt(i)) << 10) | (decode(b64.charAt(i + 1)) << 4) | (decode(b64.charAt(i + 2)) >> 2)
|
||||||
|
push((tmp >> 8) & 0xFF)
|
||||||
|
push(tmp & 0xFF)
|
||||||
|
}
|
||||||
|
|
||||||
|
return arr
|
||||||
|
}
|
||||||
|
|
||||||
|
function uint8ToBase64 (uint8) {
|
||||||
|
var i
|
||||||
|
var extraBytes = uint8.length % 3 // if we have 1 byte left, pad 2 bytes
|
||||||
|
var output = ''
|
||||||
|
var temp, length
|
||||||
|
|
||||||
|
function encode (num) {
|
||||||
|
return lookup.charAt(num)
|
||||||
|
}
|
||||||
|
|
||||||
|
function tripletToBase64 (num) {
|
||||||
|
return encode(num >> 18 & 0x3F) + encode(num >> 12 & 0x3F) + encode(num >> 6 & 0x3F) + encode(num & 0x3F)
|
||||||
|
}
|
||||||
|
|
||||||
|
// go through the array every three bytes, we'll deal with trailing stuff later
|
||||||
|
for (i = 0, length = uint8.length - extraBytes; i < length; i += 3) {
|
||||||
|
temp = (uint8[i] << 16) + (uint8[i + 1] << 8) + (uint8[i + 2])
|
||||||
|
output += tripletToBase64(temp)
|
||||||
|
}
|
||||||
|
|
||||||
|
// pad the end with zeros, but make sure to not forget the extra bytes
|
||||||
|
switch (extraBytes) {
|
||||||
|
case 1:
|
||||||
|
temp = uint8[uint8.length - 1]
|
||||||
|
output += encode(temp >> 2)
|
||||||
|
output += encode((temp << 4) & 0x3F)
|
||||||
|
output += '=='
|
||||||
|
break
|
||||||
|
case 2:
|
||||||
|
temp = (uint8[uint8.length - 2] << 8) + (uint8[uint8.length - 1])
|
||||||
|
output += encode(temp >> 10)
|
||||||
|
output += encode((temp >> 4) & 0x3F)
|
||||||
|
output += encode((temp << 2) & 0x3F)
|
||||||
|
output += '='
|
||||||
|
break
|
||||||
|
default:
|
||||||
|
break
|
||||||
|
}
|
||||||
|
|
||||||
|
return output
|
||||||
|
}
|
||||||
|
|
||||||
|
exports.toByteArray = b64ToByteArray
|
||||||
|
exports.fromByteArray = uint8ToBase64
|
||||||
|
}(typeof exports === 'undefined' ? (this.base64js = {}) : exports))
|
||||||
8
bin/dune
Normal file
8
bin/dune
Normal file
|
|
@ -0,0 +1,8 @@
|
||||||
|
(executable
|
||||||
|
(public_name webauthn_demo)
|
||||||
|
(name webauthn_demo)
|
||||||
|
(modules webauthn_demo template)
|
||||||
|
(preprocessor_deps base64.js)
|
||||||
|
(preprocess (pps ppx_blob))
|
||||||
|
(libraries webauthn dream cmdliner logs.cli lwt flash_message)
|
||||||
|
(optional))
|
||||||
140
bin/template.ml
Normal file
140
bin/template.ml
Normal file
|
|
@ -0,0 +1,140 @@
|
||||||
|
let page s b =
|
||||||
|
Printf.sprintf {|
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<title>WebAuthn Demo</title>
|
||||||
|
<script type="text/javascript" src="/static/base64.js"></script>
|
||||||
|
<script>
|
||||||
|
function bufferEncode(value) {
|
||||||
|
return base64js.fromByteArray(value)
|
||||||
|
.replace(/\+/g, "-")
|
||||||
|
.replace(/\//g, "_")
|
||||||
|
.replace(/=/g, "");
|
||||||
|
}
|
||||||
|
</script>
|
||||||
|
<script>%s</script>
|
||||||
|
</head><body>%s</body></html>|} s b
|
||||||
|
|
||||||
|
let overview notes authenticated_as users =
|
||||||
|
let authenticated_as =
|
||||||
|
match authenticated_as with
|
||||||
|
| None -> "<h2>Not authenticated</h2>"
|
||||||
|
| Some user -> Printf.sprintf {|<h2>Authenticated as %s</h2>
|
||||||
|
<form action="/logout" method="post"><input type="submit" value="Log out"/></form>
|
||||||
|
|} user
|
||||||
|
and links =
|
||||||
|
{|<h2>Register</h2><ul>
|
||||||
|
<li><a href="/register">register</a></li>
|
||||||
|
</ul>
|
||||||
|
|}
|
||||||
|
and users =
|
||||||
|
String.concat ""
|
||||||
|
("<h2>Users</h2><ul>" ::
|
||||||
|
Hashtbl.fold (fun name keys acc ->
|
||||||
|
let handles = List.map (fun (_, h, _) -> h) keys in
|
||||||
|
(Printf.sprintf "<li>%s [<a href=/authenticate/%s>authenticate</a>] (%s)</li>" name name (String.concat ", " handles)) :: acc)
|
||||||
|
users [] @ [ "</ul>" ])
|
||||||
|
in
|
||||||
|
page "" (String.concat "" (notes @ [authenticated_as;links;users]))
|
||||||
|
|
||||||
|
let register_view user challenge userid =
|
||||||
|
let script = Printf.sprintf {|
|
||||||
|
var publicKey = {
|
||||||
|
challenge: Uint8Array.from(window.atob("%s"), c=>c.charCodeAt(0)),
|
||||||
|
rp: {
|
||||||
|
id: "webauthn-demo.robur.coop",
|
||||||
|
name: "WebAuthn Demo from robur.coop"
|
||||||
|
},
|
||||||
|
user: {
|
||||||
|
id: Uint8Array.from(window.atob("%s"), c=>c.charCodeAt(0)),
|
||||||
|
displayName: "%s",
|
||||||
|
name: "%s"
|
||||||
|
},
|
||||||
|
pubKeyCredParams: [
|
||||||
|
{
|
||||||
|
type: "public-key",
|
||||||
|
alg: -7
|
||||||
|
}
|
||||||
|
]
|
||||||
|
};
|
||||||
|
navigator.credentials.create({ publicKey })
|
||||||
|
.then(function (credential) {
|
||||||
|
// send attestation response and client extensions
|
||||||
|
// to the server to proceed with the registration
|
||||||
|
// of the credential
|
||||||
|
console.log(credential);
|
||||||
|
// Move data into Arrays incase it is super long
|
||||||
|
let response = credential.response;
|
||||||
|
let attestationObject = new Uint8Array(response.attestationObject);
|
||||||
|
let clientDataJSON = new Uint8Array(response.clientDataJSON);
|
||||||
|
let rawId = new Uint8Array(credential.rawId);
|
||||||
|
|
||||||
|
var body =
|
||||||
|
JSON.stringify({
|
||||||
|
id: credential.id,
|
||||||
|
rawId: bufferEncode(rawId),
|
||||||
|
type: credential.type,
|
||||||
|
response: {
|
||||||
|
attestationObject: bufferEncode(attestationObject),
|
||||||
|
clientDataJSON: bufferEncode(clientDataJSON),
|
||||||
|
},
|
||||||
|
});
|
||||||
|
console.log(body);
|
||||||
|
|
||||||
|
let headers = {'Content-type': "application/json; charset=utf-8"};
|
||||||
|
|
||||||
|
let request = new Request('/register_finish', { method: 'POST', body: body, headers: headers } );
|
||||||
|
fetch(request)
|
||||||
|
.then(function (response) {
|
||||||
|
console.log(response);
|
||||||
|
if (!response.ok) {
|
||||||
|
console.log("bad response: " + response.status);
|
||||||
|
};
|
||||||
|
});
|
||||||
|
}).catch(function (err) {
|
||||||
|
console.error(err);
|
||||||
|
});
|
||||||
|
|} challenge userid user user
|
||||||
|
and body =
|
||||||
|
Printf.sprintf {|
|
||||||
|
<p>Welcome %s.</p>
|
||||||
|
|} user
|
||||||
|
in
|
||||||
|
page script body
|
||||||
|
|
||||||
|
let authenticate_view data user =
|
||||||
|
let script =
|
||||||
|
Printf.sprintf {|
|
||||||
|
var request = JSON.parse('%s');
|
||||||
|
setTimeout(function() {
|
||||||
|
u2f.sign(
|
||||||
|
request.appId,
|
||||||
|
request.challenge,
|
||||||
|
request.registeredKeys,
|
||||||
|
function(data) {
|
||||||
|
if(data.errorCode) {
|
||||||
|
switch (data.errorCode) {
|
||||||
|
case 4:
|
||||||
|
alert("This device is not registered for this account.");
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
alert("U2F failed with error code: " + data.errorCode);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
document.getElementById('token').value = JSON.stringify(data);
|
||||||
|
document.getElementById('form').submit();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}, 1000);
|
||||||
|
|} data
|
||||||
|
and body =
|
||||||
|
Printf.sprintf {|
|
||||||
|
<p>Touch your U2F token to authenticate as %S.</p>
|
||||||
|
<form method="POST" action="/authenticate_finish" id="form">
|
||||||
|
<input type="hidden" name="token" id="token"/>
|
||||||
|
</form>
|
||||||
|
|} user
|
||||||
|
in
|
||||||
|
page script body
|
||||||
213
bin/webauthn_demo.ml
Normal file
213
bin/webauthn_demo.ml
Normal file
|
|
@ -0,0 +1,213 @@
|
||||||
|
open Lwt.Infix
|
||||||
|
|
||||||
|
let users = Hashtbl.create 7
|
||||||
|
|
||||||
|
module KhPubHashtbl = Hashtbl.Make(struct
|
||||||
|
type t = Webauthn.key_handle * Mirage_crypto_ec.P256.Dsa.pub
|
||||||
|
let cs_of_pub = Mirage_crypto_ec.P256.Dsa.pub_to_cstruct
|
||||||
|
let equal (kh, pub) (kh', pub') =
|
||||||
|
String.equal kh kh' && Cstruct.equal (cs_of_pub pub) (cs_of_pub pub')
|
||||||
|
let hash (kh, pub) = Hashtbl.hash (kh, Cstruct.to_string (cs_of_pub pub ))
|
||||||
|
end)
|
||||||
|
|
||||||
|
let counters = KhPubHashtbl.create 7
|
||||||
|
|
||||||
|
let check_counter kh_pub counter =
|
||||||
|
let r =
|
||||||
|
match KhPubHashtbl.find_opt counters kh_pub with
|
||||||
|
| Some counter' -> Int32.unsigned_compare counter counter' > 0
|
||||||
|
| None -> true
|
||||||
|
in
|
||||||
|
if r
|
||||||
|
then KhPubHashtbl.replace counters kh_pub counter;
|
||||||
|
r
|
||||||
|
|
||||||
|
let retrieve_form request =
|
||||||
|
Dream.body request >|= fun body ->
|
||||||
|
let form = Dream__pure.Formats.from_form_urlencoded body in
|
||||||
|
List.stable_sort (fun (key, _) (key', _) -> String.compare key key') form
|
||||||
|
|
||||||
|
let to_string err = Format.asprintf "%a" Webauthn.pp_error err
|
||||||
|
|
||||||
|
let gen_data ?(pad = false) ?alphabet length =
|
||||||
|
Base64.encode_string ~pad ?alphabet
|
||||||
|
(Cstruct.to_string (Mirage_crypto_rng.generate length))
|
||||||
|
|
||||||
|
|
||||||
|
let add_routes t =
|
||||||
|
let main req =
|
||||||
|
let authenticated_as = Dream.session "authenticated_as" req in
|
||||||
|
let flash = Flash_message.get_flash req |> List.map snd in
|
||||||
|
Dream.html (Template.overview flash authenticated_as users)
|
||||||
|
in
|
||||||
|
|
||||||
|
let register req =
|
||||||
|
let user =
|
||||||
|
match Dream.session "authenticated_as" req with
|
||||||
|
| None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8
|
||||||
|
| Some username -> username
|
||||||
|
in
|
||||||
|
let _key_handles = match Hashtbl.find_opt users user with
|
||||||
|
| None -> []
|
||||||
|
| Some keys -> List.map (fun (_, kh, _) -> kh) keys
|
||||||
|
in
|
||||||
|
(* let challenge, rr = Webauthn.register_request ~key_handles t in *)
|
||||||
|
let challenge = gen_data ~pad:true 16
|
||||||
|
and userid = gen_data ~pad:true 16
|
||||||
|
in
|
||||||
|
Dream.put_session "challenge" challenge req >>= fun () ->
|
||||||
|
Dream.html (Template.register_view user challenge userid)
|
||||||
|
in
|
||||||
|
|
||||||
|
let register_finish req =
|
||||||
|
Dream.body req >>= fun body ->
|
||||||
|
Logs.info (fun m -> m "received body: %s" body);
|
||||||
|
(* let token = List.assoc "token" data in
|
||||||
|
let user = List.assoc "username" data in *)
|
||||||
|
let token = "a" and user = "b" in
|
||||||
|
match Dream.session "challenge" req with
|
||||||
|
| None ->
|
||||||
|
Logs.warn (fun m -> m "no challenge found");
|
||||||
|
Dream.respond ~status:`Bad_Request "Bad request."
|
||||||
|
| Some challenge ->
|
||||||
|
match Webauthn.register_response t challenge token 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.redirect req "/"
|
||||||
|
| Ok (key, kh, cert) ->
|
||||||
|
match Dream.session "authenticated_as" req, Hashtbl.find_opt users user with
|
||||||
|
| _, None ->
|
||||||
|
Logs.app (fun m -> m "registered %s" user);
|
||||||
|
Hashtbl.replace users user [ (key, kh, cert) ];
|
||||||
|
Dream.invalidate_session req >>= fun () ->
|
||||||
|
Flash_message.put_flash ""
|
||||||
|
(Printf.sprintf "Successfully registered as %s! <a href=\"/authenticate/%s\">[authenticate]</a>" user user)
|
||||||
|
req;
|
||||||
|
Dream.redirect req "/"
|
||||||
|
| Some session_user, Some keys ->
|
||||||
|
if String.equal user session_user then begin
|
||||||
|
Logs.app (fun m -> m "registered %s" user);
|
||||||
|
Hashtbl.replace users user ((key, kh, 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)
|
||||||
|
req;
|
||||||
|
Dream.redirect req "/"
|
||||||
|
end else
|
||||||
|
Dream.respond ~status:`Forbidden "Forbidden."
|
||||||
|
| None, Some _keys ->
|
||||||
|
Dream.respond ~status:`Forbidden "Forbidden."
|
||||||
|
in
|
||||||
|
|
||||||
|
let authenticate req =
|
||||||
|
let user = Dream.param "user" req in
|
||||||
|
match Hashtbl.find_opt users user with
|
||||||
|
| None ->
|
||||||
|
Logs.warn (fun m -> m "no user found");
|
||||||
|
Dream.respond ~status:`Bad_Request "Bad request."
|
||||||
|
| Some keys ->
|
||||||
|
let khs = List.map (fun (_, kh, _) -> kh) keys in
|
||||||
|
let challenge, ar = Webauthn.authentication_request t khs in
|
||||||
|
Dream.put_session "challenge" challenge req >>= fun () ->
|
||||||
|
Dream.put_session "challenge_user" user req >>= fun () ->
|
||||||
|
Dream.html (Template.authenticate_view ar user)
|
||||||
|
in
|
||||||
|
|
||||||
|
let authenticate_finish req =
|
||||||
|
retrieve_form req >>= fun data ->
|
||||||
|
match Dream.session "challenge_user" req with
|
||||||
|
| None -> Dream.respond ~status:`Internal_Server_Error "Internal server error."
|
||||||
|
| Some user ->
|
||||||
|
match Dream.session "challenge" req with
|
||||||
|
| None ->
|
||||||
|
Logs.warn (fun m -> m "no challenge found");
|
||||||
|
Dream.respond ~status:`Bad_Request "Bad request."
|
||||||
|
| Some challenge ->
|
||||||
|
match Hashtbl.find_opt users user with
|
||||||
|
| None ->
|
||||||
|
Logs.warn (fun m -> m "no user found, using empty");
|
||||||
|
Dream.respond ~status:`Bad_Request "Bad request."
|
||||||
|
| Some keys ->
|
||||||
|
let kh_keys = List.map (fun (key, kh, _) -> kh, key) keys in
|
||||||
|
let token = List.assoc "token" data in
|
||||||
|
match Webauthn.authentication_response t kh_keys challenge token with
|
||||||
|
| Ok (key_handle_pubkey, _user_present, counter) ->
|
||||||
|
if check_counter key_handle_pubkey 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.redirect req "/"
|
||||||
|
end else begin
|
||||||
|
Logs.warn (fun m -> m "key handle %S for user %S: counter not strictly increasing! \
|
||||||
|
Got %ld, expected >%ld. webauthn device compromised?"
|
||||||
|
(fst key_handle_pubkey) user counter (KhPubHashtbl.find counters key_handle_pubkey));
|
||||||
|
Flash_message.put_flash "" "Authentication failure: key compromised?" req;
|
||||||
|
Dream.redirect req "/"
|
||||||
|
end
|
||||||
|
| Error e ->
|
||||||
|
Logs.warn (fun m -> m "error %a" Webauthn.pp_error e);
|
||||||
|
let err = to_string e in
|
||||||
|
Flash_message.put_flash "" ("Authentication failure: " ^ err) req;
|
||||||
|
Dream.redirect req "/"
|
||||||
|
in
|
||||||
|
|
||||||
|
let logout req =
|
||||||
|
Dream.invalidate_session req >>= fun () ->
|
||||||
|
Dream.redirect req "/"
|
||||||
|
in
|
||||||
|
|
||||||
|
let base64 _req =
|
||||||
|
Dream.respond ~headers:[("Content-type", "application/javascript")]
|
||||||
|
[%blob "base64.js"]
|
||||||
|
in
|
||||||
|
|
||||||
|
Dream.router [
|
||||||
|
Dream.get "/" main;
|
||||||
|
Dream.get "/register" register;
|
||||||
|
Dream.post "/register_finish" register_finish;
|
||||||
|
Dream.get "/authenticate/:user" authenticate;
|
||||||
|
Dream.post "/authenticate_finish" authenticate_finish;
|
||||||
|
Dream.post "/logout" logout;
|
||||||
|
Dream.get "/static/base64.js" base64;
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
let setup_app level port host application_id https =
|
||||||
|
let webauthn = Webauthn.create application_id in
|
||||||
|
let level = match level with None -> None | Some Logs.Debug -> Some `Debug | Some Info -> Some `Info | Some Warning -> Some `Warning | Some Error -> Some `Error | Some App -> None in
|
||||||
|
Dream.initialize_log ?level ();
|
||||||
|
Dream.run ~port ~interface:host ~https
|
||||||
|
@@ Dream.logger
|
||||||
|
@@ Dream.memory_sessions
|
||||||
|
@@ Flash_message.flash_messages
|
||||||
|
@@ add_routes webauthn
|
||||||
|
@@ Dream.not_found
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
|
||||||
|
let port =
|
||||||
|
let doc = "port" in
|
||||||
|
Arg.(value & opt int 5000 & info [ "p"; "port" ] ~doc)
|
||||||
|
|
||||||
|
let host =
|
||||||
|
let doc = "host" in
|
||||||
|
Arg.(value & opt string "0.0.0.0" & info [ "h"; "host" ] ~doc)
|
||||||
|
|
||||||
|
let application_id =
|
||||||
|
let doc = "the webauthn application id - usually protocol://host(:port)" in
|
||||||
|
Arg.(value & opt string "https://webauthn-demo.robur.coop" & info [ "application-id" ] ~doc)
|
||||||
|
|
||||||
|
let tls =
|
||||||
|
let doc = "tls" in
|
||||||
|
Arg.(value & flag & info [ "tls" ] ~doc)
|
||||||
|
|
||||||
|
let () =
|
||||||
|
let term = Term.(pure setup_app $ Logs_cli.level () $ port $ host $ application_id $ tls) in
|
||||||
|
let info = Term.info "Webauthn app" ~doc:"Webauthn app" ~man:[] in
|
||||||
|
match Term.eval (term, info) with
|
||||||
|
| `Ok () -> exit 0
|
||||||
|
| `Error _ -> exit 1
|
||||||
|
| _ -> exit 0
|
||||||
2
dune-project
Normal file
2
dune-project
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
(lang dune 2.7)
|
||||||
|
(name webauthn)
|
||||||
3
flash_message/dune
Normal file
3
flash_message/dune
Normal file
|
|
@ -0,0 +1,3 @@
|
||||||
|
(library
|
||||||
|
(name flash_message)
|
||||||
|
(libraries dream))
|
||||||
51
flash_message/flash_message.ml
Normal file
51
flash_message/flash_message.ml
Normal file
|
|
@ -0,0 +1,51 @@
|
||||||
|
open Lwt.Syntax
|
||||||
|
|
||||||
|
let five_minutes = 5. *. 60.
|
||||||
|
|
||||||
|
|
||||||
|
let storage = Dream.new_local ~name:"dream.flash_message" ()
|
||||||
|
|
||||||
|
|
||||||
|
let flash_cookie = "dream.flash_message"
|
||||||
|
|
||||||
|
|
||||||
|
let flash_messages inner_handler request =
|
||||||
|
let outbox = ref [] in
|
||||||
|
let request = Dream.with_local storage outbox request in
|
||||||
|
let* response = inner_handler request in
|
||||||
|
Lwt.return(
|
||||||
|
let entries = List.rev !outbox in
|
||||||
|
let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] in
|
||||||
|
let value = `List content |> Yojson.Basic.to_string in
|
||||||
|
Dream.set_cookie flash_cookie value request response ~max_age:five_minutes
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
let (|>?) =
|
||||||
|
Option.bind
|
||||||
|
|
||||||
|
|
||||||
|
let get_flash request =
|
||||||
|
let rec group x = match x with
|
||||||
|
| x1::x2::rest -> (x1, x2) :: group rest
|
||||||
|
| _ -> []
|
||||||
|
in
|
||||||
|
let unpack u = match u with
|
||||||
|
| `String x -> x
|
||||||
|
| _ -> failwith "Bad flash message content" in
|
||||||
|
let x = Dream.cookie flash_cookie request
|
||||||
|
|>? fun value ->
|
||||||
|
match Yojson.Basic.from_string value with
|
||||||
|
| `List y -> Some (group @@ List.map unpack y)
|
||||||
|
| _ -> None
|
||||||
|
in Option.value x ~default:[]
|
||||||
|
|
||||||
|
|
||||||
|
let put_flash category message request =
|
||||||
|
let outbox = match Dream.local storage request with
|
||||||
|
| Some outbox -> outbox
|
||||||
|
| None ->
|
||||||
|
let message = "Missing flash message middleware" in
|
||||||
|
Logs.err (fun log -> log "%s" message);
|
||||||
|
failwith message in
|
||||||
|
outbox := (category, message) :: !outbox
|
||||||
6
src/dune
Normal file
6
src/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
(library
|
||||||
|
(name webauthn)
|
||||||
|
(public_name webauthn)
|
||||||
|
(preprocess
|
||||||
|
(pps ppx_deriving_yojson))
|
||||||
|
(libraries mirage-crypto-rng yojson mirage-crypto-ec x509 base64))
|
||||||
48
src/webauthn.ml
Normal file
48
src/webauthn.ml
Normal file
|
|
@ -0,0 +1,48 @@
|
||||||
|
type key_handle = string
|
||||||
|
|
||||||
|
type error = [
|
||||||
|
`None
|
||||||
|
]
|
||||||
|
|
||||||
|
let pp_error _ppf _e = ()
|
||||||
|
|
||||||
|
type t = unit
|
||||||
|
|
||||||
|
type challenge = string
|
||||||
|
|
||||||
|
type typ = Public_key [@name "public-key"]
|
||||||
|
[@@deriving yojson]
|
||||||
|
|
||||||
|
type response_raw = {
|
||||||
|
attestation_object : string [@key "attestationObject"];
|
||||||
|
client_data_json : string [@key "clientDataJSON"];
|
||||||
|
} [@@deriving of_yojson]
|
||||||
|
|
||||||
|
type attestation_raw = {
|
||||||
|
id : string;
|
||||||
|
raw_id : string [@key "rawId"];
|
||||||
|
typ : typ [@key "type"];
|
||||||
|
response : response_raw;
|
||||||
|
} [@@deriving of_yojson]
|
||||||
|
|
||||||
|
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 b64_dec thing s =
|
||||||
|
lift_err
|
||||||
|
(function `Msg m -> `Base64_decoding (thing, m, s))
|
||||||
|
Base64.(decode ~pad:false ~alphabet:uri_safe_alphabet s)
|
||||||
|
|
||||||
|
let _ = ignore b64_enc; ignore b64_dec
|
||||||
|
|
||||||
|
let create _app = ()
|
||||||
|
|
||||||
|
let register_request ?key_handles:_ _t = "foo", "bar"
|
||||||
|
|
||||||
|
let register_response _t _challenge _data = Error `None
|
||||||
|
|
||||||
|
let authentication_request _t _handles = "foo", "bar"
|
||||||
|
|
||||||
|
let authentication_response _t _handles _challenges _data =
|
||||||
|
Error `None
|
||||||
26
src/webauthn.mli
Normal file
26
src/webauthn.mli
Normal file
|
|
@ -0,0 +1,26 @@
|
||||||
|
type key_handle = string
|
||||||
|
|
||||||
|
type error
|
||||||
|
|
||||||
|
val pp_error : Format.formatter -> error -> unit
|
||||||
|
|
||||||
|
type t
|
||||||
|
|
||||||
|
val create : string -> t
|
||||||
|
|
||||||
|
type challenge = string
|
||||||
|
|
||||||
|
val register_request : ?key_handles:key_handle list -> t -> challenge * string
|
||||||
|
|
||||||
|
val register_response : t -> challenge -> string ->
|
||||||
|
(Mirage_crypto_ec.P256.Dsa.pub * key_handle * X509.Certificate.t,
|
||||||
|
error) result
|
||||||
|
|
||||||
|
val authentication_request : t -> key_handle list ->
|
||||||
|
challenge * string
|
||||||
|
|
||||||
|
val authentication_response : t ->
|
||||||
|
(key_handle * Mirage_crypto_ec.P256.Dsa.pub) list ->
|
||||||
|
challenge -> string ->
|
||||||
|
((key_handle * Mirage_crypto_ec.P256.Dsa.pub) * bool * int32, error) result
|
||||||
|
|
||||||
0
webauthn.opam
Normal file
0
webauthn.opam
Normal file
Loading…
Reference in a new issue