this repo has no description
Move things aronund on the server side
+132
-137
+6
-2
mvp/ocaml/client/client.ml
+6
-2
mvp/ocaml/client/client.ml
···
2
2
open Eio.Std
3
3
module API = Schema.Storage.MakeRPC (Capnp_rpc)
4
4
5
+
let pp_file ppf file =
6
+
let e = Capability.problem file in
7
+
Fmt.pf ppf "[%a:%a]" Capnp_rpc.Capability.pp file
8
+
Fmt.(option Capnp_rpc.Exception.pp)
9
+
e
10
+
5
11
module Storage :
6
12
Bellairs.Storage
7
13
with type file = API.Client.File.t Capability.t
···
77
83
let client_vat = Capnp_rpc_unix.client_only_vat ~sw net in
78
84
let client = Capnp_rpc_unix.Vat.import_exn client_vat uri in
79
85
Capnp_rpc_unix.with_cap_exn client f
80
-
81
-
let pp_file ppf file = Fmt.pf ppf "[%a]" Capnp_rpc.Capability.pp file
82
86
83
87
let pp_entry ppf entry =
84
88
Fmt.pf ppf "%s:%a" entry.Storage.name pp_file entry.file
+1
mvp/ocaml/server/API.ml
+1
mvp/ocaml/server/API.ml
···
1
+
include Schema.Storage.MakeRPC (Capnp_rpc)
+56
mvp/ocaml/server/directory.ml
+56
mvp/ocaml/server/directory.ml
···
1
+
open Capnp_rpc.Std
2
+
module API = Schema.Storage.MakeRPC (Capnp_rpc)
3
+
4
+
let local dir =
5
+
let module Directory = API.Service.Directory in
6
+
Directory.local
7
+
@@ object
8
+
inherit Directory.service
9
+
10
+
method create_impl params release_param_caps =
11
+
let open Directory.Create in
12
+
let name = Params.name_get params in
13
+
release_param_caps ();
14
+
let response, results = Service.Response.create Results.init_pointer in
15
+
let file = Impl.create dir name in
16
+
let file_cap = File.local file in
17
+
(* TODO: add persistence *)
18
+
Results.file_set results (Some file_cap);
19
+
Service.return response
20
+
21
+
method list_impl _ release_param_caps =
22
+
let open Directory.List in
23
+
release_param_caps ();
24
+
let response, results = Service.Response.create Results.init_pointer in
25
+
let entries = Impl.list dir in
26
+
let entries_array =
27
+
Results.entries_init results (List.length entries)
28
+
in
29
+
List.iteri
30
+
(fun i e ->
31
+
let entry = Capnp.Array.get entries_array i in
32
+
API.Builder.Directory.Entry.name_set entry e.Impl.name;
33
+
API.Builder.Directory.Entry.file_set entry
34
+
(Some (File.local e.Impl.file)))
35
+
entries;
36
+
Service.return response
37
+
38
+
method open_impl params release_param_caps =
39
+
let open Directory.Open in
40
+
let name = Params.name_get params in
41
+
release_param_caps ();
42
+
let response, results = Service.Response.create Results.init_pointer in
43
+
try
44
+
let file = Impl.open_ dir name in
45
+
Results.file_set results (Some (File.local file));
46
+
Service.return response
47
+
with Not_found -> Service.fail "File '%s' not found" name
48
+
49
+
method delete_impl params release_param_caps =
50
+
let open Directory.Delete in
51
+
let name = Params.name_get params in
52
+
release_param_caps ();
53
+
let response = Service.Response.create_empty () in
54
+
Impl.delete dir name;
55
+
Service.return response
56
+
end
+3
mvp/ocaml/server/directory.mli
+3
mvp/ocaml/server/directory.mli
+26
mvp/ocaml/server/file.ml
+26
mvp/ocaml/server/file.ml
···
1
+
open Capnp_rpc.Std
2
+
3
+
let local file =
4
+
let module File = API.Service.File in
5
+
File.local
6
+
@@ object
7
+
inherit File.service
8
+
9
+
method read_impl params release_param_caps =
10
+
let open File.Read in
11
+
let off = Stdint.Int64.of_uint64 (Params.off_get params) in
12
+
let len = Stdint.Int64.of_uint64 (Params.len_get params) in
13
+
release_param_caps ();
14
+
let response, results = Service.Response.create Results.init_pointer in
15
+
let data = Impl.read file ~off ~len in
16
+
Results.data_set results data;
17
+
Service.return response
18
+
19
+
method size_impl _ release_param_caps =
20
+
let open File.Size in
21
+
release_param_caps ();
22
+
let response, results = Service.Response.create Results.init_pointer in
23
+
let size = Stdint.Int64.to_uint64 (Impl.size file) in
24
+
Results.size_set results size;
25
+
Service.return response
26
+
end
+3
mvp/ocaml/server/file.mli
+3
mvp/ocaml/server/file.mli
+31
mvp/ocaml/server/impl.ml
+31
mvp/ocaml/server/impl.ml
···
1
+
type file = { content : string; size : int64 }
2
+
type dir = (string, file) Hashtbl.t
3
+
type entry = { name : string; file : file }
4
+
5
+
let create files name =
6
+
let file = { content = ""; size = 0L } in
7
+
Hashtbl.add files name file;
8
+
file
9
+
10
+
let root () =
11
+
let tbl = Hashtbl.create 10 in
12
+
let _ = create tbl "foo" in
13
+
let _ = create tbl "bar" in
14
+
tbl
15
+
16
+
let open_ (files : dir) name = Hashtbl.find files name
17
+
let delete files name = Hashtbl.remove files name
18
+
19
+
let read ?(off = 0L) ?(len = Int64.max_int) file =
20
+
let content_len = String.length file.content in
21
+
let off = Int64.to_int off in
22
+
let len = Int64.to_int len in
23
+
let off = max 0 (min off content_len) in
24
+
let max_len = content_len - off in
25
+
let len = if len >= max_len then max_len else len in
26
+
String.sub file.content off len
27
+
28
+
let size file = file.size
29
+
30
+
let list files =
31
+
Hashtbl.fold (fun name file acc -> { name; file } :: acc) files []
+3
-135
mvp/ocaml/server/server.ml
+3
-135
mvp/ocaml/server/server.ml
···
3
3
4
4
let cap_file = "storage.cap"
5
5
6
-
module API = Schema.Storage.MakeRPC (Capnp_rpc)
7
-
open Capnp_rpc.Std
8
-
9
-
module Impl : sig
10
-
include Bellairs.Storage
11
-
12
-
val root : unit -> dir
13
-
end = struct
14
-
type file = { content : string; size : int64 }
15
-
type dir = (string, file) Hashtbl.t
16
-
type entry = { name : string; file : file }
17
-
18
-
let create files name =
19
-
let file = { content = ""; size = 0L } in
20
-
Hashtbl.add files name file;
21
-
file
22
-
23
-
let root () =
24
-
let tbl = Hashtbl.create 10 in
25
-
let _ = create tbl "foo" in
26
-
let _ = create tbl "bar" in
27
-
tbl
28
-
29
-
let open_ (files : dir) name = Hashtbl.find files name
30
-
let delete files name = Hashtbl.remove files name
31
-
32
-
let read ?(off = 0L) ?(len = Int64.max_int) file =
33
-
let content_len = String.length file.content in
34
-
let off = Int64.to_int off in
35
-
let len = Int64.to_int len in
36
-
let off = max 0 (min off content_len) in
37
-
let max_len = content_len - off in
38
-
let len = if len >= max_len then max_len else len in
39
-
String.sub file.content off len
40
-
41
-
let size file = file.size
42
-
43
-
let list files =
44
-
Hashtbl.fold (fun name file acc -> { name; file } :: acc) files []
45
-
end
46
-
47
-
module File = struct
48
-
let local file =
49
-
let module File = API.Service.File in
50
-
File.local
51
-
@@ object
52
-
inherit File.service
53
-
54
-
method read_impl params release_param_caps =
55
-
let open File.Read in
56
-
let off = Stdint.Int64.of_uint64 (Params.off_get params) in
57
-
let len = Stdint.Int64.of_uint64 (Params.len_get params) in
58
-
release_param_caps ();
59
-
let response, results =
60
-
Service.Response.create Results.init_pointer
61
-
in
62
-
let data = Impl.read file ~off ~len in
63
-
Results.data_set results data;
64
-
Service.return response
65
-
66
-
method size_impl _ release_param_caps =
67
-
let open File.Size in
68
-
release_param_caps ();
69
-
let response, results =
70
-
Service.Response.create Results.init_pointer
71
-
in
72
-
let size = Stdint.Int64.to_uint64 (Impl.size file) in
73
-
Results.size_set results size;
74
-
Service.return response
75
-
end
76
-
end
77
-
78
-
module Directory = struct
79
-
let local dir =
80
-
let module Directory = API.Service.Directory in
81
-
Directory.local
82
-
@@ object
83
-
inherit Directory.service
84
-
85
-
method create_impl params release_param_caps =
86
-
let open Directory.Create in
87
-
let name = Params.name_get params in
88
-
release_param_caps ();
89
-
let response, results =
90
-
Service.Response.create Results.init_pointer
91
-
in
92
-
let file = Impl.create dir name in
93
-
Results.file_set results (Some (File.local file));
94
-
Service.return response
95
-
96
-
method list_impl _ release_param_caps =
97
-
let open Directory.List in
98
-
release_param_caps ();
99
-
let response, results =
100
-
Service.Response.create Results.init_pointer
101
-
in
102
-
let entries = Impl.list dir in
103
-
let entries_array =
104
-
Results.entries_init results (List.length entries)
105
-
in
106
-
List.iteri
107
-
(fun i e ->
108
-
let entry = Capnp.Array.get entries_array i in
109
-
API.Builder.Directory.Entry.name_set entry e.Impl.name;
110
-
API.Builder.Directory.Entry.file_set entry
111
-
(Some (File.local e.Impl.file)))
112
-
entries;
113
-
Service.return response
114
-
115
-
method open_impl params release_param_caps =
116
-
let open Directory.Open in
117
-
let name = Params.name_get params in
118
-
release_param_caps ();
119
-
let response, results =
120
-
Service.Response.create Results.init_pointer
121
-
in
122
-
try
123
-
let file = Impl.open_ dir name in
124
-
Results.file_set results (Some (File.local file));
125
-
Service.return response
126
-
with Not_found -> Service.fail "File '%s' not found" name
127
-
128
-
method delete_impl params release_param_caps =
129
-
let open Directory.Delete in
130
-
let name = Params.name_get params in
131
-
release_param_caps ();
132
-
let response = Service.Response.create_empty () in
133
-
Impl.delete dir name;
134
-
Service.return response
135
-
end
136
-
end
137
-
138
6
let serve config =
139
7
Switch.run @@ fun sw ->
140
-
let service_id = Capnp_rpc_unix.Vat_config.derived_id config "main" in
141
-
let restore = Restorer.single service_id (Directory.local (Impl.root ())) in
8
+
let root_id = Capnp_rpc_unix.Vat_config.derived_id config "root" in
9
+
let restore = Restorer.single root_id (Directory.local (Impl.root ())) in
142
10
let vat = Capnp_rpc_unix.serve ~sw ~restore config in
143
-
match Capnp_rpc_unix.Cap_file.save_service vat service_id cap_file with
11
+
match Capnp_rpc_unix.Cap_file.save_service vat root_id cap_file with
144
12
| Error (`Msg m) -> failwith m
145
13
| Ok () ->
146
14
traceln "Server running. Connect using %S." cap_file;