diff --git a/projects/miragesdk/examples/https-unikernel/.dockerignore b/projects/miragesdk/examples/https-unikernel/.dockerignore
new file mode 100644
index 000000000..4d01038d7
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/.dockerignore
@@ -0,0 +1,5 @@
+_build
+rpc
+Dockerfile
+tls-secrets
+www-data
diff --git a/projects/miragesdk/examples/https-unikernel/.gitignore b/projects/miragesdk/examples/https-unikernel/.gitignore
new file mode 100644
index 000000000..f8f4e9f29
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/.gitignore
@@ -0,0 +1,8 @@
+.merlin
+_build
+proto.ml
+proto.mli
+lib/schema.ml
+lib/schema.mli
+www-data
+tls-secrets
diff --git a/projects/miragesdk/examples/https-unikernel/Dockerfile b/projects/miragesdk/examples/https-unikernel/Dockerfile
new file mode 100644
index 000000000..141b20277
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/Dockerfile
@@ -0,0 +1,23 @@
+FROM ocaml/opam@sha256:a469435632d0cacbceab799d7e48201b727d025fa1805cbbe210d94233b251ad
+#FROM ocaml/opam:debian-9_ocaml-4.04.0
+RUN opam pin add -yn capnp 'https://github.com/talex5/capnp-ocaml.git#interfaces'
+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 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
+ADD opam /home/opam/src/opam
+RUN opam pin add -ny mypkg /home/opam/src
+RUN opam install --deps-only mypkg
+ENV JBUILD_STATIC=true
+WORKDIR /home/opam/src
+ADD . /home/opam/src
+RUN sudo chown -R opam .
+RUN opam config exec -- make
+USER root
+RUN cp _build/default/src/main.exe /usr/bin/https-unikernel-single && \
+ cp _build/default/src/store_main.exe /usr/bin/https-unikernel-store && \
+ cp _build/default/src/http_main.exe /usr/bin/https-unikernel-http && \
+ cp _build/default/src/tls_main.exe /usr/bin/https-unikernel-tls
+USER opam
+ENV SHELL=bash
diff --git a/projects/miragesdk/examples/https-unikernel/Makefile b/projects/miragesdk/examples/https-unikernel/Makefile
new file mode 100644
index 000000000..eff3a1e26
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/Makefile
@@ -0,0 +1,31 @@
+.PHONY: all docker docker-run clean
+
+all: www-data
+ jbuilder build --dev src/main.exe src/store_main.exe src/http_main.exe src/tls_main.exe
+
+docker:
+ docker build -t https-unikernel .
+
+docker-run: tls-secrets/server.crt
+ docker run --rm -it -v ${PWD}/tls-secrets:/home/opam/src/tls-secrets -p 8443:8443 https-unikernel bash -c 'reset; screen'
+
+clean:
+ rm -rf _build
+
+tls-secrets/server.key:
+ @echo Generating server key...
+ [ -d tls-secrets ] || mkdir -p tls-secrets
+ openssl genrsa -out $@ 4096
+
+tls-secrets/server.crt: tls-secrets/server.key
+ @echo ">>> Generating server X.509 certificate."
+ @echo ">>> Enter the server's full hostname as the 'Common Name' (e.g. demo.mynet)."
+ @echo ">>> Everything else can be left blank."
+ @echo
+ @openssl req -new -x509 -key $< -out $@ -days 10000
+
+www-data:
+ git init www-data
+ echo 'It works!
Powered by Irmin.
' > www-data/index.html
+ git -C www-data add index.html
+ git -C www-data commit --author 'Test ' -m 'Initial state'
diff --git a/projects/miragesdk/examples/https-unikernel/README.md b/projects/miragesdk/examples/https-unikernel/README.md
new file mode 100644
index 000000000..5eb9f982b
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/README.md
@@ -0,0 +1,70 @@
+## https-unikernel example service
+
+This sample service implements an https web-server as a set of three components communicating using [Cap'n Proto RPC][].
+
+1. The `store` service accepts requests for web pages and returns the page content.
+2. The `http` service accepts HTTP connections over RPC and handles GET requests using `store`.
+3. The `tls` service accepts encrypted HTTPS connections and provides them as a plain-text stream to `http`.
+
+The protocols implemented by the services can be found in the `proto.capnp` file.
+
+The services can be run in separate processes so that they are isolated from each other.
+For example, only the `tls` component needs access to the private key, so
+a bug in the HTTP protocol decoder cannot leak the key.
+
+Although the example services are all written in OCaml, it should be possible to replace any of them with a different implementation written in any other language with Cap'n Proto RPC support.
+
+### Running the samples
+
+The easiest way to build and run is using Docker:
+
+ make docker
+ make docker-run
+
+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`.
+
+First, start the store:
+
+ https-unikernel-store /tmp/store.sock
+
+Then, create a new window (`Ctrl-A c`) and start the http service:
+
+ https-unikernel-http /tmp/http.sock --store=/tmp/store.sock
+
+Finally, make another window and run the TLS terminator:
+
+ https-unikernel-tls --http /tmp/http.sock --port 8443
+
+
+### Testing with Python
+
+With the services running as separate processes (i.e. with socket files available), you can also invoke services from other languages.
+For example, using Python (make another screen split):
+
+```
+$ cd src
+$ python
+>>> import capnp
+>>> import proto_capnp
+>>> import socket
+>>> s = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM, 0)
+>>> s.connect('/tmp/store.sock')
+>>> client = capnp.TwoPartyClient(s)
+>>> store = client.bootstrap().cast_as(proto_capnp.Store)
+>>> r = store.get(['index.html'])
+>>> print r.wait()
+( ok = "It works!
Powered by Irmin.
\n" )
+```
+
+(or just do `python 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
new file mode 100644
index 000000000..a8cf384ed
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/opam
@@ -0,0 +1,18 @@
+opam-version: "1.2"
+name: "https-unikernel"
+version: "0.1"
+maintainer: "Thomas Leonard "
+authors: "Thomas Leonard "
+build: [
+ [make]
+]
+depends: [
+ "lwt"
+ "cohttp"
+ "astring"
+ "tls"
+ "irmin-unix"
+ "capnp-rpc-lwt"
+ "jbuilder" {build}
+ "ocamlfind" {build}
+]
diff --git a/projects/miragesdk/examples/https-unikernel/src/api.ml b/projects/miragesdk/examples/https-unikernel/src/api.ml
new file mode 100644
index 000000000..ab4116aac
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/api.ml
@@ -0,0 +1 @@
+include Proto.MakeRPC(Capnp.BytesMessage)(Capnp_rpc_lwt)
diff --git a/projects/miragesdk/examples/https-unikernel/src/common.ml b/projects/miragesdk/examples/https-unikernel/src/common.ml
new file mode 100644
index 000000000..80721b7eb
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/common.ml
@@ -0,0 +1,77 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let connect ~switch path =
+ Logs.info (fun f -> f "Connecting to %S" path);
+ let socket = Unix.(socket PF_UNIX SOCK_STREAM 0) in
+ begin
+ try Unix.connect socket (Unix.ADDR_UNIX path)
+ with Unix.Unix_error(Unix.ECONNREFUSED, "connect", "") ->
+ Logs.err (fun f -> f "Failed to connect to %S" path);
+ exit 1
+ end;
+ let endpoint = Endpoint.of_socket ~switch socket in
+ let conn = CapTP.of_endpoint ~switch endpoint in
+ CapTP.bootstrap conn
+
+let rm_socket path =
+ match Unix.lstat path with
+ | stat when stat.Unix.st_kind = Unix.S_SOCK -> Unix.unlink path
+ | _ -> failwith (Fmt.strf "%S exists and is not a socket" path)
+ | exception Unix.Unix_error(Unix.ENOENT, "lstat", _) -> ()
+
+let listen ~switch ~offer path =
+ let socket = Unix.(socket PF_UNIX SOCK_STREAM 0) in
+ Lwt_switch.add_hook (Some switch) (fun () -> Unix.close socket; Lwt.return_unit);
+ rm_socket path;
+ Unix.bind socket (Unix.ADDR_UNIX path);
+ Unix.listen socket 5;
+ let socket = Lwt_unix.of_unix_file_descr socket in
+ Logs.info (fun f -> f "Waiting for connections on %S" path);
+ let rec loop () =
+ Lwt_unix.accept socket >>= fun (c, _) ->
+ 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);
+ loop () in
+ loop ()
+
+module Actor = struct
+ type t = Fmt.style * string
+ let pp f (style, name) = Fmt.(styled style (const string name)) f ()
+ let tag = Logs.Tag.def "actor" pp
+end
+
+let pp_qid f = function
+ | None -> ()
+ | Some x ->
+ let s = Uint32.to_string x in
+ Fmt.(styled `Magenta (fun f x -> Fmt.pf f " (qid=%s)" x)) f s
+
+let reporter =
+ let report src level ~over k msgf =
+ let src = Logs.Src.name src in
+ msgf @@ fun ?header ?(tags=Logs.Tag.empty) fmt ->
+ let actor =
+ match Logs.Tag.find Actor.tag tags with
+ | Some x -> x
+ | None -> `Black, "------"
+ in
+ let qid = Logs.Tag.find Capnp_rpc.Debug.qid_tag tags in
+ let print _ =
+ Fmt.(pf stderr) "%a@." pp_qid qid;
+ over ();
+ k ()
+ in
+ Fmt.kpf print Fmt.stderr ("%a %a %a: @[" ^^ fmt ^^ "@]")
+ Fmt.(styled `Magenta string) (Printf.sprintf "%11s" src)
+ Logs_fmt.pp_header (level, header)
+ Actor.pp actor
+ in
+ { Logs.report = report }
+
+let init_logging () =
+ Fmt_tty.setup_std_outputs ();
+ Logs.set_reporter reporter;
+ Logs.set_level (Some Logs.Info)
diff --git a/projects/miragesdk/examples/https-unikernel/src/debug.ml b/projects/miragesdk/examples/https-unikernel/src/debug.ml
new file mode 100644
index 000000000..722fbc3d4
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/debug.ml
@@ -0,0 +1 @@
+let endpoint_tag = Logs.Tag.def "endpoint" Fmt.string
diff --git a/projects/miragesdk/examples/https-unikernel/src/http_main.ml b/projects/miragesdk/examples/https-unikernel/src/http_main.ml
new file mode 100644
index 000000000..c37c999f4
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/http_main.ml
@@ -0,0 +1,24 @@
+let () = Common.init_logging ()
+
+let main store_socket http_socket =
+ Lwt_main.run begin
+ Lwt_switch.with_switch @@ fun switch ->
+ let store = Common.connect ~switch store_socket in
+ let http = Http_server.service store in
+ Common.listen ~switch ~offer:http http_socket
+ end
+
+open Cmdliner
+
+let store =
+ let doc = "The database store to use" in
+ Arg.(required @@ opt (some string) None @@ info ~doc ~docv:"STORE" ["store"])
+
+let http =
+ let doc = "The http socket to provide" in
+ Arg.(required @@ pos 0 (some string) None @@ info ~doc ~docv:"HTTP" [])
+
+let cmd =
+ Term.(const main $ store $ http), Term.info "http"
+
+let () = Term.(exit @@ eval cmd)
diff --git a/projects/miragesdk/examples/https-unikernel/src/http_server.ml b/projects/miragesdk/examples/https-unikernel/src/http_server.ml
new file mode 100644
index 000000000..fd38bbdf3
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/http_server.ml
@@ -0,0 +1,135 @@
+let src = Logs.Src.create "web.http" ~doc:"HTTP engine for web server"
+module Log = (val Logs.src_log src: Logs.LOG)
+
+open Capnp_rpc_lwt
+open Lwt.Infix
+open Astring
+
+module Remote_flow = struct
+ type buffer = Cstruct.t
+ type flow = Api.Reader.Flow.t Capability.t
+ type error = [`Capnp of Capnp_rpc.Error.t]
+ type write_error = [Mirage_flow.write_error | `Capnp of Capnp_rpc.Error.t]
+ type 'a io = 'a Lwt.t
+
+ let create x = x
+
+ 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 ->
+ let p = R.of_payload resp in
+ let data = R.data_get p in
+ Lwt.return (Ok (`Data (Cstruct.of_string data)))
+
+ 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 _ ->
+ Lwt.return (Ok ())
+
+ let writev t data =
+ write t (Cstruct.concat data)
+
+ let close _ = failwith "TODO: close"
+
+ let pp_error f = function
+ | `Capnp e -> Capnp_rpc.Error.pp f e
+ | `Closed -> Fmt.string f "Closed"
+
+ let pp_write_error f = function
+ | `Capnp e -> Capnp_rpc.Error.pp f e
+ | #Mirage_flow.write_error as e -> Mirage_flow.pp_write_error f e
+end
+
+module IO = struct
+ type 'a t = 'a Lwt.t
+ let (>>=) = Lwt.bind
+ let return = Lwt.return
+
+ type ic = Lwt_io.input_channel
+ type oc = Lwt_io.output_channel
+ type conn = Remote_flow.flow
+
+ let read_line ic =
+ Lwt_io.read_line_opt ic
+
+ let read ic count =
+ let count = min count Sys.max_string_length in
+ Lwt_io.read ~count ic
+
+ let write oc buf =
+ Lwt_io.write oc buf
+
+ let flush oc =
+ Lwt_io.flush oc
+end
+
+module Server = Cohttp_lwt.Make_server(IO)
+
+type t = Api.Reader.Store.t Capability.t
+
+(* Make a Cap'n'Proto call to the store service *)
+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 ->
+ let open Api.Reader.Store in
+ match GetResults.get (GetResults.of_payload resp) with
+ | GetResults.NotFound -> Lwt.return None
+ | GetResults.Ok data -> Lwt.return (Some data)
+ | GetResults.Undefined _ -> failwith "Protocol error: bad msg type"
+
+(* Handle HTTP requests *)
+let callback t _conn req _body =
+ let open Cohttp in
+ let uri = Request.uri req in
+ Log.info (fun f -> f "HTTP request for %a" Uri.pp_hum uri);
+ match Request.meth req with
+ | `GET ->
+ let path = String.cuts ~empty:false ~sep:"/" (Uri.path uri) in
+ let path =
+ match path with
+ | [] -> ["index.html"]
+ | p -> p
+ in
+ begin get t path >>= function
+ | Some body -> Server.respond_string ~status:`OK ~body ()
+ | None -> Server.respond_not_found ~uri ()
+ end
+ | m ->
+ let body = Fmt.strf "Bad method %S" (Code.string_of_method m) in
+ Server.respond_error ~status:`Bad_request ~body ()
+
+let callback t = Server.callback (Server.make ~callback:(callback t) ())
+
+module Remote_flow_unix = Mirage_flow_unix.Make(Remote_flow)
+
+let handle_connection store c =
+ Log.info (fun f -> f "Handing new connection");
+ let flow = Remote_flow.create c in
+ callback store flow (Remote_flow_unix.ic flow) (Remote_flow_unix.oc flow) >>= fun () ->
+ Capability.dec_ref c;
+ Lwt.return_unit
+
+let service store =
+ Api.Builder.HttpServer.local @@
+ object (_ : Api.Builder.HttpServer.service)
+ method accept 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
+ match P.connection_get p with
+ | None -> Service.fail "No connection!"
+ | Some i ->
+ let c = Payload.import req i in
+ Service.return_lwt (fun () ->
+ handle_connection store c >|= fun () ->
+ Ok (Service.Response.create_empty ())
+ )
+ end
diff --git a/projects/miragesdk/examples/https-unikernel/src/jbuild b/projects/miragesdk/examples/https-unikernel/src/jbuild
new file mode 100644
index 000000000..0eb30fec6
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/jbuild
@@ -0,0 +1,25 @@
+(* -*- tuareg -*- *)
+open Jbuild_plugin.V1
+
+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 %s)) \
+ )) \
+ (rule \
+ ((targets (proto.ml proto.mli)) \
+ (deps (proto.capnp)) \
+ (action (run capnpc -o ocaml ${<})))) \
+" extra_flags
+
+let () =
+ send sexp
diff --git a/projects/miragesdk/examples/https-unikernel/src/main.ml b/projects/miragesdk/examples/https-unikernel/src/main.ml
new file mode 100644
index 000000000..46b582060
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/main.ml
@@ -0,0 +1,37 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let switch = Lwt_switch.create ()
+
+let socket_pair ~switch =
+ let client, server = Unix.(socketpair PF_UNIX SOCK_STREAM 0) in
+ Lwt_switch.add_hook (Some switch) (fun () ->
+ Unix.close client;
+ Unix.close server;
+ Lwt.return ()
+ );
+ (Endpoint.of_socket ~switch client, Endpoint.of_socket ~switch server)
+
+let store_to_http, http_to_store = socket_pair ~switch
+let http_to_tls, tls_to_http = socket_pair ~switch
+
+let () =
+ Common.init_logging ();
+ Lwt_main.run begin
+ 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
+ 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 service = Http_server.service store in
+ let _ : CapTP.t = CapTP.of_endpoint ~offer:service ~tags ~switch http_to_tls in
+ Lwt.return ()
+ end
+ >>= fun () ->
+ Tls_terminator.init ~switch ~to_http:tls_to_http
+ end
diff --git a/projects/miragesdk/examples/https-unikernel/src/main.mli b/projects/miragesdk/examples/https-unikernel/src/main.mli
new file mode 100644
index 000000000..e69de29bb
diff --git a/projects/miragesdk/examples/https-unikernel/src/proto.capnp b/projects/miragesdk/examples/https-unikernel/src/proto.capnp
new file mode 100644
index 000000000..49a7797ed
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/proto.capnp
@@ -0,0 +1,21 @@
+@0xe81d238ec50a0daa;
+
+interface Store {
+ struct GetResults {
+ union {
+ ok @0 :Text;
+ notFound @1 :Void;
+ }
+ }
+
+ get @0 (path :List(Text)) -> GetResults;
+}
+
+interface Flow {
+ read @0 () -> (data :Data);
+ write @1 (data :Data) -> ();
+}
+
+interface HttpServer {
+ accept @0 (connection :Flow) -> ();
+}
diff --git a/projects/miragesdk/examples/https-unikernel/src/store.ml b/projects/miragesdk/examples/https-unikernel/src/store.ml
new file mode 100644
index 000000000..bfb02b33c
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/store.ml
@@ -0,0 +1,33 @@
+let src = Logs.Src.create "web.store" ~doc:"Datastore for web server"
+module Log = (val Logs.src_log src: Logs.LOG)
+
+module Irmin_store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
+
+open Lwt.Infix
+open Capnp_rpc_lwt
+open Astring
+
+(* The Cap'n'Proto service interface we expose. *)
+let service () =
+ let config = Irmin_fs.config "www-data" in
+ 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 =
+ let module P = Api.Reader.Store.Get_params in
+ let module R = Api.Builder.Store.GetResults in
+ let params = P.of_payload req in
+ let path = P.path_get_list params in
+ Log.info (fun f -> f "Handing request for %a" (Fmt.Dump.list String.dump) path);
+ Service.return_lwt (fun () ->
+ let resp, results = Service.Response.create R.init_pointer in
+ begin
+ Irmin_store.find db path >|= function
+ | Some data -> R.ok_set results data
+ | None -> R.not_found_set results
+ end
+ >>= fun () ->
+ Lwt.return (Ok resp)
+ )
+ end
diff --git a/projects/miragesdk/examples/https-unikernel/src/store_main.ml b/projects/miragesdk/examples/https-unikernel/src/store_main.ml
new file mode 100644
index 000000000..8ae1115d9
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/store_main.ml
@@ -0,0 +1,21 @@
+open Lwt.Infix
+
+let () = Common.init_logging ()
+
+let main store_socket =
+ Lwt_main.run begin
+ Lwt_switch.with_switch @@ fun switch ->
+ Store.service () >>= fun store ->
+ Common.listen ~switch ~offer:store store_socket
+ end
+
+open Cmdliner
+
+let store =
+ let doc = "The database store to serve" in
+ Arg.(required @@ pos 0 (some string) None @@ info ~doc ~docv:"STORE" [])
+
+let cmd =
+ Term.(const main $ store), Term.info "store"
+
+let () = Term.(exit @@ eval cmd)
diff --git a/projects/miragesdk/examples/https-unikernel/src/test_store.py b/projects/miragesdk/examples/https-unikernel/src/test_store.py
new file mode 100644
index 000000000..d44441fe6
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/test_store.py
@@ -0,0 +1,10 @@
+import capnp
+import capnp
+import proto_capnp
+import socket
+s = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM, 0)
+s.connect('/tmp/store.sock')
+client = capnp.TwoPartyClient(s)
+store = client.bootstrap().cast_as(proto_capnp.Store)
+r = store.get(['index.html'])
+print r.wait()
diff --git a/projects/miragesdk/examples/https-unikernel/src/tls_main.ml b/projects/miragesdk/examples/https-unikernel/src/tls_main.ml
new file mode 100644
index 000000000..f71ed5f9d
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/tls_main.ml
@@ -0,0 +1,23 @@
+let () = Common.init_logging ()
+
+let main http_socket port =
+ Lwt_main.run begin
+ Lwt_switch.with_switch @@ fun switch ->
+ let http_service = Common.connect ~switch http_socket in
+ Tls_terminator.run ~http_service ~port
+ end
+
+open Cmdliner
+
+let http =
+ let doc = "The HTTP service to use" in
+ Arg.(required @@ opt (some string) None @@ info ~doc ~docv:"HTTP" ["http"])
+
+let tls =
+ let doc = "The TLS port on which to listen for incoming connections" in
+ Arg.(value @@ opt int 8443 @@ info ~doc ~docv:"PORT" ["port"])
+
+let cmd =
+ Term.(const main $ http $ tls), Term.info "tls"
+
+let () = Term.(exit @@ eval cmd)
diff --git a/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml b/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml
new file mode 100644
index 000000000..7d91c58e5
--- /dev/null
+++ b/projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml
@@ -0,0 +1,53 @@
+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