WIP

bin/base64.js

@@ -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))

bin/dune

@@ -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))

bin/template.ml

@@ -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

bin/webauthn_demo.ml

@@ -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

dune-project

@@ -0,0 +1,2 @@
+(lang dune 2.7)
+(name webauthn)

flash_message/dune

@@ -0,0 +1,3 @@
+(library
+ (name flash_message)
+ (libraries dream))

flash_message/flash_message.ml

@@ -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

src/dune

@@ -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))

src/webauthn.ml

@@ -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

src/webauthn.mli

@@ -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
+