diff --git a/projects/miragesdk/src/README.md b/projects/miragesdk/src/README.md index 9640b090c..a6d4aa6b9 100644 --- a/projects/miragesdk/src/README.md +++ b/projects/miragesdk/src/README.md @@ -1,7 +1,23 @@ -## DHCP client using MirageOS +### SDK -To debug/build, the `enter-dev` target will create a dev container where -`make dev` will build and run the current state of the prototype: +To build and test the SDK, run: + +``` +$ make test +``` + +This will work on any OS. + +### DHCP client using MirageOS + +To build the MirageOS DHCP client, run: + +``` +$ make dev +``` + +As this is using some BPF runes, this will work only on Linux. To debug/build +on OSX, you can create a container and build from there: ``` make enter-dev @@ -11,4 +27,4 @@ make dev ### Documentation -See the [general architecture document](../../doc/unikernel.md). \ No newline at end of file +See the [general architecture document](../../doc/unikernel.md). diff --git a/projects/miragesdk/src/dhcp-client/main.ml b/projects/miragesdk/src/dhcp-client/main.ml index 88994e257..22f590ac8 100644 --- a/projects/miragesdk/src/dhcp-client/main.ml +++ b/projects/miragesdk/src/dhcp-client/main.ml @@ -41,8 +41,10 @@ end external bpf_filter: unit -> string = "bpf_filter" -let ctl = string_of_int Init.(Fd.to_int Pipe.(calf ctl)) -let net = string_of_int Init.(Fd.to_int Pipe.(calf net)) +let t = Init.Pipe.v () + +let ctl = string_of_int Init.(Fd.to_int Pipe.(calf @@ ctl t)) +let net = string_of_int Init.(Fd.to_int Pipe.(calf @@ net t)) let default_cmd = [ "/dhcp-client-calf"; "--ctl="^ctl; "--net="^net ] @@ -78,10 +80,10 @@ let read_cmd file = "/nameservers/*" ] in Ctl.v "/data" >>= fun ctl -> - let fd = Init.(Fd.fd @@ Pipe.(priv ctl)) in + let fd = Init.(Fd.fd @@ Pipe.(priv @@ ctl t)) in let ctl () = Ctl.Server.listen ~routes ctl fd in let handlers () = Handlers.watch path in - Init.run ~net ~ctl ~handlers cmd + Init.run t ~net ~ctl ~handlers cmd ) (* CLI *) diff --git a/projects/miragesdk/src/sdk/init.ml b/projects/miragesdk/src/sdk/init.ml index b77e48f88..5f6559893 100644 --- a/projects/miragesdk/src/sdk/init.ml +++ b/projects/miragesdk/src/sdk/init.ml @@ -95,6 +95,20 @@ module Pipe = struct type t = Fd.t * Fd.t + type monitor = { + stdout: t; + stderr: t; + metrics: t; + ctl: t; + net: t; + } + + let stdout t = t.stdout + let stderr t = t.stderr + let metrics t = t.metrics + let ctl t = t.ctl + let net t = t.net + let name (x, _) = x.Fd.name let priv = fst @@ -112,37 +126,36 @@ module Pipe = struct Lwt_unix.clear_close_on_exec calf; { Fd.name = name; fd = priv }, { Fd.name = name ^ "-calf"; fd = calf } - (* logs pipe *) - let stdout = pipe "stdout" - let stderr = pipe "stderr" - - (* store pipe *) - let ctl = socketpair "ctl" - - (* network pipe *) - let net = socketpair "net" - - (* metrics pipe *) - let metrics = pipe "metrics" + let v () = + (* logs pipe *) + let stdout = pipe "stdout" in + let stderr = pipe "stderr" in + (* store pipe *) + let ctl = socketpair "ctl" in + (* network pipe *) + let net = socketpair "net" in + (* metrics pipe *) + let metrics = pipe "metrics" in + { stdout; stderr; ctl; net; metrics } end -let exec_calf cmd = +let exec_calf t cmd = Fd.(redirect_to_dev_null stdin) >>= fun () -> (* close parent fds *) - Fd.close Pipe.(priv stdout) >>= fun () -> - Fd.close Pipe.(priv stderr) >>= fun () -> - Fd.close Pipe.(priv ctl) >>= fun () -> - Fd.close Pipe.(priv net) >>= fun () -> - Fd.close Pipe.(priv metrics) >>= fun () -> + Fd.close Pipe.(priv t.stdout) >>= fun () -> + Fd.close Pipe.(priv t.stderr) >>= fun () -> + Fd.close Pipe.(priv t.ctl) >>= fun () -> + Fd.close Pipe.(priv t.net) >>= fun () -> + Fd.close Pipe.(priv t.metrics) >>= fun () -> let cmds = String.concat " " cmd in - let calf_net = Pipe.(calf net) in - let calf_ctl = Pipe.(calf ctl) in - let calf_stdout = Pipe.(calf stdout) in - let calf_stderr = Pipe.(calf stderr) in + let calf_net = Pipe.(calf t.net) in + let calf_ctl = Pipe.(calf t.ctl) in + let calf_stdout = Pipe.(calf t.stdout) in + let calf_stderr = Pipe.(calf t.stderr) in Log.info (fun l -> l "Executing %s" cmds); Log.debug (fun l -> l "net-fd=%a store-fd=%a" Fd.pp calf_net Fd.pp calf_ctl); @@ -167,16 +180,16 @@ let check_exit_status cmd status = | Unix.WSIGNALED i -> failf "%s: signal %d" cmds i | Unix.WSTOPPED i -> failf "%s: stopped %d" cmds i -let exec_priv ~pid ~cmd ~net ~ctl ~handlers = +let exec_priv t ~pid ~cmd ~net ~ctl ~handlers = Fd.(redirect_to_dev_null stdin) >>= fun () -> (* close child fds *) - Fd.close Pipe.(calf stdout) >>= fun () -> - Fd.close Pipe.(calf stderr) >>= fun () -> - Fd.close Pipe.(calf net) >>= fun () -> - Fd.close Pipe.(calf ctl) >>= fun () -> - Fd.close Pipe.(calf metrics) >>= fun () -> + Fd.close Pipe.(calf t.stdout) >>= fun () -> + Fd.close Pipe.(calf t.stderr) >>= fun () -> + Fd.close Pipe.(calf t.net) >>= fun () -> + Fd.close Pipe.(calf t.ctl) >>= fun () -> + Fd.close Pipe.(calf t.metrics) >>= fun () -> let wait () = Lwt_unix.waitpid [] pid >>= fun (_pid, w) -> @@ -187,18 +200,18 @@ let exec_priv ~pid ~cmd ~net ~ctl ~handlers = Lwt.pick ([ wait (); (* data *) - Fd.proxy_net ~net Pipe.(priv net); + Fd.proxy_net ~net Pipe.(priv t.net); (* redirect the calf stdout to the shim stdout *) - Fd.forward ~src:Pipe.(priv stdout) ~dst:Fd.stdout; - Fd.forward ~src:Pipe.(priv stderr) ~dst:Fd.stderr; + Fd.forward ~src:Pipe.(priv t.stdout) ~dst:Fd.stdout; + Fd.forward ~src:Pipe.(priv t.stderr) ~dst:Fd.stderr; (* TODO: Init.Fd.forward ~src:Init.Pipe.(priv metrics) ~dst:Init.Fd.metric; *) ctl (); handlers (); ]) -let run ~net ~ctl ~handlers cmd = +let run t ~net ~ctl ~handlers cmd = Lwt_io.flush_all () >>= fun () -> match Lwt_unix.fork () with - | 0 -> exec_calf cmd - | pid -> exec_priv ~pid ~cmd ~net ~ctl ~handlers + | 0 -> exec_calf t cmd + | pid -> exec_priv t ~pid ~cmd ~net ~ctl ~handlers diff --git a/projects/miragesdk/src/sdk/init.mli b/projects/miragesdk/src/sdk/init.mli index 1e2828a26..4733b43b5 100644 --- a/projects/miragesdk/src/sdk/init.mli +++ b/projects/miragesdk/src/sdk/init.mli @@ -63,6 +63,11 @@ module Pipe: sig (** The type for pipes. Could be either uni-directional (normal pipes) or a bi-directional (socket pairs). *) + type monitor + (** The type for pipe monitors. *) + + val v: unit -> monitor + val name: t -> string (** [name t] is [t]'s name. *) @@ -74,23 +79,26 @@ module Pipe: sig (** {1 Useful Pipes} *) - val stdout: t - (** [stdout] is the uni-directional pipe from the calf's stdout . *) + val stdout: monitor -> t + (** [stdout m] is the uni-directional pipe from the calf's stdout + monitored by [m]. *) - val stderr: t - (** [stderr] is the uni-directional pipe from the calf's stderr. *) + val stderr: monitor -> t + (** [stderr m] is the uni-directional pipe from the calf's stderr + monitored by [m]. *) - val metrics: t - (** [metrics] is the uni-directional pipe fomr the calf's metric - endpoint. *) + val metrics: monitor -> t + (** [metrics m] is the uni-directional pipe from the calf's metric + endpoint monitored by [m]. *) - val ctl: t - (** [ctl] is the bi-directional pipe used to exchange control - data between the calf and the priv containers. *) + val ctl: monitor -> t + (** [ctl m] is the bi-directional pipe used to exchange control data + between the calf and the priv containers monitored by [m]. *) - val net: t - (** [net] is the bi-directional pipe used to exchange network - traffic between the calf and the priv containers. *) + val net: monitor -> t + (** [net m] is the bi-directional pipe used to exchange network + traffic between the calf and the priv containers monitored by + [m]. *) end @@ -98,12 +106,12 @@ val rawlink: ?filter:string -> string -> Lwt_rawlink.t (** [rawlink ?filter i] is the net raw link to the interface [i] using the (optional) BPF filter [filter]. *) -val run: +val run: Pipe.monitor -> net:Lwt_rawlink.t -> ctl:(unit -> unit Lwt.t) -> handlers:(unit -> unit Lwt.t) -> string list -> unit Lwt.t -(** [run ~net ~ctl ~handlers cmd] runs [cmd] in a unprivileged calf +(** [run m ~net ~ctl ~handlers cmd] runs [cmd] in a unprivileged calf process. [ctl] is the control thread connected to the {Pipe.ctl} pipe. [net] is the net raw link which will be connected to the calf via the {!Pipe.net} socket pair. [handlers] are the system diff --git a/projects/miragesdk/src/test/test.ml b/projects/miragesdk/src/test/test.ml index 5876f1805..c03543ef3 100644 --- a/projects/miragesdk/src/test/test.ml +++ b/projects/miragesdk/src/test/test.ml @@ -117,9 +117,9 @@ let test_serialization to_cstruct of_cstruct message messages = in List.iter test messages -let test_send write read message messages = - let calf = Init.Fd.fd @@ Init.Pipe.(calf ctl) in - let priv = Init.Fd.fd @@ Init.Pipe.(priv ctl) in +let test_send t write read message messages = + let calf = Init.Fd.fd @@ Init.Pipe.(calf @@ ctl t) in + let priv = Init.Fd.fd @@ Init.Pipe.(priv @@ ctl t) in let test m = write calf m >>= fun () -> read priv >|= function @@ -136,13 +136,13 @@ let test_reply_serialization () = let open Ctl.Reply in test_serialization to_cstruct of_cstruct reply replies -let test_query_send () = +let test_query_send t () = let open Ctl.Query in - test_send write read query queries + test_send t write read query queries -let test_reply_send () = +let test_reply_send t () = let open Ctl.Reply in - test_send write read reply replies + test_send t write read reply replies let failf fmt = Fmt.kstrf Alcotest.fail fmt @@ -191,9 +191,9 @@ let delete_should_work t k = | Ok () -> () | Error (`Msg e) -> failf "write(%s) -> error: %s" k e -let test_ctl () = - let calf = Init.Fd.fd @@ Init.Pipe.(calf ctl) in - let priv = Init.Fd.fd @@ Init.Pipe.(priv ctl) in +let test_ctl t () = + let calf = Init.Fd.fd @@ Init.Pipe.(calf @@ ctl t) in + let priv = Init.Fd.fd @@ Init.Pipe.(priv @@ ctl t) in let k1 = "/foo/bar" in let k2 = "a" in let k3 = "b/c" in @@ -238,16 +238,18 @@ let run f () = let test_stderr () = () +let t = Init.Pipe.v () + let test = [ - "stdout is a pipe" , `Quick, run (test_pipe Init.Pipe.stdout); - "stdout is a pipe" , `Quick, run (test_pipe Init.Pipe.stderr); - "net is a socket pair", `Quick, run (test_socketpair Init.Pipe.net); - "ctl is a socket pair", `Quick, run (test_socketpair Init.Pipe.ctl); + "stdout is a pipe" , `Quick, run (test_pipe Init.Pipe.(stdout t)); + "stdout is a pipe" , `Quick, run (test_pipe Init.Pipe.(stderr t)); + "net is a socket pair", `Quick, run (test_socketpair Init.Pipe.(net t)); + "ctl is a socket pair", `Quick, run (test_socketpair Init.Pipe.(ctl t)); "seralize queries" , `Quick, test_query_serialization; "seralize replies" , `Quick, test_reply_serialization; - "send queries" , `Quick, run test_query_send; - "send replies" , `Quick, run test_reply_send; - "ctl" , `Quick, run test_ctl; + "send queries" , `Quick, run (test_query_send t); + "send replies" , `Quick, run (test_reply_send t); + "ctl" , `Quick, run (test_ctl t); ] let reporter ?(prefix="") () =