mirror of
https://github.com/linuxkit/linuxkit.git
synced 2026-04-06 03:44:48 +00:00
c7c33b9a56
This is mainly a test for the Cap'n'Proto RPC support. Signed-off-by: Thomas Leonard <thomas.leonard@docker.com>
54 lines
1.9 KiB
OCaml
54 lines
1.9 KiB
OCaml
open Lwt.Infix
|
|
open Capnp_rpc_lwt
|
|
|
|
let make_flow _flow ic oc =
|
|
Api.Builder.Flow.local @@
|
|
object (_ : Api.Builder.Flow.service)
|
|
method read _ =
|
|
Service.return_lwt (fun () ->
|
|
Lwt_io.read ~count:4096 ic >|= fun data ->
|
|
let module R = Api.Builder.Flow.Read_results in
|
|
let resp, results = Service.Response.create R.init_pointer in
|
|
R.data_set results data;
|
|
Ok resp
|
|
)
|
|
|
|
method write req =
|
|
let module R = Api.Reader.Flow.Write_params in
|
|
let p = R.of_payload req in
|
|
let data = R.data_get p in
|
|
Service.return_lwt (fun () ->
|
|
Lwt_io.write oc data >>= fun () ->
|
|
Lwt.return (Ok (Service.Response.create_empty ()))
|
|
)
|
|
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
|
|
| Ok _ -> ()
|
|
| Error e -> Logs.warn (fun f -> f "Error from HTTP server: %a" Capnp_rpc.Error.pp e)
|
|
|
|
let run ~port ~http_service =
|
|
let tls_config : Conduit_lwt_unix.server_tls_config =
|
|
`Crt_file_path "tls-secrets/server.crt",
|
|
`Key_file_path "tls-secrets/server.key",
|
|
`No_password,
|
|
`Port port
|
|
in
|
|
let mode = `TLS tls_config in
|
|
Logs.info (fun f -> f "Listening on https port %d" port);
|
|
Conduit_lwt_unix.(serve ~ctx:default_ctx) ~mode (fun flow ic oc ->
|
|
Logs.info (fun f -> f "Got new TLS connection");
|
|
let flow_obj = make_flow flow ic oc in
|
|
handle ~http_service flow_obj
|
|
)
|
|
|
|
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
|
|
run ~http_service ~port:8443
|