···

       
10
       
10
       
 
       
  val size : file -> int64

     

       
11
       
11
       
 
       
  val read : ?off:int64 -> ?len:int64 -> file -> string

     

       
12
       
12
       
 
       
  val write : ?off:int64 -> ?len:int64 -> file -> string -> unit

     

       
13
       
13
       
+
       


     

       
14
       
14
       
+
       
  (* FIXME: not totally sure if that should be here *)

     

       
15
       
15
       
+
       
  val share : file -> Uri.t

     

       
13
       
16
       
 
       
end

     

       
14
       
17
       
 
       


     

       
15
       
18
       
 
       
module type Sigs = sig

     

···

       
8
       
8
       
 
       
  Capnp_rpc_unix.with_cap_exn client f

     

       
9
       
9
       
 
       


     

       
10
       
10
       
 
       
let pp_name ppf name = Fmt.pf ppf "%a" Fmt.(styled `Bold string) name

     

       
11
       
11
       
-
       


     

       
12
       
12
       
-
       
let pp_entry ppf { Storage.name; file } =

     

       
13
       
13
       
-
       
  Fmt.pf ppf "%a:%a" pp_name name Capability.pp file

     

       
11
       
11
       
+
       
let pp_uri ppf id = Fmt.pf ppf "%a" Fmt.(styled `Yellow Uri.pp) id

     

       
12
       
12
       
+
       
let pp_entry ppf { Storage.name; _ } = Fmt.pf ppf "%a" pp_name name

     

       
14
       
13
       
 
       


     

       
15
       
14
       
 
       
let ls net () uri =

     

       
16
       
15
       
 
       
  connect net uri @@ fun dir ->

     
···

       
25
       
24
       
 
       
  Storage.write file data;

     

       
26
       
25
       
 
       
  Fmt.pr "%a is created.\n%!" pp_name name

     

       
27
       
26
       
 
       


     

       
28
       
28
       
-
       
let open_file net () uri name =

     

       
27
       
27
       
+
       
let share net () uri name =

     

       
29
       
28
       
 
       
  connect net uri @@ fun dir ->

     

       
30
       
30
       
-
       
  let _file = Storage.open_ dir name in

     

       
31
       
31
       
-
       
  Fmt.pr "%a: <raw>.\n%!" pp_name name

     

       
29
       
29
       
+
       
  Capability.with_ref (Storage.open_ dir name) @@ fun file ->

     

       
30
       
30
       
+
       
  let uri = Storage.share file in

     

       
31
       
31
       
+
       
  Fmt.pr "%a\n%!" pp_uri uri

     

       
32
       
32
       
 
       


     

       
33
       
33
       
 
       
let delete net () uri name =

     

       
34
       
34
       
 
       
  connect net uri @@ fun dir ->

     
···

       
110
       
110
       
 
       
    Term.(

     

       
111
       
111
       
 
       
      const (create env#net) $ setup_log $ connect_addr $ name_arg $ data_arg)

     

       
112
       
112
       
 
       


     

       
113
       
113
       
-
       
let open_cmd env =

     

       
113
       
113
       
+
       
let share_cmd env =

     

       
114
       
114
       
 
       
  let doc = "Open an existing file and show its ID" in

     

       
115
       
115
       
-
       
  let info = Cmd.info "open" ~doc in

     

       
116
       
116
       
-
       
  Cmd.v info

     

       
117
       
117
       
-
       
    Term.(const (open_file env#net) $ setup_log $ connect_addr $ name_arg)

     

       
115
       
115
       
+
       
  let info = Cmd.info "share" ~doc in

     

       
116
       
116
       
+
       
  Cmd.v info Term.(const (share env#net) $ setup_log $ connect_addr $ name_arg)

     

       
118
       
117
       
 
       


     

       
119
       
118
       
 
       
let delete_cmd env =

     

       
120
       
119
       
 
       
  let doc = "Delete a file" in

     
···

       
149
       
148
       
 
       
    [

     

       
150
       
149
       
 
       
      ls_cmd env;

     

       
151
       
150
       
 
       
      create_cmd env;

     

       
152
       
152
       
-
       
      open_cmd env;

     

       
151
       
151
       
+
       
      share_cmd env;

     

       
153
       
152
       
 
       
      delete_cmd env;

     

       
154
       
153
       
 
       
      size_cmd env;

     

       
155
       
154
       
 
       
      read_cmd env;

     

···

       
35
       
35
       
 
       
  let open API.Client.Directory.Delete in

     

       
36
       
36
       
 
       
  let request, params = Capability.Request.create Params.init_pointer in

     

       
37
       
37
       
 
       
  Params.name_set params name;

     

       
38
       
38
       
-
       
  let _ = Capability.call_for_value_exn t method_id request in

     

       
39
       
39
       
-
       
  ()

     

       
38
       
38
       
+
       
  Capability.call_for_unit_exn t method_id request

     

       
40
       
39
       
 
       


     

       
41
       
40
       
 
       
let size t =

     

       
42
       
41
       
 
       
  let open API.Client.File.Size in

     

       
43
       
42
       
 
       
  let request = Capability.Request.create_no_args () in

     

       
44
       
43
       
 
       
  let results = Capability.call_for_value_exn t method_id request in

     

       
45
       
44
       
 
       
  Stdint.Int64.of_uint64 (Results.size_get results)

     

       
45
       
45
       
+
       


     

       
46
       
46
       
+
       
let share t =

     

       
47
       
47
       
+
       
  let open API.Client.File.Share in

     

       
48
       
48
       
+
       
  let request = Capability.Request.create_no_args () in

     

       
49
       
49
       
+
       
  let results = Capability.call_for_value_exn t method_id request in

     

       
50
       
50
       
+
       
  Uri.of_string (Results.uri_get results)

     

       
46
       
51
       
 
       


     

       
47
       
52
       
 
       
let opt_set f params = function

     

       
48
       
53
       
 
       
  | None -> ()

     

···

       
1
       
1
       
 
       
open Capnp_rpc.Std

     

       
2
       
2
       
 
       
module API = Schema.Storage.MakeRPC (Capnp_rpc)

     

       
3
       
3
       
 
       


     

       
4
       
4
       
-
       
let local sr dir =

     

       
4
       
4
       
+
       
let local dir =

     

       
5
       
5
       
 
       
  let module Directory = API.Service.Directory in

     

       
6
       
6
       
-
       
  Capnp_rpc.Persistence.with_sturdy_ref sr Directory.local

     

       
6
       
6
       
+
       
  Directory.local

     

       
7
       
7
       
 
       
  @@ object

     

       
8
       
8
       
 
       
       inherit Directory.service

     

       
9
       
9
       
 
       


     

···

       
1
       
1
       
-
       
open Capnp_rpc

     

       
2
       
1
       
 
       
open Bellairs

     

       
2
       
2
       
+
       
open Capnp_rpc

     

       
3
       
3
       
 
       


     

       
4
       
4
       
-
       
val local :

     

       
5
       
5
       
-
       
  API.Service.Directory.t Sturdy_ref.t ->

     

       
6
       
6
       
-
       
  Impl.dir ->

     

       
7
       
7
       
-
       
  API.Service.Directory.t Capability.t

     

       
4
       
4
       
+
       
val local : Impl.dir -> API.Service.Directory.t Capability.t

     

···

       
1
       
1
       
-
       
open Capnp_rpc.Std

     

       
2
       
1
       
 
       
open Bellairs

     

       
2
       
2
       
+
       
open Capnp_rpc.Std

     

       
3
       
3
       
 
       


     

       
4
       
4
       
 
       
let int64_of_uint64 n =

     

       
5
       
5
       
 
       
  match Stdint.Int64.of_uint64 n with -1L -> None | i -> Some i

     
···

       
7
       
7
       
 
       
let local file =

     

       
8
       
8
       
 
       
  let module File = API.Service.File in

     

       
9
       
9
       
 
       
  File.local

     

       
10
       
10
       
-
       
  @@ object

     

       
10
       
10
       
+
       
  @@ object (self)

     

       
11
       
11
       
 
       
       inherit File.service

     

       
12
       
12
       
+
       


     

       
13
       
13
       
+
       
       method share_impl _params release_param_caps =

     

       
14
       
14
       
+
       
         let open File.Share in

     

       
15
       
15
       
+
       
         release_param_caps ();

     

       
16
       
16
       
+
       
         let response, results = Service.Response.create Results.init_pointer in

     

       
17
       
17
       
+
       
         let uri = Capnp_rpc.Persistence.save_exn (File.local self) in

     

       
18
       
18
       
+
       
         Results.uri_set results (Uri.to_string uri);

     

       
19
       
19
       
+
       
         Service.return response

     

       
12
       
20
       
 
       


     

       
13
       
21
       
 
       
       method read_impl params release_param_caps =

     

       
14
       
22
       
 
       
         let open File.Read in

     

···

       
1
       
1
       
-
       
open Capnp_rpc

     

       
2
       
1
       
 
       
open Bellairs

     

       
2
       
2
       
+
       
open Capnp_rpc

     

       
3
       
3
       
 
       


     

       
4
       
4
       
 
       
val local : Impl.file -> API.Service.File.t Capability.t

     

···

       
2
       
2
       
 
       
   in-memory database *)

     

       
3
       
3
       
 
       


     

       
4
       
4
       
 
       
type file = { mutable content : string }

     

       
5
       
5
       
-
       
type dir = (string, file) Hashtbl.t

     

       
5
       
5
       
+
       
type dir = { files : (string, file) Hashtbl.t }

     

       
6
       
6
       
 
       
type entry = { name : string; file : file }

     

       
7
       
7
       
 
       


     

       
8
       
8
       
-
       
let create files name =

     

       
8
       
8
       
+
       
let create { files } name =

     

       
9
       
9
       
 
       
  let file = { content = "" } in

     

       
10
       
10
       
 
       
  Hashtbl.add files name file;

     

       
11
       
11
       
 
       
  file

     

       
12
       
12
       
 
       


     

       
13
       
13
       
-
       
let root () =

     

       
14
       
14
       
-
       
  let tbl = Hashtbl.create 10 in

     

       
15
       
15
       
-
       
  let _ = create tbl "foo" in

     

       
16
       
16
       
-
       
  let _ = create tbl "bar" in

     

       
17
       
17
       
-
       
  tbl

     

       
18
       
18
       
-
       


     

       
19
       
19
       
-
       
let open_ (files : dir) name = Hashtbl.find files name

     

       
20
       
20
       
-
       
let delete files name = Hashtbl.remove files name

     

       
13
       
13
       
+
       
let root () = { files = Hashtbl.create 10 }

     

       
14
       
14
       
+
       
let open_ dir name = Hashtbl.find dir.files name

     

       
15
       
15
       
+
       
let delete dir name = Hashtbl.remove dir.files name

     

       
21
       
16
       
 
       


     

       
22
       
17
       
 
       
let read ?(off = 0L) ?len file =

     

       
23
       
18
       
 
       
  let content_len = String.length file.content in

     
···

       
47
       
42
       
 
       


     

       
48
       
43
       
 
       
let size file = Int64.of_int (String.length file.content)

     

       
49
       
44
       
 
       


     

       
50
       
50
       
-
       
let list files =

     

       
51
       
51
       
-
       
  Hashtbl.fold (fun name file acc -> { name; file } :: acc) files []

     

       
45
       
45
       
+
       
let list dir =

     

       
46
       
46
       
+
       
  Hashtbl.fold (fun name file acc -> { name; file } :: acc) dir.files []

     

       
47
       
47
       
+
       


     

       
48
       
48
       
+
       
(* this is done in another layer *)

     

       
49
       
49
       
+
       
let share _ = assert false

     

···

       
9
       
9
       
 
       
  let services = Restorer.Table.create ~sw make_sturdy in

     

       
10
       
10
       
 
       
  let restore = Restorer.of_table services in

     

       
11
       
11
       
 
       
  let root_id = Capnp_rpc_unix.Vat_config.derived_id config "root" in

     

       
12
       
12
       
-
       
  let root =

     

       
13
       
13
       
-
       
    let sr = Capnp_rpc_net.Restorer.Table.sturdy_ref services root_id in

     

       
14
       
14
       
-
       
    Directory.local sr (Impl.root ())

     

       
15
       
15
       
-
       
  in

     

       
12
       
12
       
+
       
  let root = Directory.local (Impl.root ()) in

     

       
16
       
13
       
 
       
  Restorer.Table.add services root_id root;

     

       
17
       
14
       
 
       
  let vat = Capnp_rpc_unix.serve ~sw ~restore config in

     

       
18
       
15
       
 
       
  match Capnp_rpc_unix.Cap_file.save_service vat root_id cap_file with

     

···

       
24
       
24
       
 
       
interface File {

     

       
25
       
25
       
 
       
  # Represents a file in the filesystem

     

       
26
       
26
       
 
       


     

       
27
       
27
       
-
       
  size @0 () -> (size :UInt64);

     

       
28
       
28
       
-
       
  # Returns the size of the file in bytes

     

       
29
       
29
       
-
       


     

       
30
       
30
       
-
       
  read @1 (off :UInt64 = 0, len :UInt64 = 0xffffffffffffffff) -> (data :Data);

     

       
27
       
27
       
+
       
  read @0 (off :UInt64 = 0, len :UInt64 = 0xffffffffffffffff) -> (data :Data);

     

       
31
       
28
       
 
       
  # Reads data from the file, optionally starting at offset and reading up to len bytes

     

       
32
       
29
       
 
       
  # Default is to read the entire file

     

       
33
       
30
       
 
       


     

       
31
       
31
       
+
       
  size @1 () -> (size :UInt64);

     

       
32
       
32
       
+
       
  # Returns the size of the file in bytes

     

       
33
       
33
       
+
       


     

       
34
       
34
       
 
       
  write @2 (off :UInt64 = 0, len :UInt64 = 0xffffffffffffffff, data :Data) -> ();

     

       
35
       
35
       
 
       
  # Write data to the file, optionally starting at offset and reading up to len bytes

     

       
36
       
36
       
 
       
  # Default is to write the entire file

     

       
37
       
37
       
+
       


     

       
38
       
38
       
+
       
  share @3 () -> (uri: Text);

     

       
37
       
39
       
 
       
}