From 815f5599fc66696384e64397dd6e74c5cf682836 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Fri, 7 Jul 2017 14:36:09 +0100 Subject: [PATCH] Update https-unikernel example to latest API Also, stop static linking for now, as it generates a lot of warnings with glibc. Signed-off-by: Thomas Leonard --- .../examples/https-unikernel/Dockerfile | 8 ++--- .../examples/https-unikernel/README.md | 5 ++- .../miragesdk/examples/https-unikernel/opam | 2 +- .../examples/https-unikernel/src/common.ml | 4 +-- .../https-unikernel/src/http_server.ml | 15 ++++---- .../examples/https-unikernel/src/jbuild | 34 ++++++------------- .../examples/https-unikernel/src/main.ml | 6 ++-- .../examples/https-unikernel/src/store.ml | 6 ++-- .../https-unikernel/src/tls_terminator.ml | 14 ++++---- 9 files changed, 41 insertions(+), 53 deletions(-) diff --git a/projects/miragesdk/examples/https-unikernel/Dockerfile b/projects/miragesdk/examples/https-unikernel/Dockerfile index 99d4122ba..ba121bc17 100644 --- a/projects/miragesdk/examples/https-unikernel/Dockerfile +++ b/projects/miragesdk/examples/https-unikernel/Dockerfile @@ -1,8 +1,8 @@ -FROM ocaml/opam@sha256:a469435632d0cacbceab799d7e48201b727d025fa1805cbbe210d94233b251ad +FROM ocaml/opam@sha256:523988cb7ac4c51e1c6e2f00658686c320330000859f49e1ec8fe3d6df046a26 #FROM ocaml/opam:debian-9_ocaml-4.04.0 -RUN opam pin add -yn capnp 'https://github.com/talex5/capnp-ocaml.git#demo1' -RUN opam pin add -yn capnp-rpc 'https://github.com/talex5/capnp-rpc.git#demo1' -RUN opam pin add -yn capnp-rpc-lwt 'https://github.com/talex5/capnp-rpc.git#demo1' +RUN opam pin add -yn capnp 'https://github.com/talex5/capnp-ocaml.git#demo2' +RUN opam pin add -yn capnp-rpc 'https://github.com/talex5/capnp-rpc.git#demo2' +RUN opam pin add -yn capnp-rpc-lwt 'https://github.com/talex5/capnp-rpc.git#demo2' RUN opam depext -i -y jbuilder lwt cohttp astring tls capnp camlzip alcotest cohttp RUN sudo apt-get install -y screen python-pip python-setuptools python-dev --no-install-recommends RUN pip install cython pycapnp diff --git a/projects/miragesdk/examples/https-unikernel/README.md b/projects/miragesdk/examples/https-unikernel/README.md index 5eb9f982b..c6e7c7e3d 100644 --- a/projects/miragesdk/examples/https-unikernel/README.md +++ b/projects/miragesdk/examples/https-unikernel/README.md @@ -23,13 +23,12 @@ The easiest way to build and run is using Docker: Once inside the container, you can run all the services in a single process like this: - reset https-unikernel-single You should be able to try out the service by opening in a browser. You can also run the service as three separate processes. -The easiest way to do this is by running `screen`. +The easiest way to do this is by creating multiple windows in `screen` (which is running by default in the Docker image). First, start the store: @@ -64,7 +63,7 @@ $ python ( ok = "

It works!

Powered by Irmin.

\n" ) ``` -(or just do `python test_store.py`) +(or just do `python src/test_store.py`) [Cap'n Proto RPC]: https://capnproto.org/rpc.html diff --git a/projects/miragesdk/examples/https-unikernel/opam b/projects/miragesdk/examples/https-unikernel/opam index a8cf384ed..040c2b2da 100644 --- a/projects/miragesdk/examples/https-unikernel/opam +++ b/projects/miragesdk/examples/https-unikernel/opam @@ -8,7 +8,7 @@ build: [ ] depends: [ "lwt" - "cohttp" + "cohttp" {>="0.21.0" & <"0.99"} "astring" "tls" "irmin-unix" diff --git a/projects/miragesdk/examples/https-unikernel/src/common.ml b/projects/miragesdk/examples/https-unikernel/src/common.ml index 80721b7eb..7b999bff9 100644 --- a/projects/miragesdk/examples/https-unikernel/src/common.ml +++ b/projects/miragesdk/examples/https-unikernel/src/common.ml @@ -11,7 +11,7 @@ let connect ~switch path = exit 1 end; let endpoint = Endpoint.of_socket ~switch socket in - let conn = CapTP.of_endpoint ~switch endpoint in + let conn = CapTP.connect ~switch endpoint in CapTP.bootstrap conn let rm_socket path = @@ -33,7 +33,7 @@ let listen ~switch ~offer path = Logs.info (fun f -> f "Got connection on %S" path); Lwt_switch.with_switch @@ fun switch -> (* todo: with_child_switch *) let endpoint = Endpoint.of_socket ~switch (Lwt_unix.unix_file_descr c) in - ignore (CapTP.of_endpoint ~switch ~offer endpoint); + ignore (CapTP.connect ~switch ~offer endpoint); loop () in loop () diff --git a/projects/miragesdk/examples/https-unikernel/src/http_server.ml b/projects/miragesdk/examples/https-unikernel/src/http_server.ml index fd38bbdf3..140fa756f 100644 --- a/projects/miragesdk/examples/https-unikernel/src/http_server.ml +++ b/projects/miragesdk/examples/https-unikernel/src/http_server.ml @@ -17,8 +17,7 @@ module Remote_flow = struct let read t = let module R = Api.Reader.Flow.Read_results in let req = Capability.Request.create_no_args () in - let proxy = new Api.Reader.Flow.client t in - Capability.call_for_value_exn proxy#read req >>= fun resp -> + Capability.call_for_value_exn t Api.Reader.Flow.read_method req >>= fun resp -> let p = R.of_payload resp in let data = R.data_get p in Lwt.return (Ok (`Data (Cstruct.of_string data))) @@ -26,9 +25,8 @@ module Remote_flow = struct let write t data = let module P = Api.Builder.Flow.Write_params in let req, p = Capability.Request.create P.init_pointer in - let proxy = new Api.Reader.Flow.client t in P.data_set p (Cstruct.to_string data); - Capability.call_for_value_exn proxy#write req >>= fun _ -> + Capability.call_for_value_exn t Api.Reader.Flow.write_method req >>= fun _ -> Lwt.return (Ok ()) let writev t data = @@ -77,8 +75,7 @@ let get t path = let module P = Api.Builder.Store.Get_params in let req, p = Capability.Request.create P.init_pointer in ignore (P.path_set_list p path); - let proxy = new Api.Reader.Store.client t in - Capability.call_for_value_exn proxy#get req >>= fun resp -> + Capability.call_for_value_exn t Api.Reader.Store.get_method req >>= fun resp -> let open Api.Reader.Store in match GetResults.get (GetResults.of_payload resp) with | GetResults.NotFound -> Lwt.return None @@ -119,8 +116,10 @@ let handle_connection store c = let service store = Api.Builder.HttpServer.local @@ - object (_ : Api.Builder.HttpServer.service) - method accept req = + object + inherit Api.Builder.HttpServer.service + + method accept_impl req = Log.info (fun f -> f "Handing new connection"); let module P = Api.Reader.HttpServer.Accept_params in let p = P.of_payload req in diff --git a/projects/miragesdk/examples/https-unikernel/src/jbuild b/projects/miragesdk/examples/https-unikernel/src/jbuild index 29e48cd29..98055c950 100644 --- a/projects/miragesdk/examples/https-unikernel/src/jbuild +++ b/projects/miragesdk/examples/https-unikernel/src/jbuild @@ -1,25 +1,11 @@ -(* -*- tuareg -*- *) -open Jbuild_plugin.V1 +(jbuild_version 1) -let extra_flags = - match Sys.getenv "JBUILD_STATIC" with - | "true" -> "-cclib -static" - | x -> failwith (Printf.sprintf "JBUILD_STATIC: unknown value %S" x) - | exception Not_found -> "" - -let sexp = Printf.sprintf {| - (jbuild_version 1) - - (executables ( - (names (main store_main http_main tls_main)) - (libraries (capnp-rpc-lwt cohttp.lwt irmin-unix cmdliner fmt.tty)) - (flags (:standard -w -53-55 %s)) - )) - (rule - ((targets (proto.ml proto.mli)) - (deps (proto.capnp)) - (action (run capnpc -o ocaml ${<})))) -|} extra_flags - -let () = - send sexp +(executables ( + (names (main store_main http_main tls_main)) + (libraries (capnp-rpc-lwt cohttp.lwt irmin-unix cmdliner fmt.tty)) + (flags (:standard -w -53-55)) +)) +(rule + ((targets (proto.ml proto.mli)) + (deps (proto.capnp)) + (action (run capnpc -o ocaml ${<})))) diff --git a/projects/miragesdk/examples/https-unikernel/src/main.ml b/projects/miragesdk/examples/https-unikernel/src/main.ml index 46b582060..718890bd1 100644 --- a/projects/miragesdk/examples/https-unikernel/src/main.ml +++ b/projects/miragesdk/examples/https-unikernel/src/main.ml @@ -21,15 +21,15 @@ let () = begin Store.service () >>= fun service -> let tags = Logs.Tag.add Common.Actor.tag (`Green, "Store ") Logs.Tag.empty in - let _ : CapTP.t = CapTP.of_endpoint ~offer:service ~tags ~switch store_to_http in + let _ : CapTP.t = CapTP.connect ~offer:service ~tags ~switch store_to_http in Lwt.return () end >>= fun () -> begin let tags = Logs.Tag.add Common.Actor.tag (`Red, "HTTP ") Logs.Tag.empty in - let store = CapTP.bootstrap (CapTP.of_endpoint ~tags ~switch http_to_store) in + let store = CapTP.bootstrap (CapTP.connect ~tags ~switch http_to_store) in let service = Http_server.service store in - let _ : CapTP.t = CapTP.of_endpoint ~offer:service ~tags ~switch http_to_tls in + let _ : CapTP.t = CapTP.connect ~offer:service ~tags ~switch http_to_tls in Lwt.return () end >>= fun () -> diff --git a/projects/miragesdk/examples/https-unikernel/src/store.ml b/projects/miragesdk/examples/https-unikernel/src/store.ml index bfb02b33c..5cb45a557 100644 --- a/projects/miragesdk/examples/https-unikernel/src/store.ml +++ b/projects/miragesdk/examples/https-unikernel/src/store.ml @@ -13,8 +13,10 @@ let service () = Irmin_store.Repo.v config >>= fun repo -> Irmin_store.of_branch repo Irmin_store.Branch.master >|= fun db -> Api.Builder.Store.local @@ - object (_ : Api.Builder.Store.service) - method get req = + object + inherit Api.Builder.Store.service + + method get_impl req = let module P = Api.Reader.Store.Get_params in let module R = Api.Builder.Store.GetResults in let params = P.of_payload req in diff --git a/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml b/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml index 7d91c58e5..895b25898 100644 --- a/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml +++ b/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml @@ -3,8 +3,10 @@ open Capnp_rpc_lwt let make_flow _flow ic oc = Api.Builder.Flow.local @@ - object (_ : Api.Builder.Flow.service) - method read _ = + object + inherit Api.Builder.Flow.service + + method read_impl _ = Service.return_lwt (fun () -> Lwt_io.read ~count:4096 ic >|= fun data -> let module R = Api.Builder.Flow.Read_results in @@ -13,7 +15,7 @@ let make_flow _flow ic oc = Ok resp ) - method write req = + method write_impl req = let module R = Api.Reader.Flow.Write_params in let p = R.of_payload req in let data = R.data_get p in @@ -24,11 +26,11 @@ let make_flow _flow ic oc = end let handle ~http_service flow = - let proxy = new Api.Reader.HttpServer.client http_service in let module P = Api.Builder.HttpServer.Accept_params in let req, p = Capability.Request.create P.init_pointer in P.connection_set p (Some (Capability.Request.export req flow)); - Capability.call_for_value proxy#accept req >|= function + Capability.dec_ref flow; + Capability.call_for_value http_service Api.Reader.HttpServer.accept_method req >|= function | Ok _ -> () | Error e -> Logs.warn (fun f -> f "Error from HTTP server: %a" Capnp_rpc.Error.pp e) @@ -49,5 +51,5 @@ let run ~port ~http_service = let init ~switch ~to_http = let tags = Logs.Tag.add Common.Actor.tag (`Blue, "TLS ") Logs.Tag.empty in - let http_service = CapTP.bootstrap (CapTP.of_endpoint ~tags ~switch to_http) in + let http_service = CapTP.bootstrap (CapTP.connect ~tags ~switch to_http) in run ~http_service ~port:8443