commit bbb14c6b57c4934a9dee8835d5ad9af6d33204c0 · anil.recoil.org/bellairs-quest

+12

.gitignore

···

       1
       1
       +
       _build

     

       2
       2
       +
       _coverage

     

       3
       3
       +
       _metrics

     

       4
       4
       +
       *~

     

       5
       5
       +
       *.install

     

       6
       6
       +
       *.merlin

     

       7
       7
       +
       _opam

     

       8
       8
       +
       .envrc

     

       9
       9
       +
       \#*

     

       10
       10
       +
       .#*

     

       11
       11
       +
       .*.swp

     

       12
       12
       +
       **/.DS_Store

+2 -1

README.md

···

       6
       6
        
       

     

       7
       7
        
       - Add your SSH key to the tangled.sh login under 'Settings'.

     

       8
       8
        
       

     

       9
       9
       -
       - use port 2222 for the SSH !!! Put the following into `~/.ssh/config`:

     

       9
       9
       +
       - use port 2222 for the SSH !!!

     

       10
       10
       +
         Put the following into `~/.ssh/config`:

     

       10
       11
        
       

     

       11
       12
        
       ```

     

       12
       13
        
       Host git.recoil.org

-18

mvp/bellairs.mli

···

       1
       1
       -
       

     

       2
       2
       -
       type dir

     

       3
       3
       -
       type file

     

       4
       4
       -
       

     

       5
       5
       -
       type entry = {

     

       6
       6
       -
         name: string;

     

       7
       7
       -
         file: file;

     

       8
       8
       -
       }

     

       9
       9
       -
       

     

       10
       10
       -
       val root : dir

     

       11
       11
       -
       val list : dir -> entry list

     

       12
       12
       -
       

     

       13
       13
       -
       val create : dir -> string -> file

     

       14
       14
       -
       val open_ : dir -> string -> file

     

       15
       15
       -
       val delete : dir -> string -> unit

     

       16
       16
       -
       

     

       17
       17
       -
       val size : file -> int64

     

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

mvp/bellairs.schema mvp/schema/storage.capnp

-4

mvp/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name bellairs)

     

       3
       3
       -
        (modules_without_implementation bellairs)

     

       4
       4
       -
        (modules bellairs))

-1

mvp/dune-project

···

       1
       1
       -
       (lang dune 3.17)

mvp/ocaml/bellairs.ml

···

       1
       1
       +
       include Bellairs_intf

mvp/ocaml/bellairs.mli

···

       1
       1
       +
       include Bellairs_intf.Sigs

+16

mvp/ocaml/bellairs_intf.ml

···

       1
       1
       +
       module type Storage = sig

     

       2
       2
       +
         type dir

     

       3
       3
       +
         type file

     

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

     

       5
       5
       +
       

     

       6
       6
       +
         val list : dir -> entry list

     

       7
       7
       +
         val create : dir -> string -> file

     

       8
       8
       +
         val open_ : dir -> string -> file

     

       9
       9
       +
         val delete : dir -> string -> unit

     

       10
       10
       +
         val size : file -> int64

     

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

     

       12
       12
       +
       end

     

       13
       13
       +
       

     

       14
       14
       +
       module type Sigs = sig

     

       15
       15
       +
         module type Storage = Storage

     

       16
       16
       +
       end

+59

mvp/ocaml/client/client.ml

···

       1
       1
       +
       open Capnp_rpc.Std

     

       2
       2
       +
       open Eio.Std

     

       3
       3
       +
       

     

       4
       4
       +
       module Storage :

     

       5
       5
       +
         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
       +
       

     

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

     

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

     

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

     

       13
       13
       +
       

     

       14
       14
       +
         let entry r =

     

       15
       15
       +
           let name = API.Reader.Directory.Entry.name_get r in

     

       16
       16
       +
           let file = API.Reader.Directory.Entry.file_get r in

     

       17
       17
       +
           match file with

     

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

     

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

     

       20
       20
       +
       

     

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

     

       22
       22
       +
       

     

       23
       23
       +
         let list t =

     

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

     

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

     

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

     

       27
       27
       +
           let entries = Results.entries_get_list results in

     

       28
       28
       +
           List.map entry entries

     

       29
       29
       +
       

     

       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"

     

       35
       35
       +
       end

     

       36
       36
       +
       

     

       37
       37
       +
       let ls net uri =

     

       38
       38
       +
         Switch.run @@ fun sw ->

     

       39
       39
       +
         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

     

       43
       43
       +
       

     

       44
       44
       +
       open Cmdliner

     

       45
       45
       +
       

     

       46
       46
       +
       let () =

     

       47
       47
       +
         Logs.set_level (Some Logs.Warning);

     

       48
       48
       +
         Logs.set_reporter (Logs_fmt.reporter ())

     

       49
       49
       +
       

     

       50
       50
       +
       let connect_addr =

     

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

     

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

     

       53
       53
       +
       

     

       54
       54
       +
       let ls_cmd env =

     

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

     

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

     

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

     

       58
       58
       +
       

     

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

mvp/ocaml/client/client.mli

···

       1
       1
       +
       (* empty *)

mvp/ocaml/client/dune

···

       1
       1
       +
       (executables

     

       2
       2
       +
        (names client)

     

       3
       3
       +
        (libraries bellairs eio_main capnp-rpc logs.fmt capnp-rpc-unix))

mvp/ocaml/server/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name server)

     

       3
       3
       +
        (libraries bellairs eio_main capnp-rpc logs.fmt capnp-rpc-unix))

+139

mvp/ocaml/server/server.ml

···

       1
       1
       +
       open Eio.Std

     

       2
       2
       +
       open Capnp_rpc_net

     

       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
       +
       let todo msg = failwith ("TODO: " ^ msg)

     

       10
       10
       +
       

     

       11
       11
       +
       module Impl : sig

     

       12
       12
       +
         include Bellairs.Storage

     

       13
       13
       +
       

     

       14
       14
       +
         val root : unit -> dir

     

       15
       15
       +
       end = struct

     

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

     

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

     

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

     

       19
       19
       +
       

     

       20
       20
       +
         let create files name =

     

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

     

       22
       22
       +
           Hashtbl.add files name file;

     

       23
       23
       +
           file

     

       24
       24
       +
       

     

       25
       25
       +
         let root () =

     

       26
       26
       +
           let tbl = Hashtbl.create 10 in

     

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

     

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

     

       29
       29
       +
           tbl

     

       30
       30
       +
       

     

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

     

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

     

       33
       33
       +
       

     

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

     

       35
       35
       +
       

     

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

     

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

     

       38
       38
       +
           let off = Int64.to_int off in

     

       39
       39
       +
           let len = Int64.to_int len in

     

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

     

       41
       41
       +
           let max_len = content_len - off in

     

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

     

       43
       43
       +
           String.sub file.content off len

     

       44
       44
       +
       

     

       45
       45
       +
         let size file = file.size

     

       46
       46
       +
       

     

       47
       47
       +
         let list files =

     

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

     

       49
       49
       +
       end

     

       50
       50
       +
       

     

       51
       51
       +
       module File = struct

     

       52
       52
       +
         let local file =

     

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

     

       54
       54
       +
           File.local

     

       55
       55
       +
           @@ object

     

       56
       56
       +
                inherit File.service

     

       57
       57
       +
       

     

       58
       58
       +
                method read_impl params release_param_caps =

     

       59
       59
       +
                  let open File.Read in

     

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

     

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

     

       62
       62
       +
                  release_param_caps ();

     

       63
       63
       +
                  let response, results =

     

       64
       64
       +
                    Service.Response.create Results.init_pointer

     

       65
       65
       +
                  in

     

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

     

       67
       67
       +
                  Results.data_set results data;

     

       68
       68
       +
                  Service.return response

     

       69
       69
       +
       

     

       70
       70
       +
                method size_impl _ release_param_caps =

     

       71
       71
       +
                  let open File.Size in

     

       72
       72
       +
                  release_param_caps ();

     

       73
       73
       +
                  let response, results =

     

       74
       74
       +
                    Service.Response.create Results.init_pointer

     

       75
       75
       +
                  in

     

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

     

       77
       77
       +
                  Results.size_set results size;

     

       78
       78
       +
                  Service.return response

     

       79
       79
       +
              end

     

       80
       80
       +
       end

     

       81
       81
       +
       

     

       82
       82
       +
       module Directory = struct

     

       83
       83
       +
         let local dir =

     

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

     

       85
       85
       +
           Directory.local

     

       86
       86
       +
           @@ object

     

       87
       87
       +
                inherit Directory.service

     

       88
       88
       +
                method create_impl _ = todo "create_impl"

     

       89
       89
       +
       

     

       90
       90
       +
                method list_impl _ release_param_caps =

     

       91
       91
       +
                  let open Directory.List in

     

       92
       92
       +
                  release_param_caps ();

     

       93
       93
       +
                  let response, results =

     

       94
       94
       +
                    Service.Response.create Results.init_pointer

     

       95
       95
       +
                  in

     

       96
       96
       +
                  let entries = Impl.list dir in

     

       97
       97
       +
       

     

       98
       98
       +
                  let entries_array =

     

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

     

       100
       100
       +
                  in

     

       101
       101
       +
                  List.iteri

     

       102
       102
       +
                    (fun i e ->

     

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

     

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

     

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

     

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

     

       107
       107
       +
                    entries;

     

       108
       108
       +
       

     

       109
       109
       +
                  Service.return response

     

       110
       110
       +
       

     

       111
       111
       +
                method size_impl _ = todo "size_impl"

     

       112
       112
       +
                method open_impl _ = todo "open_impl"

     

       113
       113
       +
                method delete_impl _ = todo "delete_impl"

     

       114
       114
       +
              end

     

       115
       115
       +
       end

     

       116
       116
       +
       

     

       117
       117
       +
       let serve config =

     

       118
       118
       +
         Switch.run @@ fun sw ->

     

       119
       119
       +
         let service_id = Capnp_rpc_unix.Vat_config.derived_id config "main" in

     

       120
       120
       +
         let restore = Restorer.single service_id (Directory.local (Impl.root ())) in

     

       121
       121
       +
         let vat = Capnp_rpc_unix.serve ~sw ~restore config in

     

       122
       122
       +
         match Capnp_rpc_unix.Cap_file.save_service vat service_id cap_file with

     

       123
       123
       +
         | Error (`Msg m) -> failwith m

     

       124
       124
       +
         | Ok () ->

     

       125
       125
       +
             traceln "Server running. Connect using %S." cap_file;

     

       126
       126
       +
             Fiber.await_cancel ()

     

       127
       127
       +
       

     

       128
       128
       +
       open Cmdliner

     

       129
       129
       +
       

     

       130
       130
       +
       let () =

     

       131
       131
       +
         Logs.set_level (Some Logs.Warning);

     

       132
       132
       +
         Logs.set_reporter (Logs_fmt.reporter ())

     

       133
       133
       +
       

     

       134
       134
       +
       let serve_cmd env =

     

       135
       135
       +
         let doc = "run the server" in

     

       136
       136
       +
         let info = Cmd.info "serve" ~doc in

     

       137
       137
       +
         Cmd.v info Term.(const serve $ Capnp_rpc_unix.Vat_config.cmd env)

     

       138
       138
       +
       

     

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

mvp/ocaml/server/server.mli

···

       1
       1
       +
       (* empty *)