This repository has no description
1open Shelter_common
2open Capnp_rpc
3
4module Admin = struct
5 module Secret = Capnp_rpc_net.Restorer.Id
6
7 let add_user t restorer name =
8 match Store.lookup t name with
9 | Some _ -> Fmt.failwith "User %s already exists!" name
10 | None -> (
11 let secret = Store.add_client t name in
12 match Capnp_rpc_net.Restorer.restore restorer secret with
13 | Ok v -> v
14 | Error exn ->
15 Fmt.failwith "%a" Capnp_rpc_proto.Error.pp (`Exception exn))
16
17 let remove_user t name = Store.remove t name
18
19 let v sr restorer t =
20 let add_user = add_user t restorer in
21 let remove_user = remove_user t in
22 Admin.v ~add_user ~remove_user sr
23end
24
25open Capnp_rpc_net
26
27let export ~secrets_dir ~vat ~name id =
28 let ( / ) = Filename.concat in
29 let path = secrets_dir / (name ^ ".cap") in
30 Capnp_rpc_unix.Cap_file.save_service vat id path |> or_fail;
31 Logs.app (fun f -> f "Wrote capability reference to %S" path)
32
33let daemon capnp services store secrets_dir =
34 let restore = Restorer.of_table services in
35 let admin_id = Capnp_rpc_unix.Vat_config.derived_id capnp "admin" in
36 let admin =
37 let sr = Capnp_rpc_net.Restorer.Table.sturdy_ref services admin_id in
38 Admin.v sr restore store
39 in
40 Restorer.Table.add services admin_id admin;
41 Eio.Switch.run @@ fun sw ->
42 let vat = Capnp_rpc_unix.serve capnp ~sw ~restore in
43 export ~secrets_dir ~vat ~name:"admin" admin_id;
44 Logs.app (fun f -> f "shelterd running...");
45 Eio.Promise.await (Eio.Promise.create () |> fst)
46
47open Cmdliner
48
49let setup_log style_renderer level =
50 Fmt_tty.setup_std_outputs ?style_renderer ();
51 Logs.set_level level;
52 Logs.set_reporter (Logs_fmt.reporter ());
53 ()
54
55let setup_log =
56 let docs = Manpage.s_common_options in
57 Term.(
58 const setup_log $ Fmt_cli.style_renderer ~docs () $ Logs_cli.level ~docs ())
59
60let admin =
61 Arg.required
62 @@ Arg.opt Arg.(some file) None
63 @@ Arg.info ~doc:"Path of the admin capability." ~docv:"ADDR"
64 [ "c"; "connect" ]
65
66let username =
67 Arg.required
68 @@ Arg.pos 0 Arg.(some string) None
69 @@ Arg.info ~doc:"The name of the new user to add." ~docv:"NAME" []
70
71let daemon env =
72 let doc = "run the shelter daemon" in
73 let man =
74 [
75 `S Manpage.s_description;
76 `P "The shelter daemon provides a way to run sessions for shelter users.";
77 ]
78 in
79 let info = Cmd.info ~man "daemon" ~doc in
80 let daemon () capnp =
81 let make_sturdy = Capnp_rpc_unix.Vat_config.sturdy_uri capnp in
82 let connect = Obj.magic () in
83 let load ~validate:_ ~sturdy_ref =
84 let sr = Capnp_rpc.Sturdy_ref.cast sturdy_ref in
85 Restorer.grant (User.v sr connect)
86 in
87 let loader = Store.create ~make_sturdy ~load "shelter.index" in
88 Eio.Switch.run @@ fun sw ->
89 let services = Restorer.Table.of_loader ~sw (module Store) loader in
90 daemon capnp services loader.store "./secrets"
91 in
92 let term =
93 Term.(const daemon $ setup_log $ Capnp_rpc_unix.Vat_config.cmd env)
94 in
95 (Cmd.v info term, term)
96
97let add_cmd env =
98 let doc = "add a new client" in
99 let man =
100 [
101 `S Manpage.s_description;
102 `P
103 "Add a new client and get a capablity back to use for that client to \
104 run shelter sessions.";
105 ]
106 in
107 let info = Cmd.info ~man "add" ~doc in
108 let add () cap_path name =
109 Eio.Switch.run @@ fun sw ->
110 let vat = Capnp_rpc_unix.client_only_vat ~sw env#net in
111 let sr = Capnp_rpc_unix.Cap_file.load vat cap_path |> or_fail in
112 Capnp_rpc_unix.with_cap_exn sr @@ fun service ->
113 let cap = Shelter_common.Admin.add_user service name in
114 Capability.with_ref cap @@ fun client ->
115 let uri = Persistence.save_exn client in
116 Fmt.pr "%a" Uri.pp uri
117 in
118 Cmd.v info Term.(const add $ setup_log $ admin $ username)
119
120let () =
121 Eio_main.run @@ fun env ->
122 let doc = "Shelterd" in
123 let man =
124 [
125 `S Manpage.s_authors;
126 `P "Patrick Ferris";
127 `S Manpage.s_bugs;
128 `P "Email bug reports to <patrick@sirref.org>.";
129 ]
130 in
131 let info = Cmd.info ~doc ~man "shelterd" in
132 let daemon_cmd, daemon_term = daemon env in
133 exit
134 (Cmd.eval @@ Cmd.group ~default:daemon_term info [ daemon_cmd; add_cmd env ])