Merge pull request #165 from talex5/convenience

Add some convenience functions

README.md

@@ -245,7 +245,7 @@ Here's a suitable `dune` file to compile the schema file and then the generated
 (rule
  (targets echo_api.ml echo_api.mli)
  (deps    echo_api.capnp)
- (action (run capnpc -o ocaml %{deps})))
+ (action (run capnpc -o %{bin:capnpc-ocaml} %{deps})))
 ```
 
 The service is now usable:

capnp-rpc-lwt/dune

@@ -8,14 +8,10 @@
 
 (rule
  (targets rpc_schema.ml rpc_schema.mli)
- (deps
-  (:< rpc_schema.capnp))
- (action
-  (run capnpc -o ocaml %{<})))
+ (deps rpc_schema.capnp)
+ (action (run capnpc -o %{bin:capnpc-ocaml} %{deps})))
 
 (rule
  (targets persistent.ml persistent.mli)
- (deps
-  (:< persistent.capnp))
- (action
-  (run capnpc -o ocaml %{<})))
+ (deps persistent.capnp)
+ (action (run capnpc -o %{bin:capnpc-ocaml} %{deps})))

capnp-rpc-lwt/s.ml

@@ -131,7 +131,7 @@ module type VAT_NETWORK = sig
     val sturdy_uri : t -> service_id -> Uri.t
     (** [sturdy_uri t id] is [sturdy_ref t id |> export t]. *)
 
-    val import : t -> Uri.t -> ('a sturdy_ref, [`Msg of string]) result
+    val import : t -> Uri.t -> ('a sturdy_ref, [> `Msg of string]) result
     (** [import t uri] parses [uri] as a "capnp://" URI. *)
 
     val import_exn : t -> Uri.t -> 'a sturdy_ref

examples/dune

@@ -5,14 +5,10 @@
 
 (rule
  (targets test_api.ml test_api.mli)
- (deps
-  (:< test_api.capnp))
- (action
-  (run capnpc -o ocaml %{<})))
+ (deps test_api.capnp)
+ (action (run capnpc -o %{bin:capnpc-ocaml} %{deps})))
 
 (rule
  (targets calculator.ml calculator.mli)
- (deps
-  (:< calculator.capnp))
- (action
-  (run capnpc -o ocaml %{<})))
+ (deps calculator.capnp)
+ (action (run capnpc -o %{bin:capnpc-ocaml} %{deps})))

unix/capnp_rpc_unix.ml

@@ -26,17 +26,49 @@ let parse_uri s =
     | Ok _ -> Ok uri    (* (just check it parses) *)
     | Error _ as e -> e
 
-let sturdy_uri =
-  let of_string s =
-    if String.is_prefix s ~affix:"capnp://" then parse_uri s
-    else if Sys.file_exists s then (
-      let ch = open_in s in
+module Cap_file = struct
+  let load_uri path =
+    try
+      let ch = open_in path in
       let len = in_channel_length ch in
       let data = really_input_string ch len in
       close_in ch;
-      parse_uri data
-    ) else error "Expected a URI starting with \"capnp://\" \
-                  or the path to a file containing such a URI, but got %S." s
+      parse_uri (String.trim data)
+    with ex ->
+      if Sys.file_exists path then
+        error "Error loading %S: %a" path Fmt.exn ex
+      else
+        error "File %S does not exist" path
+
+  let load vat path =
+    match load_uri path with
+    | Ok uri -> Vat.import vat uri
+    | Error _ as e -> e
+
+  let save_uri uri path =
+    try
+      let data = Uri.to_string uri ^ "\n" in
+      let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 path in
+      output_string oc data;
+      close_out oc;
+      Ok ()
+    with ex ->
+      error "Error saving to %S: %a" path Fmt.exn ex
+
+  let save_sturdy vat sr path =
+    save_uri (Vat.export vat sr) path
+
+  let save_service vat id path =
+    let uri = Vat.sturdy_uri vat id in
+    save_uri uri path
+end
+
+let sturdy_uri =
+  let of_string s =
+    if String.is_prefix s ~affix:"capnp://" then parse_uri s
+    else if Sys.file_exists s then Cap_file.load_uri s
+    else error "Expected a URI starting with \"capnp://\" \
+                or the path to a file containing such a URI, but got %S." s
   in
   Cmdliner.Arg.conv (of_string, Uri.pp_hum)
 

unix/capnp_rpc_unix.mli

@@ -79,6 +79,18 @@ module File_store : sig
   (** [remove t ~digest] removes the stored data for [digest]. *)
 end
 
+module Cap_file : sig
+  val load : Vat.t -> string -> (_ Sturdy_ref.t, [> `Msg of string]) result
+  (** [load vat path] loads the contents of [path] as a capability URI. *)
+
+  val save_sturdy : Vat.t -> _ Sturdy_ref.t -> string -> (unit, [> `Msg of string]) result
+  (** [save_sturdy vat sr path] saves [sr] to [path], with a mode of [0o600]. *)
+
+  val save_service : Vat.t -> Capnp_rpc_lwt.Restorer.Id.t -> string ->
+    (unit, [> `Msg of string]) result
+  (** [save_service vat id path] saves [vat/id] to [path], with a mode of [0o600]. *)
+end
+
 val sturdy_uri : Uri.t Cmdliner.Arg.conv
 (** A cmdliner argument converter for a "capnp://" URI (or the path of a file containing such a URI). *)
 

unix/network.ml

@@ -2,6 +2,8 @@ module Log = Capnp_rpc.Debug.Log
 module Tls_wrapper = Capnp_rpc_lwt.Tls_wrapper.Make(Unix_flow)
 
 module Location = struct
+  open Astring
+
   include Capnp_rpc_lwt.Capnp_address.Location
 
   let abs_path p =
@@ -15,6 +17,24 @@ module Location = struct
 
   let unix x = `Unix (abs_path x)
   let tcp ~host ~port = `TCP (host, port)
+
+  let parse_tcp s =
+    match String.cut ~sep:":" s with
+    | None -> Error (`Msg "Missing :PORT in listen address")
+    | Some (host, port) ->
+      match String.to_int port with
+      | None -> Error (`Msg "PORT must be an integer")
+      | Some port ->
+        Ok (tcp ~host ~port)
+
+  let of_string s =
+    match String.cut ~sep:":" s with
+    | Some ("unix", path) -> Ok (unix path)
+    | Some ("tcp", tcp) -> parse_tcp tcp
+    | None -> Error (`Msg "Missing ':'")
+    | Some _ -> Error (`Msg "Only tcp:HOST:PORT and unix:PATH addresses are currently supported")
+
+  let cmdliner_conv = Cmdliner.Arg.conv (of_string, pp)
 end
 
 module Address

unix/network.mli

@@ -18,6 +18,10 @@ module Location : sig
 
   val tcp : host:string -> port:int -> t
   (** [tcp ~host port] is [`TCP (host, port)]. *)
+
+  val of_string : string -> (t, [> `Msg of string]) result
+
+  val cmdliner_conv : t Cmdliner.Arg.conv
 end
 
 include Capnp_rpc_lwt.S.NETWORK with

unix/vat_config.ml

@@ -1,5 +1,3 @@
-open Astring
-
 let docs = "CAP'N PROTO OPTIONS"
 
 module Auth = Capnp_rpc_lwt.Auth
@@ -8,29 +6,11 @@ module Log = Capnp_rpc.Debug.Log
 module Listen_address = struct
   include Network.Location
 
-  let parse_tcp s =
-    match String.cut ~sep:":" s with
-    | None -> Error (`Msg "Missing :PORT in listen address")
-    | Some (host, port) ->
-      match String.to_int port with
-      | None -> Error (`Msg "PORT must be an integer")
-      | Some port ->
-        Ok (tcp ~host ~port)
-
-  let of_string s =
-    match String.cut ~sep:":" s with
-    | Some ("unix", path) -> Ok (unix path)
-    | Some ("tcp", tcp) -> parse_tcp tcp
-    | None -> Error (`Msg "Missing ':'")
-    | Some _ -> Error (`Msg "Only tcp:HOST:PORT and unix:PATH addresses are currently supported")
-
   open Cmdliner
 
-  let addr_conv = Arg.conv (of_string, pp)
-
   let cmd =
     let i = Arg.info ~docs ["capnp-listen-address"] ~docv:"ADDR" ~doc:"Address to listen on, e.g. $(b,unix:/run/my.socket)." in
-    Arg.(required @@ opt (some addr_conv) None i)
+    Arg.(required @@ opt (some cmdliner_conv) None i)
 end
 
 module Secret_hash : sig
@@ -144,7 +124,7 @@ let equal {backlog; secret_key; serve_tls; listen_address; public_address} b =
 
 let public_address =
   let i = Arg.info ~docs ["capnp-public-address"] ~docv:"ADDR" ~doc:"Address to tell others to connect on." in
-  Arg.(value @@ opt (some Listen_address.addr_conv) None i)
+  Arg.(value @@ opt (some Network.Location.cmdliner_conv) None i)
 
 let disable_tls =
   let i = Arg.info ~docs ["capnp-disable-tls"] ~doc:"Do not use TLS for incoming connections." in