this repo has no description
patrick.sirref.org
1(* let () = Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna) *)
2let hash_size = 256
3
4module Fixed_string = Index.Key.String_fixed (struct
5 let length = 256
6end)
7
8module I = Index_unix.Make (Fixed_string) (Fixed_string) (Index.Cache.Noop)
9module Secret = Capnp_rpc_net.Restorer.Id
10
11type t = {
12 store : I.t;
13 make_sturdy : Secret.t -> Uri.t;
14 load :
15 validate:(unit -> bool) ->
16 sturdy_ref:[ `Generic ] Capnp_rpc.Sturdy_ref.t ->
17 Capnp_rpc_net.Restorer.resolution;
18}
19
20let create ~make_sturdy ~load path =
21 let store = I.v ~log_size:4096 path in
22 { store; make_sturdy; load }
23
24let pad_name name =
25 let diff = hash_size - String.length name in
26 if diff >= 0 then String.make diff ' ' ^ name else failwith "Name too long!"
27
28let add_client t name =
29 let name = String.trim name in
30 let secret = Secret.generate () in
31 let hash = Secret.digest `SHA256 secret in
32 let name = pad_name name in
33 let store_secret = pad_name hash in
34 I.replace t name store_secret;
35 I.replace t store_secret name;
36 I.merge t;
37 secret
38
39let lookup t name =
40 let name = pad_name name in
41 try Some (I.find t name) with Not_found -> None
42
43let lookup_by_hash t digest =
44 try Some (I.find t (pad_name digest)) with Not_found -> None
45
46let remove t name =
47 let name = String.trim name in
48 let padded_name = pad_name name in
49 I.filter t (fun (k, _) -> k = padded_name);
50 I.merge t
51
52let list t =
53 let lst = ref [] in
54 I.iter (fun k _ -> lst := String.trim k :: !lst) t;
55 List.stable_sort String.compare !lst
56
57module type T = Capnp_rpc_net.Restorer.LOADER
58
59let hash _ = `SHA256
60let make_sturdy t = t.make_sturdy
61
62let validate t digest () =
63 match lookup t.store digest with None -> false | Some _ -> true
64
65let load t self digest =
66 Logs.info (fun f -> f "Looking up %s" digest);
67 match lookup_by_hash t.store digest with
68 | None -> Capnp_rpc_net.Restorer.unknown_service_id
69 | Some _ ->
70 t.load ~validate:(validate t digest)
71 ~sturdy_ref:(Capnp_rpc.Sturdy_ref.cast self)