From a3fdc527d267c90e7f1ce76c156e9c186ce8c023 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 1 Sep 2022 09:31:53 +0200 Subject: [PATCH] new flag: key-hex to specify whether the KV-keys should be hex-encoded or raw binary --- mirage/config.ml | 10 ++++- mirage/unikernel.ml | 92 +++++++++++++++++++++++++++------------------ 2 files changed, 64 insertions(+), 38 deletions(-) diff --git a/mirage/config.ml b/mirage/config.ml index 7ae50ea..9c4be19 100644 --- a/mirage/config.ml +++ b/mirage/config.ml @@ -3,6 +3,14 @@ open Mirage type http_client = HTTP_client let http_client = typ HTTP_client +let key_hex = + let doc = + Key.Arg.info + ~doc:"File system keys should be stored as human-readable (hex) characters" + ["key-hex"] + in + Key.(create "key-hex" Arg.(flag doc)) + let check = let doc = Key.Arg.info @@ -29,7 +37,7 @@ let tls_authenticator = let mirror = foreign "Unikernel.Make" - ~keys:[ Key.v check ; Key.v remote ; Key.v tls_authenticator ] + ~keys:[ Key.v key_hex ; Key.v check ; Key.v remote ; Key.v tls_authenticator ] ~packages:[ package "paf" ; package "h2" ; diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index 0600c4f..c85c56b 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -227,20 +227,37 @@ module Make type t = { mutable md5s : string SM.t ; mutable sha512s : string SM.t ; + key_hex : bool ; dev : KV.t ; } - let empty dev = { md5s = SM.empty ; sha512s = SM.empty ; dev } + let empty key_hex dev = { md5s = SM.empty ; sha512s = SM.empty ; key_hex ; dev } + + let key t d = + let d = Cstruct.to_string d in + if t.key_hex then hex_to_string d else d + + let key_to_string t d = if t.key_hex then d else hex_to_string d + + let key_of_string t v = + if t.key_hex then + Ok v + else + match hex_of_string v with + | Error `Msg msg -> + Logs.err (fun m -> m "error %s while decoding hex %s" msg v); + Error `Bad_request + | Ok bin -> Ok bin (* on disk, we use a flat file system where the filename is the sha256 of the data *) (* on startup, we read + validate all data, and also store in the overlays (md5/sha512) the pointers *) (* the read can be md5/sha256/sha512 sum, and will output the data requested *) (* a write will compute the hashes and save the data (also validating potential other hashes) *) - let init dev = + let init ?(key_hex = false) dev = KV.list dev Mirage_kv.Key.empty >>= function | Error e -> Logs.err (fun m -> m "error %a listing kv" KV.pp_error e); assert false | Ok entries -> - let t = empty dev in + let t = empty key_hex dev in Lwt_list.iter_s (fun (name, typ) -> match typ with | `Dictionary -> @@ -251,49 +268,52 @@ module Make | Ok data -> let cs = Cstruct.of_string data in let digest = Mirage_crypto.Hash.digest `SHA256 cs in - if Cstruct.equal digest (Cstruct.of_string name) then begin - let md5 = Mirage_crypto.Hash.digest `MD5 cs - and sha512 = Mirage_crypto.Hash.digest `SHA512 cs + if String.equal name (key t digest) then begin + let md5 = Mirage_crypto.Hash.digest `MD5 cs |> key t + and sha512 = Mirage_crypto.Hash.digest `SHA512 cs |> key t in - let md5s = SM.add (Cstruct.to_string md5) name t.md5s - and sha512s = SM.add (Cstruct.to_string sha512) name t.sha512s + let md5s = SM.add md5 name t.md5s + and sha512s = SM.add sha512 name t.sha512s in t.md5s <- md5s ; t.sha512s <- sha512s; - Logs.info (fun m -> m "added %s" (hex_to_string name)); + Logs.info (fun m -> m "added %s (md5 %s sha512 %s)" + (key_to_string t name) (key_to_string t md5) + (key_to_string t sha512)); Lwt.return_unit end else begin Logs.err (fun m -> m "corrupt data, expected %s, read %s" - (hex_to_string name) + (key_to_string t name) (hex_to_string (Cstruct.to_string digest))); KV.remove dev (Mirage_kv.Key.v name) >|= function | Ok () -> () | Error e -> Logs.err (fun m -> m "error %a while removing %s" - KV.pp_write_error e (hex_to_string name)) + KV.pp_write_error e (key_to_string t name)) end | Error e -> Logs.err (fun m -> m "error %a reading %s" - KV.pp_error e (hex_to_string name)); + KV.pp_error e (key_to_string t name)); Lwt.return_unit) entries >|= fun () -> t let write t data hm = let cs = Cstruct.of_string data in - let sha256 = Mirage_crypto.Hash.digest `SHA256 cs |> Cstruct.to_string - and md5 = Mirage_crypto.Hash.digest `MD5 cs |> Cstruct.to_string - and sha512 = Mirage_crypto.Hash.digest `SHA512 cs |> Cstruct.to_string + let sha256 = Mirage_crypto.Hash.digest `SHA256 cs |> key t + and md5 = Mirage_crypto.Hash.digest `MD5 cs |> key t + and sha512 = Mirage_crypto.Hash.digest `SHA512 cs |> key t in if HM.for_all (fun h v -> let v' = match h with `MD5 -> md5 | `SHA256 -> sha256 | `SHA512 -> sha512 | _ -> assert false in + let v = if t.key_hex then hex_to_string v else v in if String.equal v v' then true else begin Logs.err (fun m -> m "hash mismatch %s: expected %s, got %s" - (hash_to_string h) (hex_to_string v) (hex_to_string v')); + (hash_to_string h) (key_to_string t v) (key_to_string t v')); false end) hm then begin @@ -301,31 +321,28 @@ module Make | Ok () -> t.md5s <- SM.add md5 sha256 t.md5s; t.sha512s <- SM.add sha512 sha256 t.sha512s; - Logs.debug (fun m -> m "wrote %s (%d bytes)" (hex_to_string sha256) + Logs.debug (fun m -> m "wrote %s (%d bytes)" (key_to_string t sha256) (String.length data)) | Error e -> Logs.err (fun m -> m "error %a while writing %s" - KV.pp_write_error e (hex_to_string sha256)) + KV.pp_write_error e (key_to_string t sha256)) end else Lwt.return_unit let find_key t h v = - match hex_of_string v with - | Error `Msg msg -> - Logs.err (fun m -> m "error %s while decoding hex %s" msg v); - Error `Bad_request - | Ok bin -> - match - match h with - | `MD5 -> SM.find_opt bin t.md5s - | `SHA512 -> SM.find_opt bin t.sha512s - | `SHA256 -> Some bin - | _ -> None - with - | None -> - Logs.err (fun m -> m "couldn't find %s" v); - Error `Not_found - | Some x -> Ok x + let ( let* ) = Result.bind in + let* key = key_of_string t v in + match + match h with + | `MD5 -> SM.find_opt key t.md5s + | `SHA512 -> SM.find_opt key t.sha512s + | `SHA256 -> Some key + | _ -> None + with + | None -> + Logs.err (fun m -> m "couldn't find %s" v); + Error `Not_found + | Some x -> Ok x let exists t h v = match find_key t h v with @@ -335,12 +352,12 @@ module Make | Ok Some `Value -> true | Ok Some `Dictionary -> Logs.err (fun m -> m "unexpected dictionary for %s %s" - (hash_to_string h) (hex_to_string v)); + (hash_to_string h) (key_to_string t v)); false | Ok None -> false | Error e -> Logs.err (fun m -> m "exists %s %s returned %a" - (hash_to_string h) (hex_to_string v) + (hash_to_string h) (key_to_string t v) KV.pp_error e); false @@ -360,7 +377,8 @@ module Make ~authenticator:HTTP.authenticator let start kv _time _pclock _stack git_ctx http_ctx = - Disk.init kv >>= fun disk -> + let key_hex = Key_gen.key_hex () in + Disk.init ~key_hex kv >>= fun disk -> if Key_gen.check () then begin Logs.info (fun m -> m "done"); Lwt.return_unit