diff --git a/.dockerignore b/.dockerignore deleted file mode 100644 index e98890450..000000000 --- a/.dockerignore +++ /dev/null @@ -1,4 +0,0 @@ -.git -_build -.*sw? -compiler diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index d69d4aeed..000000000 --- a/.travis.yml +++ /dev/null @@ -1,7 +0,0 @@ -language: c -script: docker build . -sudo: required -services: - - docker -env: - - OPAMERRLOGLEN=0 diff --git a/Dockerfile b/Dockerfile deleted file mode 100644 index 28088b3b9..000000000 --- a/Dockerfile +++ /dev/null @@ -1,14 +0,0 @@ -FROM ocurrent/opam@sha256:7cec1ab422d97bf498c309a38b685e7c2650a0daa2d6ddef5fb4428de0535f26 -#FROM ocurrent/opam:alpine-3.10-ocaml-4.08 -RUN cd ~/opam-repository && git fetch && git reset --hard 42f3767f07a36517910bdbf5d0c5230457ae7c79 && opam update -RUN opam depext -i capnp afl-persistent conf-capnproto tls tls-mirage mirage-flow ptime cmdliner dns-client dns-mirage -ADD --chown=opam *.opam /home/opam/capnp-rpc/ -WORKDIR /home/opam/capnp-rpc/ -RUN opam pin add -yn capnp-rpc.dev . && \ - opam pin add -yn capnp-rpc-lwt.dev . && \ - opam pin add -yn capnp-rpc-net.dev . && \ - opam pin add -yn capnp-rpc-unix.dev . && \ - opam pin add -yn capnp-rpc-mirage.dev . -RUN opam install --deps-only -t . -ADD --chown=opam . /home/opam/capnp-rpc -RUN opam exec -- make all test diff --git a/README.md b/README.md index 6977455bd..e11a668a4 100644 --- a/README.md +++ b/README.md @@ -602,10 +602,9 @@ let run_client service = let connect uri = Lwt_main.run begin - Fmt.pr "Connecting to echo service at: %a@." Uri.pp_hum uri; let client_vat = Capnp_rpc_unix.client_only_vat () in let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in - Sturdy_ref.with_cap_exn sr run_client + Capnp_rpc_unix.with_cap_exn sr run_client end open Cmdliner @@ -636,12 +635,14 @@ With the server still running in another window, run the client using the `echo. ``` $ dune exec ./client.exe echo.cap -Connecting to echo service at: capnp://sha-256:_FNMlR9cf1maixDAM6Y1pwwZ-aikqa_DP8P7RCVr1k4@127.0.0.1:7000/JL_hRxzrTSbLNcb0Tqp2f0N_sh5znvY2ym9KMVzLtcQ Callback got "foo" Callback got "foo" Callback got "foo" ``` +Note that we're using `Capnp_rpc_unix.with_cap_exn` here instead of `Sturdy_ref.with_cap_exn`. +It's almost the same, except that it displays a suitable progress indicator if the connection takes too long. + ### Pipelining Let's say the server also offers a logging service, which the client can get from the main echo service: @@ -1291,15 +1292,12 @@ To build: git clone https://github.com/mirage/capnp-rpc.git cd capnp-rpc - opam pin add -nyk git capnp-rpc . - opam pin add -nyk git capnp-rpc-lwt . - opam pin add -nyk git capnp-rpc-net . - opam pin add -nyk git capnp-rpc-unix . - opam depext capnp-rpc-lwt alcotest - opam install --deps-only -t capnp-rpc-unix + opam pin add -ny . + opam depext -t capnp-rpc-unix capnp-rpc-mirage + opam install --deps-only -t . make test -If you have trouble building, you can build it with Docker from a known-good state using `docker build .`. +If you have trouble building, you can use the Dockerfile shown in the CI logs (click the green tick on the main page). ### Testing diff --git a/test-bin/calc.ml b/test-bin/calc.ml index c11782f7c..e75bac6bc 100644 --- a/test-bin/calc.ml +++ b/test-bin/calc.ml @@ -45,7 +45,7 @@ let connect addr = Lwt_main.run begin let vat = Capnp_rpc_unix.client_only_vat () in let sr = Vat.import_exn vat addr in - Capnp_rpc_lwt.Sturdy_ref.with_cap_exn sr @@ fun calc -> + Capnp_rpc_unix.with_cap_exn sr @@ fun calc -> Logs.info (fun f -> f "Evaluating expression..."); let remote_add = Calc.getOperator calc `Add in let result = Calc.evaluate calc Calc.Expr.(Call (remote_add, [Float 40.0; Float 2.0])) in diff --git a/unix/capnp_rpc_unix.ml b/unix/capnp_rpc_unix.ml index c8f7325e4..348edf275 100644 --- a/unix/capnp_rpc_unix.ml +++ b/unix/capnp_rpc_unix.ml @@ -13,6 +13,7 @@ module Vat = Vat_network.Vat module Network = Network module Vat_config = Vat_config module File_store = File_store +module Sturdy_ref = Capnp_rpc_lwt.Sturdy_ref let error fmt = fmt |> Fmt.kstrf @@ fun msg -> @@ -72,6 +73,84 @@ let sturdy_uri = in Cmdliner.Arg.conv (of_string, Uri.pp_hum) +module Console = struct + (* The first item in this list is what is currently displayed on screen *) + let messages = ref [] + + let clear () = + match !messages with + | [] -> () + | msg :: _ -> + let blank = Stdlib.String.make (String.length msg) ' ' in + Printf.fprintf stderr "\r%s\r%!" blank + + let show () = + match !messages with + | [] -> () + | msg :: _ -> + prerr_string msg; + flush stderr + + let with_msg msg f = + clear (); + messages := msg :: !messages; + show (); + Lwt.finalize f + (fun () -> + clear (); + let rec remove_first = function + | [] -> assert false + | x :: xs when x = msg -> xs + | x :: xs -> x :: remove_first xs + in + messages := remove_first !messages; + show (); + Lwt.return_unit + ) +end + +let addr_of_sr sr = + match Capnp_rpc_net.Capnp_address.parse_uri (Capnp_rpc_lwt.Cast.sturdy_to_raw sr)#to_uri_with_secrets with + | Ok ((addr, _auth), _id) -> addr + | Error (`Msg m) -> failwith m + +let rec connect_with_progress ?(mode=`Auto) sr = + let pp = Fmt.using addr_of_sr Capnp_rpc_net.Capnp_address.Location.pp in + match mode with + | `Auto + | `Log -> + let did_log = ref false in + Log.info (fun f -> did_log := true; f "Connecting to %a..." pp sr); + if !did_log then ( + Sturdy_ref.connect sr >|= function + | Ok _ as x -> Log.info (fun f -> f "Connected to %a" pp sr); x + | Error _ as e -> e + ) else ( + if Unix.(isatty stderr) then + connect_with_progress ~mode:`Console sr + else + connect_with_progress ~mode:`Batch sr + ) + | `Batch -> + Fmt.epr "Connecting to %a... %!" pp sr; + begin Sturdy_ref.connect sr >|= function + | Ok _ as x -> Fmt.epr "OK@."; x + | Error _ as x -> Fmt.epr "ERROR@."; x + end + | `Console -> + let x = Sturdy_ref.connect sr in + Lwt.choose [Lwt_unix.sleep 0.5; Lwt.map ignore x] >>= fun () -> + if Lwt.is_sleeping x then ( + Console.with_msg (Fmt.strf "[ connecting to %a ]" pp sr) + (fun () -> x) + ) else x + | `Silent -> Sturdy_ref.connect sr + +let with_cap_exn ?progress sr f = + connect_with_progress ?mode:progress sr >>= function + | Error ex -> Fmt.failwith "%a" Capnp_rpc.Exception.pp ex + | Ok x -> Capnp_rpc_lwt.Capability.with_ref x f + let handle_connection ?tags ~secret_key vat client = Lwt.catch (fun () -> let switch = Lwt_switch.create () in diff --git a/unix/capnp_rpc_unix.mli b/unix/capnp_rpc_unix.mli index 3078bd959..c9ab5be15 100644 --- a/unix/capnp_rpc_unix.mli +++ b/unix/capnp_rpc_unix.mli @@ -95,6 +95,26 @@ 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). *) +val connect_with_progress : + ?mode:[`Auto | `Log | `Batch | `Console | `Silent] -> + 'a Sturdy_ref.t -> ('a Capability.t, Capnp_rpc.Exception.t) Lwt_result.t +(** [connect_with_progress sr] is like [Sturdy_ref.connect], but shows that a connection is in progress. + Note: On failure, it does {e not} display the error, which should instead be handled by the caller. + @param mode Controls how progress is displayed: + - [`Log] writes info-level log messages about starting and completing the connection. + - [`Batch] prints a message to stderr when starting, then prints OK when done. + - [`Console] displays a message while connecting if it takes too long, then erases it when done. + - [`Silent] does nothing. + - [`Auto] (the default) tries to log (as for [`Log]), but if the log message isn't used then it behaves as + [`Console] (if stderr is a tty) or as [`Batch] (if not). *) + +val with_cap_exn : + ?progress:[`Auto | `Log | `Batch | `Console | `Silent] -> + 'a Sturdy_ref.t -> + ('a Capability.t -> 'b Lwt.t) -> + 'b Lwt.t +(** Like [Sturdy_ref.with_cap_exn], but using [connect_with_progress] to show progress. *) + val serve : ?switch:Lwt_switch.t -> ?tags:Logs.Tag.set -> diff --git a/unix/network.ml b/unix/network.ml index 2a2af427a..3fa1872d7 100644 --- a/unix/network.ml +++ b/unix/network.ml @@ -80,13 +80,13 @@ let try_set_keepalive_idle socket i = let connect_socket = function | `Unix path -> - Logs.info (fun f -> f "Connecting to %S..." path); + Log.info (fun f -> f "Connecting to %S..." path); let socket = Lwt_unix.(socket PF_UNIX SOCK_STREAM 0) in Lwt.catch (fun () -> Lwt_unix.connect socket (Unix.ADDR_UNIX path) >|= fun () -> socket) (fun ex -> Lwt_unix.close socket >>= fun () -> Lwt.fail ex) | `TCP (host, port) -> - Logs.info (fun f -> f "Connecting to %s:%d..." host port); + Log.info (fun f -> f "Connecting to %s:%d..." host port); let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in Lwt.catch (fun () ->