commit 746775d1eb35ed21968b1df62733d74026833a07 · anil.recoil.org/bellairs-quest

+151 -17

mvp/ocaml/client/client.ml

···

       1
       1
        
       open Capnp_rpc.Std

     

       2
       2
        
       open Eio.Std

     

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

     

       3
       4
        
       

     

       4
       5
        
       module Storage :

     

       5
       6
        
         Bellairs.Storage

     

       6
       6
       -
           with type file = [ `File_e62ce624f782d37e ] Capability.t

     

       7
       7
       -
            and type dir = [ `Directory_8e98f5ea254aace5 ] Capability.t = struct

     

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

     

       9
       9
       -
       

     

       7
       7
       +
           with type file = API.Client.File.t Capability.t

     

       8
       8
       +
            and type dir = API.Client.Directory.t Capability.t = struct

     

       10
       9
        
         type file = API.Client.File.t Capability.t

     

       11
       10
        
         type dir = API.Client.Directory.t Capability.t

     

       12
       11
        
         type entry = { name : string; file : file }

     
···

       18
       17
        
           | Some file -> { name; file }

     

       19
       18
        
           | None -> failwith "missing entry.file"

     

       20
       19
        
       

     

       21
       21
       -
         let todo msg = failwith ("Storage." ^ msg)

     

       22
       22
       -
       

     

       23
       20
        
         let list t =

     

       24
       21
        
           let open API.Client.Directory.List in

     

       25
       22
        
           let request = Capability.Request.create_no_args () in

     
···

       27
       24
        
           let entries = Results.entries_get_list results in

     

       28
       25
        
           List.map entry entries

     

       29
       26
        
       

     

       30
       30
       -
         let create _ = todo "create"

     

       31
       31
       -
         let open_ _ = todo "open"

     

       32
       32
       -
         let delete _ = todo "delete"

     

       33
       33
       -
         let size _ = todo "size"

     

       34
       34
       -
         let read ?off:_ ?len:_ _ = todo "read"

     

       27
       27
       +
         let create t name =

     

       28
       28
       +
           let open API.Client.Directory.Create in

     

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

     

       30
       30
       +
           Params.name_set params name;

     

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

     

       32
       32
       +
           match Results.file_get results with

     

       33
       33
       +
           | Some file -> file

     

       34
       34
       +
           | None -> failwith "create: no file returned"

     

       35
       35
       +
       

     

       36
       36
       +
         let open_ t name =

     

       37
       37
       +
           let open API.Client.Directory.Open in

     

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

     

       39
       39
       +
           Params.name_set params name;

     

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

     

       41
       41
       +
           match Results.file_get results with

     

       42
       42
       +
           | Some file -> file

     

       43
       43
       +
           | None -> failwith "open: no file returned"

     

       44
       44
       +
       

     

       45
       45
       +
         let delete t name =

     

       46
       46
       +
           let open API.Client.Directory.Delete in

     

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

     

       48
       48
       +
           Params.name_set params name;

     

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

     

       50
       50
       +
           ()

     

       51
       51
       +
       

     

       52
       52
       +
         let size t =

     

       53
       53
       +
           let open API.Client.File.Size in

     

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

     

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

     

       56
       56
       +
           Stdint.Int64.of_uint64 (Results.size_get results)

     

       57
       57
       +
       

     

       58
       58
       +
         let read ?off ?len t =

     

       59
       59
       +
           let open API.Client.File.Read in

     

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

     

       61
       61
       +
           let () =

     

       62
       62
       +
             match off with

     

       63
       63
       +
             | None -> ()

     

       64
       64
       +
             | Some off -> Params.off_set params (Stdint.Int64.to_uint64 off)

     

       65
       65
       +
           in

     

       66
       66
       +
           let () =

     

       67
       67
       +
             match len with

     

       68
       68
       +
             | None -> ()

     

       69
       69
       +
             | Some len -> Params.len_set params (Stdint.Int64.to_uint64 len)

     

       70
       70
       +
           in

     

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

     

       72
       72
       +
           Results.data_get results

     

       35
       73
        
       end

     

       36
       74
        
       

     

       37
       37
       -
       let ls net uri =

     

       75
       75
       +
       let connect net uri f =

     

       38
       76
        
         Switch.run @@ fun sw ->

     

       39
       77
        
         let client_vat = Capnp_rpc_unix.client_only_vat ~sw net in

     

       40
       40
       -
         let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in

     

       41
       41
       -
         let entries = Capnp_rpc_unix.with_cap_exn sr Storage.list in

     

       42
       42
       -
         List.iter (fun { Storage.name; _ } -> Fmt.pr "- %s\n" name) entries

     

       78
       78
       +
         let client = Capnp_rpc_unix.Vat.import_exn client_vat uri in

     

       79
       79
       +
         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
       82
       +
       

     

       83
       83
       +
       let pp_entry ppf entry =

     

       84
       84
       +
         Fmt.pf ppf "%s:%a" entry.Storage.name pp_file entry.file

     

       85
       85
       +
       

     

       86
       86
       +
       let ls net uri =

     

       87
       87
       +
         connect net uri @@ fun dir ->

     

       88
       88
       +
         let entries = Storage.list dir in

     

       89
       89
       +
         Printf.printf "total %d:\n" (List.length entries);

     

       90
       90
       +
         List.iter (Fmt.pr "- %a\n" pp_entry) entries;

     

       91
       91
       +
         Fmt.pr "%!"

     

       92
       92
       +
       

     

       93
       93
       +
       let create net uri name =

     

       94
       94
       +
         connect net uri @@ fun dir ->

     

       95
       95
       +
         let file = Storage.create dir name in

     

       96
       96
       +
         Fmt.pr "Created file '%s': %a\n" name pp_file file

     

       97
       97
       +
       

     

       98
       98
       +
       let open_file net uri name =

     

       99
       99
       +
         connect net uri @@ fun dir ->

     

       100
       100
       +
         let file = Storage.open_ dir name in

     

       101
       101
       +
         Fmt.pr "Opened file '%s': %a\n" name pp_file file

     

       102
       102
       +
       

     

       103
       103
       +
       let delete net uri name =

     

       104
       104
       +
         connect net uri @@ fun dir ->

     

       105
       105
       +
         Storage.delete dir name;

     

       106
       106
       +
         Fmt.pr "Deleted file '%s'\n" name

     

       107
       107
       +
       

     

       108
       108
       +
       let size net uri name =

     

       109
       109
       +
         connect net uri @@ fun dir ->

     

       110
       110
       +
         let file = Storage.open_ dir name in

     

       111
       111
       +
         let size = Storage.size file in

     

       112
       112
       +
         Fmt.pr "Size of '%s': %Ld bytes\n" name size

     

       113
       113
       +
       

     

       114
       114
       +
       let read net addr name offset length =

     

       115
       115
       +
         connect net addr @@ fun dir ->

     

       116
       116
       +
         let file = Storage.open_ dir name in

     

       117
       117
       +
         let data = Storage.read ?off:offset ?len:length file in

     

       118
       118
       +
         Printf.printf "Contents of '%s':\n%s\n" name data

     

       43
       119
        
       

     

       44
       120
        
       open Cmdliner

     

       45
       121
        
       

     
···

       51
       127
        
         let i = Arg.info [] ~docv:"ADDR" ~doc:"Address of server (capnp://...)" in

     

       52
       128
        
         Arg.(required @@ pos 0 (some Capnp_rpc_unix.sturdy_uri) None i)

     

       53
       129
        
       

     

       130
       130
       +
       let name_arg =

     

       131
       131
       +
         let i = Arg.info [] ~docv:"NAME" ~doc:"Name of the file" in

     

       132
       132
       +
         Arg.(required @@ pos 1 (some string) None i)

     

       133
       133
       +
       

     

       134
       134
       +
       let offset_arg =

     

       135
       135
       +
         let i =

     

       136
       136
       +
           Arg.info [ "o"; "offset" ] ~docv:"OFFSET"

     

       137
       137
       +
             ~doc:"Offset from where to start reading (default: 0)"

     

       138
       138
       +
         in

     

       139
       139
       +
         Arg.(value @@ opt (some int64) None i)

     

       140
       140
       +
       

     

       141
       141
       +
       let length_arg =

     

       142
       142
       +
         let i =

     

       143
       143
       +
           Arg.info [ "l"; "length" ] ~docv:"LENGTH"

     

       144
       144
       +
             ~doc:"Number of bytes to read (default: all)"

     

       145
       145
       +
         in

     

       146
       146
       +
         Arg.(value @@ opt (some int64) None i)

     

       147
       147
       +
       

     

       54
       148
        
       let ls_cmd env =

     

       55
       55
       -
         let doc = "run the client" in

     

       149
       149
       +
         let doc = "List files in the directory" in

     

       56
       150
        
         let info = Cmd.info "ls" ~doc in

     

       57
       151
        
         Cmd.v info Term.(const (ls env#net) $ connect_addr)

     

       58
       152
        
       

     

       59
       59
       -
       let () = exit @@ Eio_main.run @@ fun env -> Cmd.eval (ls_cmd env)

     

       153
       153
       +
       let create_cmd env =

     

       154
       154
       +
         let doc = "Create a new file" in

     

       155
       155
       +
         let info = Cmd.info "create" ~doc in

     

       156
       156
       +
         Cmd.v info Term.(const (create env#net) $ connect_addr $ name_arg)

     

       157
       157
       +
       

     

       158
       158
       +
       let open_cmd env =

     

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

     

       160
       160
       +
         let info = Cmd.info "open" ~doc in

     

       161
       161
       +
         Cmd.v info Term.(const (open_file env#net) $ connect_addr $ name_arg)

     

       162
       162
       +
       

     

       163
       163
       +
       let delete_cmd env =

     

       164
       164
       +
         let doc = "Delete a file" in

     

       165
       165
       +
         let info = Cmd.info "delete" ~doc in

     

       166
       166
       +
         Cmd.v info Term.(const (delete env#net) $ connect_addr $ name_arg)

     

       167
       167
       +
       

     

       168
       168
       +
       let size_cmd env =

     

       169
       169
       +
         let doc = "Get the size of a file" in

     

       170
       170
       +
         let info = Cmd.info "size" ~doc in

     

       171
       171
       +
         Cmd.v info Term.(const (size env#net) $ connect_addr $ name_arg)

     

       172
       172
       +
       

     

       173
       173
       +
       let read_cmd env =

     

       174
       174
       +
         let doc = "Read the contents of a file" in

     

       175
       175
       +
         let info = Cmd.info "read" ~doc in

     

       176
       176
       +
         Cmd.v info

     

       177
       177
       +
           Term.(

     

       178
       178
       +
             const (read env#net) $ connect_addr $ name_arg $ offset_arg $ length_arg)

     

       179
       179
       +
       

     

       180
       180
       +
       let main_cmd env =

     

       181
       181
       +
         let doc = "Bellairs Storage Client" in

     

       182
       182
       +
         let info = Cmd.info "bellairs" ~doc in

     

       183
       183
       +
         Cmd.group info

     

       184
       184
       +
           [

     

       185
       185
       +
             ls_cmd env;

     

       186
       186
       +
             create_cmd env;

     

       187
       187
       +
             open_cmd env;

     

       188
       188
       +
             delete_cmd env;

     

       189
       189
       +
             size_cmd env;

     

       190
       190
       +
             read_cmd env;

     

       191
       191
       +
           ]

     

       192
       192
       +
       

     

       193
       193
       +
       let () = exit @@ Eio_main.run @@ fun env -> Cmd.eval (main_cmd env)

+32 -10

mvp/ocaml/server/server.ml

···

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

     

       7
       7
        
       open Capnp_rpc.Std

     

       8
       8
        
       

     

       9
       9
       -
       let todo msg = failwith ("TODO: " ^ msg)

     

       10
       10
       -
       

     

       11
       9
        
       module Impl : sig

     

       12
       10
        
         include Bellairs.Storage

     

       13
       11
        
       

     
···

       28
       26
        
           let _ = create tbl "bar" in

     

       29
       27
        
           tbl

     

       30
       28
        
       

     

       31
       31
       -
         let open_ (files : dir) name =

     

       32
       32
       -
           try Hashtbl.find files name with Not_found -> failwith "file not found"

     

       33
       33
       -
       

     

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

     

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

     

       35
       31
        
       

     

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

     
···

       85
       81
        
           Directory.local

     

       86
       82
        
           @@ object

     

       87
       83
        
                inherit Directory.service

     

       88
       88
       -
                method create_impl _ = todo "create_impl"

     

       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

     

       89
       95
        
       

     

       90
       96
        
                method list_impl _ release_param_caps =

     

       91
       97
        
                  let open Directory.List in

     
···

       94
       100
        
                    Service.Response.create Results.init_pointer

     

       95
       101
        
                  in

     

       96
       102
        
                  let entries = Impl.list dir in

     

       97
       97
       -
       

     

       98
       103
        
                  let entries_array =

     

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

     

       100
       105
        
                  in

     
···

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

     

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

     

       107
       112
        
                    entries;

     

       108
       108
       -
       

     

       109
       113
        
                  Service.return response

     

       110
       114
        
       

     

       111
       111
       -
                method open_impl _ = todo "open_impl"

     

       112
       112
       -
                method delete_impl _ = todo "delete_impl"

     

       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

     

       113
       135
        
              end

     

       114
       136
        
       end

     

       115
       137