commit 02d3dff3a83c90353f585ee38191922c07d0e3e3 · anil.recoil.org/bellairs-quest

+6 -2

mvp/ocaml/client/client.ml

···

       2
       2
        
       open Eio.Std

     

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

     

       4
       4
        
       

     

       5
       5
       +
       let pp_file ppf file =

     

       6
       6
       +
         let e = Capability.problem file in

     

       7
       7
       +
         Fmt.pf ppf "[%a:%a]" Capnp_rpc.Capability.pp file

     

       8
       8
       +
           Fmt.(option Capnp_rpc.Exception.pp)

     

       9
       9
       +
           e

     

       10
       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
       80
       -
       

     

       81
       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

mvp/ocaml/server/API.ml

···

       1
       1
       +
       include Schema.Storage.MakeRPC (Capnp_rpc)

+56

mvp/ocaml/server/directory.ml

···

       1
       1
       +
       open Capnp_rpc.Std

     

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

     

       3
       3
       +
       

     

       4
       4
       +
       let local dir =

     

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

     

       6
       6
       +
         Directory.local

     

       7
       7
       +
         @@ object

     

       8
       8
       +
              inherit Directory.service

     

       9
       9
       +
       

     

       10
       10
       +
              method create_impl params release_param_caps =

     

       11
       11
       +
                let open Directory.Create in

     

       12
       12
       +
                let name = Params.name_get params in

     

       13
       13
       +
                release_param_caps ();

     

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

     

       15
       15
       +
                let file = Impl.create dir name in

     

       16
       16
       +
                let file_cap = File.local file in

     

       17
       17
       +
                (* TODO: add persistence *)

     

       18
       18
       +
                Results.file_set results (Some file_cap);

     

       19
       19
       +
                Service.return response

     

       20
       20
       +
       

     

       21
       21
       +
              method list_impl _ release_param_caps =

     

       22
       22
       +
                let open Directory.List in

     

       23
       23
       +
                release_param_caps ();

     

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

     

       25
       25
       +
                let entries = Impl.list dir in

     

       26
       26
       +
                let entries_array =

     

       27
       27
       +
                  Results.entries_init results (List.length entries)

     

       28
       28
       +
                in

     

       29
       29
       +
                List.iteri

     

       30
       30
       +
                  (fun i e ->

     

       31
       31
       +
                    let entry = Capnp.Array.get entries_array i in

     

       32
       32
       +
                    API.Builder.Directory.Entry.name_set entry e.Impl.name;

     

       33
       33
       +
                    API.Builder.Directory.Entry.file_set entry

     

       34
       34
       +
                      (Some (File.local e.Impl.file)))

     

       35
       35
       +
                  entries;

     

       36
       36
       +
                Service.return response

     

       37
       37
       +
       

     

       38
       38
       +
              method open_impl params release_param_caps =

     

       39
       39
       +
                let open Directory.Open in

     

       40
       40
       +
                let name = Params.name_get params in

     

       41
       41
       +
                release_param_caps ();

     

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

     

       43
       43
       +
                try

     

       44
       44
       +
                  let file = Impl.open_ dir name in

     

       45
       45
       +
                  Results.file_set results (Some (File.local file));

     

       46
       46
       +
                  Service.return response

     

       47
       47
       +
                with Not_found -> Service.fail "File '%s' not found" name

     

       48
       48
       +
       

     

       49
       49
       +
              method delete_impl params release_param_caps =

     

       50
       50
       +
                let open Directory.Delete in

     

       51
       51
       +
                let name = Params.name_get params in

     

       52
       52
       +
                release_param_caps ();

     

       53
       53
       +
                let response = Service.Response.create_empty () in

     

       54
       54
       +
                Impl.delete dir name;

     

       55
       55
       +
                Service.return response

     

       56
       56
       +
            end

mvp/ocaml/server/directory.mli

···

       1
       1
       +
       open Capnp_rpc.Std

     

       2
       2
       +
       

     

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

+26

mvp/ocaml/server/file.ml

···

       1
       1
       +
       open Capnp_rpc.Std

     

       2
       2
       +
       

     

       3
       3
       +
       let local file =

     

       4
       4
       +
         let module File = API.Service.File in

     

       5
       5
       +
         File.local

     

       6
       6
       +
         @@ object

     

       7
       7
       +
              inherit File.service

     

       8
       8
       +
       

     

       9
       9
       +
              method read_impl params release_param_caps =

     

       10
       10
       +
                let open File.Read in

     

       11
       11
       +
                let off = Stdint.Int64.of_uint64 (Params.off_get params) in

     

       12
       12
       +
                let len = Stdint.Int64.of_uint64 (Params.len_get params) in

     

       13
       13
       +
                release_param_caps ();

     

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

     

       15
       15
       +
                let data = Impl.read file ~off ~len in

     

       16
       16
       +
                Results.data_set results data;

     

       17
       17
       +
                Service.return response

     

       18
       18
       +
       

     

       19
       19
       +
              method size_impl _ release_param_caps =

     

       20
       20
       +
                let open File.Size in

     

       21
       21
       +
                release_param_caps ();

     

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

     

       23
       23
       +
                let size = Stdint.Int64.to_uint64 (Impl.size file) in

     

       24
       24
       +
                Results.size_set results size;

     

       25
       25
       +
                Service.return response

     

       26
       26
       +
            end

mvp/ocaml/server/file.mli

···

       1
       1
       +
       open Capnp_rpc.Std

     

       2
       2
       +
       

     

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

+31

mvp/ocaml/server/impl.ml

···

       1
       1
       +
       type file = { content : string; size : int64 }

     

       2
       2
       +
       type dir = (string, file) Hashtbl.t

     

       3
       3
       +
       type entry = { name : string; file : file }

     

       4
       4
       +
       

     

       5
       5
       +
       let create files name =

     

       6
       6
       +
         let file = { content = ""; size = 0L } in

     

       7
       7
       +
         Hashtbl.add files name file;

     

       8
       8
       +
         file

     

       9
       9
       +
       

     

       10
       10
       +
       let root () =

     

       11
       11
       +
         let tbl = Hashtbl.create 10 in

     

       12
       12
       +
         let _ = create tbl "foo" in

     

       13
       13
       +
         let _ = create tbl "bar" in

     

       14
       14
       +
         tbl

     

       15
       15
       +
       

     

       16
       16
       +
       let open_ (files : dir) name = Hashtbl.find files name

     

       17
       17
       +
       let delete files name = Hashtbl.remove files name

     

       18
       18
       +
       

     

       19
       19
       +
       let read ?(off = 0L) ?(len = Int64.max_int) file =

     

       20
       20
       +
         let content_len = String.length file.content in

     

       21
       21
       +
         let off = Int64.to_int off in

     

       22
       22
       +
         let len = Int64.to_int len in

     

       23
       23
       +
         let off = max 0 (min off content_len) in

     

       24
       24
       +
         let max_len = content_len - off in

     

       25
       25
       +
         let len = if len >= max_len then max_len else len in

     

       26
       26
       +
         String.sub file.content off len

     

       27
       27
       +
       

     

       28
       28
       +
       let size file = file.size

     

       29
       29
       +
       

     

       30
       30
       +
       let list files =

     

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

mvp/ocaml/server/impl.mli

···

       1
       1
       +
       include Bellairs.Storage

     

       2
       2
       +
       

     

       3
       3
       +
       val root : unit -> dir

+3 -135

mvp/ocaml/server/server.ml

···

       3
       3
        
       

     

       4
       4
        
       let cap_file = "storage.cap"

     

       5
       5
        
       

     

       6
       6
       -
       module API = Schema.Storage.MakeRPC (Capnp_rpc)

     

       7
       7
       -
       open Capnp_rpc.Std

     

       8
       8
       -
       

     

       9
       9
       -
       module Impl : sig

     

       10
       10
       -
         include Bellairs.Storage

     

       11
       11
       -
       

     

       12
       12
       -
         val root : unit -> dir

     

       13
       13
       -
       end = struct

     

       14
       14
       -
         type file = { content : string; size : int64 }

     

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

     

       16
       16
       -
         type entry = { name : string; file : file }

     

       17
       17
       -
       

     

       18
       18
       -
         let create files name =

     

       19
       19
       -
           let file = { content = ""; size = 0L } in

     

       20
       20
       -
           Hashtbl.add files name file;

     

       21
       21
       -
           file

     

       22
       22
       -
       

     

       23
       23
       -
         let root () =

     

       24
       24
       -
           let tbl = Hashtbl.create 10 in

     

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

     

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

     

       27
       27
       -
           tbl

     

       28
       28
       -
       

     

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

     

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

     

       31
       31
       -
       

     

       32
       32
       -
         let read ?(off = 0L) ?(len = Int64.max_int) file =

     

       33
       33
       -
           let content_len = String.length file.content in

     

       34
       34
       -
           let off = Int64.to_int off in

     

       35
       35
       -
           let len = Int64.to_int len in

     

       36
       36
       -
           let off = max 0 (min off content_len) in

     

       37
       37
       -
           let max_len = content_len - off in

     

       38
       38
       -
           let len = if len >= max_len then max_len else len in

     

       39
       39
       -
           String.sub file.content off len

     

       40
       40
       -
       

     

       41
       41
       -
         let size file = file.size

     

       42
       42
       -
       

     

       43
       43
       -
         let list files =

     

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

     

       45
       45
       -
       end

     

       46
       46
       -
       

     

       47
       47
       -
       module File = struct

     

       48
       48
       -
         let local file =

     

       49
       49
       -
           let module File = API.Service.File in

     

       50
       50
       -
           File.local

     

       51
       51
       -
           @@ object

     

       52
       52
       -
                inherit File.service

     

       53
       53
       -
       

     

       54
       54
       -
                method read_impl params release_param_caps =

     

       55
       55
       -
                  let open File.Read in

     

       56
       56
       -
                  let off = Stdint.Int64.of_uint64 (Params.off_get params) in

     

       57
       57
       -
                  let len = Stdint.Int64.of_uint64 (Params.len_get params) in

     

       58
       58
       -
                  release_param_caps ();

     

       59
       59
       -
                  let response, results =

     

       60
       60
       -
                    Service.Response.create Results.init_pointer

     

       61
       61
       -
                  in

     

       62
       62
       -
                  let data = Impl.read file ~off ~len in

     

       63
       63
       -
                  Results.data_set results data;

     

       64
       64
       -
                  Service.return response

     

       65
       65
       -
       

     

       66
       66
       -
                method size_impl _ release_param_caps =

     

       67
       67
       -
                  let open File.Size in

     

       68
       68
       -
                  release_param_caps ();

     

       69
       69
       -
                  let response, results =

     

       70
       70
       -
                    Service.Response.create Results.init_pointer

     

       71
       71
       -
                  in

     

       72
       72
       -
                  let size = Stdint.Int64.to_uint64 (Impl.size file) in

     

       73
       73
       -
                  Results.size_set results size;

     

       74
       74
       -
                  Service.return response

     

       75
       75
       -
              end

     

       76
       76
       -
       end

     

       77
       77
       -
       

     

       78
       78
       -
       module Directory = struct

     

       79
       79
       -
         let local dir =

     

       80
       80
       -
           let module Directory = API.Service.Directory in

     

       81
       81
       -
           Directory.local

     

       82
       82
       -
           @@ object

     

       83
       83
       -
                inherit Directory.service

     

       84
       84
       -
       

     

       85
       85
       -
                method create_impl params release_param_caps =

     

       86
       86
       -
                  let open Directory.Create in

     

       87
       87
       -
                  let name = Params.name_get params in

     

       88
       88
       -
                  release_param_caps ();

     

       89
       89
       -
                  let response, results =

     

       90
       90
       -
                    Service.Response.create Results.init_pointer

     

       91
       91
       -
                  in

     

       92
       92
       -
                  let file = Impl.create dir name in

     

       93
       93
       -
                  Results.file_set results (Some (File.local file));

     

       94
       94
       -
                  Service.return response

     

       95
       95
       -
       

     

       96
       96
       -
                method list_impl _ release_param_caps =

     

       97
       97
       -
                  let open Directory.List in

     

       98
       98
       -
                  release_param_caps ();

     

       99
       99
       -
                  let response, results =

     

       100
       100
       -
                    Service.Response.create Results.init_pointer

     

       101
       101
       -
                  in

     

       102
       102
       -
                  let entries = Impl.list dir in

     

       103
       103
       -
                  let entries_array =

     

       104
       104
       -
                    Results.entries_init results (List.length entries)

     

       105
       105
       -
                  in

     

       106
       106
       -
                  List.iteri

     

       107
       107
       -
                    (fun i e ->

     

       108
       108
       -
                      let entry = Capnp.Array.get entries_array i in

     

       109
       109
       -
                      API.Builder.Directory.Entry.name_set entry e.Impl.name;

     

       110
       110
       -
                      API.Builder.Directory.Entry.file_set entry

     

       111
       111
       -
                        (Some (File.local e.Impl.file)))

     

       112
       112
       -
                    entries;

     

       113
       113
       -
                  Service.return response

     

       114
       114
       -
       

     

       115
       115
       -
                method open_impl params release_param_caps =

     

       116
       116
       -
                  let open Directory.Open in

     

       117
       117
       -
                  let name = Params.name_get params in

     

       118
       118
       -
                  release_param_caps ();

     

       119
       119
       -
                  let response, results =

     

       120
       120
       -
                    Service.Response.create Results.init_pointer

     

       121
       121
       -
                  in

     

       122
       122
       -
                  try

     

       123
       123
       -
                    let file = Impl.open_ dir name in

     

       124
       124
       -
                    Results.file_set results (Some (File.local file));

     

       125
       125
       -
                    Service.return response

     

       126
       126
       -
                  with Not_found -> Service.fail "File '%s' not found" name

     

       127
       127
       -
       

     

       128
       128
       -
                method delete_impl params release_param_caps =

     

       129
       129
       -
                  let open Directory.Delete in

     

       130
       130
       -
                  let name = Params.name_get params in

     

       131
       131
       -
                  release_param_caps ();

     

       132
       132
       -
                  let response = Service.Response.create_empty () in

     

       133
       133
       -
                  Impl.delete dir name;

     

       134
       134
       -
                  Service.return response

     

       135
       135
       -
              end

     

       136
       136
       -
       end

     

       137
       137
       -
       

     

       138
       6
        
       let serve config =

     

       139
       7
        
         Switch.run @@ fun sw ->

     

       140
       140
       -
         let service_id = Capnp_rpc_unix.Vat_config.derived_id config "main" in

     

       141
       141
       -
         let restore = Restorer.single service_id (Directory.local (Impl.root ())) in

     

       8
       8
       +
         let root_id = Capnp_rpc_unix.Vat_config.derived_id config "root" in

     

       9
       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
       143
       -
         match Capnp_rpc_unix.Cap_file.save_service vat service_id cap_file with

     

       11
       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;