Merge pull request #1395 from samoht/mirage

More progress on the Mirage SDK

projects/miragesdk/dhcp-client/.gitignore

@@ -3,9 +3,13 @@
 .dev
 obj/
 
+hash
+
 # Generated by `make dev`
 _build/
 main.native
+calf/dhcp_client
+src/bpf/.merlin
 
 # Generated by the mirage tool
 calf/_build

projects/miragesdk/dhcp-client/Dockerfile.build

@@ -5,7 +5,7 @@ RUN opam pin -n add conduit https://github.com/samoht/ocaml-conduit.git#fd
 RUN opam pin -n add mirage-net-unix https://github.com/samoht/mirage-net-unix.git#fd
 
 RUN opam depext -iy mirage-net-unix logs-syslog irmin-unix cohttp decompress
-RUN opam depext -iy rawlink
+RUN opam depext -iy rawlink tuntap.1.0.0 jbuilder irmin-watcher inotify
 
 RUN sudo mkdir -p /src /bin
 COPY ./src /src
@@ -14,5 +14,7 @@ RUN sudo chown opam -R /src
 USER opam
 WORKDIR /src
 
-RUN opam config exec -- ocamlbuild -use-ocamlfind -lflags -cclib,-static main.native
+RUN opam pin add tuntap 1.0.0
-RUN sudo cp /src/_build/main.native /dhcp-client
+
+RUN opam config exec -- jbuilder build main.exe
+RUN sudo cp /src/_build/default/main.exe /dhcp-client

projects/miragesdk/dhcp-client/Dockerfile.dev

@@ -5,7 +5,9 @@ RUN opam pin -n add conduit https://github.com/samoht/ocaml-conduit.git#fd
 RUN opam pin -n add mirage-net-unix https://github.com/samoht/mirage-net-unix.git#fd
 
 RUN opam depext -iy mirage-net-unix logs-syslog cohttp decompress
-RUN opam depext -iy rawlink
+RUN opam depext -iy rawlink tuntap.1.0.0 jbuilder
+
+RUN opam pin add tuntap 1.0.0
 
 RUN sudo mkdir -p /src /bin
 

projects/miragesdk/dhcp-client/Makefile

@@ -1,5 +1,6 @@
 BASE=ocaml/opam:alpine-3.5_ocaml-4.04.0
-FILES=src/main.ml src/inflator.ml src/io_fs.ml src/_tags
+FILES=$(shell find src/ -regex '.*\.mli?') src/bpf/dhcp.c \
+	src/jbuild src/bpf/jbuild
 IMAGE=dhcp-client
 OBJS=obj/dhcp-client
 
@@ -65,7 +66,9 @@ clean::
 
 dev:
 	cd calf && mirage configure && make
-	ocamlbuild -use-ocamlfind -lflags -cclib,-static src/main.native
+	jbuilder build src/main.exe
-	sudo ./_build/src/main.native -vv --cmd 'calf/_build/main.native -l debug --store 10 --net 12'
+#	_build/default/src/main.exe -vv \
+#	  --cmd 'calf/_build/main.native -l debug --store 10 --net 12' \
+#	  --ethif eno1
 
 .DELETE_ON_ERROR:

projects/miragesdk/dhcp-client/calf/config.ml

@@ -33,9 +33,9 @@ let net =
   let key = Key.(create "input" Arg.(opt int 3 doc)) in
   netif_of_fd key
 
-let store =
+let ctl =
   let doc =
-    Key.Arg.info ~docv:"FD" ~doc:"Store interface" ["store"]
+    Key.Arg.info ~docv:"FD" ~doc:"Control interface" ["ctl"]
   in
   let key = Key.(create "output" Arg.(opt int 4 doc)) in
   netif_of_fd key
@@ -54,4 +54,4 @@ let main =
   foreign ~keys ~packages "Unikernel.Main"
     (time @-> network @-> network @-> job)
 
-let () = register "dhcp-client" [main $ default_time $ net $ store]
+let () = register "dhcp-client" [main $ default_time $ net $ ctl]

projects/miragesdk/dhcp-client/calf/unikernel.ml

@@ -199,13 +199,13 @@ end
 module Main
     (Time :Mirage_time_lwt.S)
     (Net  : Mirage_net_lwt.S)
-    (Store: Mirage_net_lwt.S) =
+    (Ctl  : Mirage_net_lwt.S) =
 struct
 
-  module API = API(Store)
+  module API = API(Ctl)
   module Dhcp_client = Dhcp_client_mirage.Make(Time)(Net)
 
-  let start () net store =
+  let start () net ctl =
     let requests = match Key_gen.codes () with
       | [] -> default_options
       | l  ->
@@ -220,6 +220,6 @@ struct
     Lwt_stream.last_new stream >>= fun result ->
     let result = of_ipv4_config result in
     Log.info (fun l -> l "found lease: %a" pp result);
-    API.set_ip store result.address
+    API.set_ip ctl result.address
 
 end

projects/miragesdk/dhcp-client/src/.merlin

@@ -1,4 +1,74 @@
-PKG mirage-net-unix logs-syslog.lwt irmin-unix webmachine cmdliner decompress
+B ../_build/default/src
+B ../_build/default/src/bpf
+FLG -cclib -static
+PKG astring
+PKG base64
+PKG bigarray
+PKG bytes
+PKG calendar
+PKG cmdliner
+PKG cohttp
+PKG cohttp.lwt
+PKG cohttp.lwt-core
+PKG conduit
+PKG conduit.lwt
+PKG conduit.lwt-unix
+PKG cstruct
+PKG cstruct.lwt
+PKG cstruct.ppx
+PKG decompress
+PKG dispatch
+PKG fieldslib
+PKG fmt
+PKG fmt.cli
+PKG fmt.tty
+PKG git
+PKG hex
+PKG inotify
+PKG inotify.lwt
+PKG ipaddr
+PKG ipaddr.unix
+PKG irmin
+PKG irmin-git
+PKG irmin-http
+PKG irmin-watcher
+PKG irmin-watcher.core
+PKG irmin-watcher.inotify
+PKG irmin-watcher.polling
+PKG jsonm
+PKG logs
+PKG logs-syslog
+PKG logs-syslog.lwt
+PKG logs.cli
+PKG logs.fmt
+PKG logs.lwt
+PKG lwt
+PKG lwt.log
+PKG lwt.unix
+PKG magic-mime
+PKG mstruct
+PKG ocamlgraph
+PKG ocplib-endian
+PKG ocplib-endian.bigstring
+PKG ptime
+PKG ptime.clock.os
 PKG rawlink
+PKG re
+PKG re.emacs
+PKG re.posix
+PKG re.str
+PKG result
+PKG sexplib
+PKG str
+PKG stringext
+PKG syslog-message
+PKG threads
+PKG threads.posix
+PKG tuntap
+PKG uchar
+PKG unix
+PKG uri
+PKG uri.services
+PKG uutf
+PKG webmachine
 S .
-B _build/

projects/miragesdk/dhcp-client/src/_tags

@@ -1,6 +0,0 @@
-true: bin_annot, debug, strict_sequence
-true: warn_error(+1..49+60), warn(A-4-41-44-7)
-true: thread
-true: package(mirage-net-unix,logs-syslog.lwt,threads,cohttp.lwt)
-true: package(cmdliner,fmt.cli,logs.fmt,logs.cli,fmt.tty,decompress)
-true: package(irmin,irmin-git,irmin-http,lwt.unix,rawlink)

projects/miragesdk/dhcp-client/src/bpf/dhcp.c

@@ -0,0 +1,89 @@
+/* dhcp_bpf_filter taken from bpf.c in dhcp-3.1.0
+ *
+ * Copyright (c) 2004,2007 by Internet Systems Consortium, Inc. ("ISC")
+ * Copyright (c) 1996-2003 by Internet Software Consortium
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+ * OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *   Internet Systems Consortium, Inc.
+ *   950 Charter Street
+ *   Redwood City, CA 94063
+ *   <info@isc.org>
+ *   http://www.isc.org/
+ */
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/ioctl.h>
+
+#include <net/ethernet.h>
+
+#include <linux/if_packet.h>
+#include <linux/filter.h>
+
+#include <net/if.h>
+
+#include <arpa/inet.h>
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <fcntl.h>
+
+#include "caml/memory.h"
+#include "caml/fail.h"
+#include "caml/unixsupport.h"
+#include "caml/signals.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/bigarray.h"
+
+#define BOOTPC          68
+#define BPF_WHOLEPACKET 0x0fffffff
+
+#ifndef BPF_ETHCOOK
+# define BPF_ETHCOOK 0
+#endif
+
+static const struct sock_filter bootp_bpf_filter [] = {
+  /* Make sure this is an IP packet... */
+  BPF_STMT(BPF_LD + BPF_H + BPF_ABS, 12),
+  BPF_JUMP(BPF_JMP + BPF_JEQ + BPF_K, ETHERTYPE_IP, 0, 8),
+  /* Make sure it's a UDP packet... */
+  BPF_STMT(BPF_LD + BPF_B + BPF_ABS, 23 + BPF_ETHCOOK),
+  BPF_JUMP(BPF_JMP + BPF_JEQ + BPF_K, IPPROTO_UDP, 0, 6),
+  /* Make sure this isn't a fragment... */
+  BPF_STMT(BPF_LD + BPF_H + BPF_ABS, 20 + BPF_ETHCOOK),
+  BPF_JUMP(BPF_JMP + BPF_JSET + BPF_K, 0x1fff, 4, 0),
+  /* Get the IP header length... */
+  BPF_STMT(BPF_LDX + BPF_B + BPF_MSH, 14 + BPF_ETHCOOK),
+  /* Make sure it's to the right port... */
+  BPF_STMT(BPF_LD + BPF_H + BPF_IND, 16 + BPF_ETHCOOK),
+  BPF_JUMP(BPF_JMP + BPF_JEQ + BPF_K, BOOTPC, 0, 1),
+  /* If we passed all the tests, ask for the whole packet. */
+  BPF_STMT(BPF_RET + BPF_K, BPF_WHOLEPACKET),
+  /* Otherwise, drop it. */
+  BPF_STMT(BPF_RET + BPF_K, 0),
+};
+
+/* Filters */
+CAMLprim value bpf_filter(value vunit)
+{
+  CAMLparam0();
+  CAMLlocal1(vfilter);
+  vfilter = caml_alloc_string(sizeof(bootp_bpf_filter));
+  memcpy(String_val(vfilter), bootp_bpf_filter, sizeof(bootp_bpf_filter));
+  CAMLreturn (vfilter);
+}

projects/miragesdk/dhcp-client/src/bpf/jbuild

@@ -0,0 +1,6 @@
+(jbuild_version 1)
+
+(library
+ ((name            bpf_dhcp)
+  (c_names         (dhcp))
+))

projects/miragesdk/dhcp-client/src/ctl.ml

@@ -0,0 +1,128 @@
+open Lwt.Infix
+
+let src = Logs.Src.create "init" ~doc:"Init steps"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(* FIXME: to avoid linking with gmp *)
+module IO = struct
+  type ic = unit
+  type oc = unit
+  type ctx = unit
+  let with_connection ?ctx:_ _uri ?init:_ _f = Lwt.fail_with "not allowed"
+  let read_all _ic = Lwt.fail_with "not allowed"
+  let read_exactly _ic _n = Lwt.fail_with "not allowed"
+  let write _oc _buf = Lwt.fail_with "not allowed"
+  let flush _oc = Lwt.fail_with "not allowed"
+  let ctx () = Lwt.return_none
+end
+
+(* FIXME: we don't use Irmin_unix.Git.FS.KV to avoid linking with gmp *)
+module Store = Irmin_git.FS.KV(IO)(Inflator)(Io_fs)
+module KV = Store(Irmin.Contents.String)
+
+let v path =
+  let config = Irmin_git.config path in
+  KV.Repo.v config >>= fun repo ->
+  KV.of_branch repo "calf"
+
+let set_listen_dir_hook () =
+  Irmin.Private.Watch.set_listen_dir_hook Irmin_watcher.hook
+
+module HTTP = struct
+
+  module Wm = struct
+    module Rd = Webmachine.Rd
+    include Webmachine.Make(Cohttp_lwt_unix.Server.IO)
+  end
+
+  let with_key rd f =
+    match KV.Key.of_string rd.Wm.Rd.dispatch_path with
+    | Ok x    -> f x
+    | Error _ -> Wm.respond 404 rd
+
+  let infof fmt =
+    Fmt.kstrf (fun msg () ->
+        let date = Int64.of_float (Unix.gettimeofday ()) in
+        Irmin.Info.v ~date ~author:"calf" msg
+      ) fmt
+
+  let ok = "{\"status\": \"ok\"}"
+
+  class item db = object(self)
+
+    inherit [Cohttp_lwt_body.t] Wm.resource
+
+    method private of_string rd =
+      Cohttp_lwt_body.to_string rd.Wm.Rd.req_body >>= fun value ->
+      with_key rd (fun key ->
+          let info = infof "Updating %a" KV.Key.pp key in
+          KV.set db ~info key value >>= fun () ->
+          let resp_body = `String ok in
+          let rd = { rd with Wm.Rd.resp_body } in
+          Wm.continue true rd
+        )
+
+    method private to_string rd =
+      with_key rd (fun key ->
+          KV.find db key >>= function
+          | Some value -> Wm.continue (`String value) rd
+          | None       -> assert false
+        )
+
+    method resource_exists rd =
+      with_key rd (fun key ->
+          KV.mem db key >>= fun mem ->
+          Wm.continue mem rd
+        )
+
+    method allowed_methods rd =
+      Wm.continue [`GET; `HEAD; `PUT; `DELETE] rd
+
+    method content_types_provided rd =
+      Wm.continue [
+        "plain", self#to_string
+      ] rd
+
+    method content_types_accepted rd =
+      Wm.continue [
+        "plain", self#of_string
+      ] rd
+
+    method delete_resource rd =
+      with_key rd (fun key ->
+          let info = infof "Deleting %a" KV.Key.pp key in
+          KV.remove db ~info key >>= fun () ->
+          let resp_body = `String ok in
+          Wm.continue true { rd with Wm.Rd.resp_body }
+        )
+  end
+
+  let v db routes =
+    let routes = List.map (fun r -> r, fun () -> new item db) routes in
+    let callback (_ch, _conn) request body =
+      let open Cohttp in
+      (Wm.dispatch' routes ~body ~request >|= function
+        | None        -> (`Not_found, Header.init (), `String "Not found", [])
+        | Some result -> result)
+      >>= fun (status, headers, body, path) ->
+      Log.info (fun l ->
+          l "%d - %s %s"
+            (Code.code_of_status status)
+            (Code.string_of_method (Request.meth request))
+            (Uri.path (Request.uri request)));
+      Log.debug (fun l -> l "path=%a" Fmt.(Dump.list string) path);
+      (* Finally, send the response to the client *)
+      Cohttp_lwt_unix.Server.respond ~flush:true ~headers ~body ~status ()
+    in
+    (* create the server and handle requests with the function defined above *)
+    let conn_closed (_, conn) =
+      Log.info (fun l ->
+          l "connection %s closed\n%!" (Cohttp.Connection.to_string conn))
+    in
+    Cohttp_lwt_unix.Server.make ~callback ~conn_closed ()
+end
+
+let serve ~routes db fd =
+  let http = HTTP.v db routes in
+  let on_exn e = Log.err (fun l -> l "ERROR: %a" Fmt.exn e) in
+  Cohttp_lwt_unix.Server.create ~on_exn ~mode:(`Fd fd) http

projects/miragesdk/dhcp-client/src/ctl.mli

@@ -0,0 +1,16 @@
+(** [Control] handle the server part of the control path, running in
+    the privileged container. *)
+
+module KV: Irmin.KV with type contents = string
+
+val v: string -> KV.t Lwt.t
+(** [v p] is the KV store storing the control state, located at path
+    [p] in the filesystem of the privileged container. *)
+
+val serve: routes:string list -> KV.t -> Lwt_unix.file_descr -> unit Lwt.t
+(** [serve ~routes kv fd] is the thread exposing the KV store [kv],
+    holding control state, running inside the privileged container.
+    [routes] are the routes exposed by the server (currently over a
+    simple HTTP server -- but will change to something else later,
+    probably protobuf) to the calf and [kv] is the control state
+    handler. *)

projects/miragesdk/dhcp-client/src/init.ml

@@ -0,0 +1,216 @@
+open Lwt.Infix
+
+let src = Logs.Src.create "init" ~doc:"Init steps"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let failf fmt = Fmt.kstrf Lwt.fail_with fmt
+
+module Fd = struct
+
+  type t = {
+    name: string;
+    fd  : Lwt_unix.file_descr;
+  }
+
+  let fd t = t.fd
+  let stdout = { name = "stdout"; fd = Lwt_unix.stdout }
+  let stderr = { name = "stderr"; fd = Lwt_unix.stderr }
+  let stdin  = { name = "stdin" ; fd = Lwt_unix.stdin  }
+
+  let to_int t =
+    (Obj.magic (Lwt_unix.unix_file_descr t.fd): int)
+
+  let pp ppf fd = Fmt.pf ppf "%s:%d" fd.name (to_int fd)
+
+  let close fd =
+    Log.debug (fun l -> l "close %a" pp fd);
+    Lwt_unix.close fd.fd
+
+  let dev_null =
+    Lwt_unix.of_unix_file_descr ~blocking:false
+      (Unix.openfile "/dev/null" [Unix.O_RDWR] 0)
+
+  let redirect_to_dev_null fd =
+    Log.debug (fun l -> l "redirect-stdin-to-dev-null");
+    Lwt_unix.close fd.fd >>= fun () ->
+    Lwt_unix.dup2 dev_null fd.fd;
+    Lwt_unix.close dev_null
+
+  let dup2 ~src ~dst =
+    Log.debug (fun l -> l "dup2 %a => %a" pp src pp dst);
+    Lwt_unix.dup2 src.fd dst.fd;
+    close src
+
+  let proxy_net ~net fd =
+    Log.debug (fun l -> l "proxy-net eth0 <=> %a" pp fd);
+    let rec listen_rawlink () =
+      Lwt_rawlink.read_packet net >>= fun buf ->
+      Log.debug (fun l -> l "PROXY-NET: => %a" Cstruct.hexdump_pp buf);
+      Log.debug (fun l -> l "PROXY-NET: => %S" (Cstruct.to_string buf));
+      let rec write buf =
+        Lwt_cstruct.write fd.fd buf >>= function
+        | 0 -> Lwt.return_unit
+        | n -> write (Cstruct.shift buf n)
+      in
+      write buf >>= fun () ->
+      listen_rawlink ()
+    in
+    let listen_socket () =
+      let len = 16 * 1024 in
+      let buf = Cstruct.create len in
+      let rec loop () =
+        Lwt_cstruct.read fd.fd buf >>= fun len ->
+        let buf = Cstruct.sub buf 0 len in
+        Log.debug (fun l -> l "PROXY-NET: <= %a" Cstruct.hexdump_pp buf);
+        Lwt_rawlink.send_packet net buf >>= fun () ->
+        loop ()
+      in
+      loop ()
+    in
+    Lwt.pick [
+      listen_rawlink ();
+      listen_socket ();
+    ]
+
+  let rec really_write dst buf off len =
+    match len with
+    | 0   -> Lwt.return_unit
+    | len ->
+      Lwt_unix.write dst.fd buf off len >>= fun n ->
+      really_write dst buf (off+n) (len-n)
+
+  let forward ~src ~dst =
+    Log.debug (fun l -> l "forward %a => %a" pp src pp dst);
+    let len = 16 * 1024 in
+    let buf = Bytes.create len in
+    let rec loop () =
+      Lwt_unix.read src.fd buf 0 len >>= fun len ->
+      if len = 0 then
+        (* FIXME: why this ever happen *)
+        Fmt.kstrf Lwt.fail_with "FORWARD[%a => %a]: EOF" pp src pp dst
+      else (
+        Log.debug (fun l ->
+            l "FORWARD[%a => %a]: %S (%d)"
+              pp src pp dst (Bytes.sub buf 0 len) len);
+        really_write dst buf 0 len >>= fun () ->
+        loop ()
+      )
+    in
+    loop ()
+
+  let proxy x y =
+    Lwt.pick [
+      forward ~src:x ~dst:y;
+      forward ~src:y ~dst:x;
+    ]
+
+end
+
+module Pipe = struct
+
+  type t = Fd.t * Fd.t
+
+  let priv = fst
+  let calf = snd
+
+  let socketpair name =
+    let priv, calf = Lwt_unix.(socketpair PF_UNIX SOCK_STREAM 0) in
+    Lwt_unix.clear_close_on_exec priv;
+    Lwt_unix.clear_close_on_exec calf;
+    { Fd.name = name; fd = priv }, { Fd.name = name ^ "-calf"; fd = calf }
+
+  let pipe name =
+    let priv, calf = Lwt_unix.pipe () in
+    Lwt_unix.clear_close_on_exec priv;
+    Lwt_unix.clear_close_on_exec calf;
+    { Fd.name = name; fd = priv }, { Fd.name = name ^ "-calf"; fd = calf }
+
+  (* logs pipe *)
+  let stdout = pipe "logs-out"
+  let stderr = pipe "logs-err"
+
+  (* store pipe *)
+  let ctl = socketpair "ctl"
+
+  (* network pipe *)
+  let net = socketpair "net"
+
+  (* metrics pipe *)
+  let metrics = pipe "metrics"
+
+end
+
+let exec_calf 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 () ->
+
+  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
+
+  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);
+
+  Fd.dup2 ~src:calf_stdout ~dst:Fd.stdout >>= fun () ->
+  Fd.dup2 ~src:calf_stderr ~dst:Fd.stderr >>= fun () ->
+
+  (* exec the calf *)
+  Unix.execve (List.hd cmd) (Array.of_list cmd) [||]
+
+let rawlink ?filter ethif =
+  Log.debug (fun l -> l "bringing up %s" ethif);
+  (try Tuntap.set_up_and_running ethif
+   with e -> Log.err (fun l -> l "rawlink: %a" Fmt.exn e));
+  Lwt_rawlink.open_link ?filter ethif
+
+let check_exit_status cmd status =
+  let cmds = String.concat " " cmd in
+  match status with
+  | Unix.WEXITED 0   -> Lwt.return_unit
+  | Unix.WEXITED i   -> failf "%s: exit %d" cmds i
+  | 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 =
+
+  (* close child fds *)
+  Fd.(redirect_to_dev_null stdin)   >>= fun () ->
+  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 () ->
+
+  let wait () =
+    Lwt_unix.waitpid [] pid >>= fun (_pid, w) ->
+    Lwt_io.flush_all () >>= fun () ->
+
+    check_exit_status cmd w
+  in
+  Lwt.pick ([
+      wait ();
+      (* data *)
+      Fd.proxy_net ~net Pipe.(priv 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;
+      (* TODO: Init.Fd.forward ~src:Init.Pipe.(priv metrics) ~dst:Init.Fd.metric; *)
+      ctl ();
+      handlers ();
+    ])
+
+let run ~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

projects/miragesdk/dhcp-client/src/init.mli

@@ -0,0 +1,109 @@
+(** Init functions.
+
+    [Init] contains funcitons to initialise the state of the
+    privileged container.
+
+    {ul
+
+    {- fowrard and filter the network traffic using BPF (for instance
+       to allow only DHCP traffic).}
+    {- open pipes for forwarding the calf's stdout and stderr
+       to the privileged container's ones.}
+    {- open a pipe to forward the metrics.}
+    {- open a socket pair with the calf to be able to transmit control
+       data, e.g. the IP address once a DHCP lease is obtained.}
+    }*)
+
+
+module Fd: sig
+
+  type t
+  (** The type for file descriptors. *)
+
+  val pp: t Fmt.t
+  (** [pp_fd] pretty prints a file descriptor. *)
+
+  val fd: t -> Lwt_unix.file_descr
+  (** [fd t] is [t]'s underlying unix file descriptor. *)
+
+  val to_int: t -> int
+(** [to_int fd] is [fd]'s number. *)
+
+  val redirect_to_dev_null: t -> unit Lwt.t
+  (** [redirect_to_dev_null fd] redirects [fd] [/dev/null]. *)
+
+  val close: t -> unit Lwt.t
+  (** [close fd] closes [fd]. *)
+
+  val dup2: src:t -> dst:t -> unit Lwt.t
+  (** [dup2 ~src ~dst] calls [Unix.dup2] on [src] and [dst]. *)
+
+  val proxy_net: net:Lwt_rawlink.t -> t -> unit Lwt.t
+  (** [proxy_net ~net fd] proxies the traffic between the raw net link
+      [net] and [fd]. *)
+
+  val forward: src:t -> dst:t -> unit Lwt.t
+  (** [forward ~src ~dst] forwards the flow from [src] to [dst]. *)
+
+  (** {1 Usefull File Descriptors} *)
+
+  val stdin: t
+  (** [stdin] is the standart input. *)
+
+  val stdout: t
+  (** [stdout] is the standard output. *)
+
+  val stderr: t
+  (** [stderr] is the standard error. *)
+
+end
+
+module Pipe: sig
+
+  type t
+  (** The type for pipes. Could be either uni-directional (normal
+      pipes) or a bi-directional (socket pairs). *)
+
+  val priv: t -> Fd.t
+  (** [priv p] is the private side of the pipe [p]. *)
+
+  val calf: t -> Fd.t
+  (** [calf p] is the calf side of the pipe [p]. *)
+
+  (** {1 Useful Pipes} *)
+
+  val stdout: t
+  (** [stdout] is the uni-directional pipe from the calf's stdout . *)
+
+  val stderr: t
+  (** [stderr] is the uni-directional pipe from the calf's stderr. *)
+
+  val metrics: t
+  (** [metrics] is the uni-directional pipe fomr the calf's metric
+      endpoint. *)
+
+  val ctl: t
+  (** [ctl] is the bi-directional pipe used to exchange control
+      data between the calf and the priv containers. *)
+
+  val net: t
+  (** [net] is the bi-directional pipe used to exchange network
+      traffic between the calf and the priv containers. *)
+
+end
+
+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:
+  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
+    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
+    handler thread which will react to control data to perform
+    privileged system actions. *)

projects/miragesdk/dhcp-client/src/jbuild

@@ -0,0 +1,10 @@
+(jbuild_version 1)
+
+(executables
+ ((names (main))
+  (libraries (logs-syslog.lwt threads cohttp.lwt cstruct.lwt
+              cmdliner fmt.cli logs.fmt logs.cli fmt.tty decompress
+              irmin irmin-git irmin-http lwt.unix rawlink tuntap bpf_dhcp
+              irmin-watcher inotify))
+  (flags (-cclib -static))
+ ))

projects/miragesdk/dhcp-client/src/main.ml

@@ -5,335 +5,55 @@ module Log = (val Logs.src_log src : Logs.LOG)
 
 let failf fmt = Fmt.kstrf Lwt.fail_with fmt
 
-type fd = {
-  name: string;
-  fd  : Lwt_unix.file_descr;
-}
 
-let stdout = { name = "stdout"; fd = Lwt_unix.stdout }
+module Handlers = struct
-let stderr = { name = "stderr"; fd = Lwt_unix.stderr }
-let stdin  = { name = "stdin" ; fd = Lwt_unix.stdin  }
 
-let int_of_fd (fd:Lwt_unix.file_descr) =
+  (* System handlers *)
-  (Obj.magic (Lwt_unix.unix_file_descr fd): int)
 
-let pp_fd ppf fd = Fmt.pf ppf "%s:%d" fd.name (int_of_fd fd.fd)
+  let contents_of_diff = function
+    | `Added (_, `Contents (v, _))
+    | `Updated (_, (_, `Contents (v, _))) -> Some v
+    | _ -> None
 
-let close fd =
+  let ip t =
-  Log.debug (fun l -> l "close %a" pp_fd fd);
+    Ctl.KV.watch_key t ["ip"] (fun diff ->
-  Lwt_unix.close fd.fd
+        match contents_of_diff diff with
+        | Some ip ->
+          Log.info (fun l -> l "SET IP to %s" ip);
+          Lwt.return ()
+        | _ ->
+          Lwt.return ()
+      )
 
-let dev_null =
+  let handlers = [
-  Lwt_unix.of_unix_file_descr ~blocking:false
+    ip;
-    (Unix.openfile "/dev/null" [Unix.O_RDWR] 0)
-
-let close_and_dup fd =
-  Log.debug (fun l -> l "close-and-dup %a" pp_fd fd);
-  Lwt_unix.close fd.fd >>= fun () ->
-  Lwt_unix.dup2 dev_null fd.fd;
-  Lwt_unix.close dev_null
-
-let dup2 ~src ~dst =
-  Log.debug (fun l -> l "dup2 %a => %a" pp_fd src pp_fd dst);
-  Lwt_unix.dup2 src.fd dst.fd;
-  close src
-
-let proxy_rawlink ~rawlink ~fd =
-  Log.debug (fun l -> l "proxy-netif tap0 <=> %a" pp_fd fd);
-  let rec listen_rawlink () =
-    Lwt_rawlink.read_packet rawlink >>= fun buf ->
-    Log.debug (fun l -> l "PROXY-NETIF: => %a" Cstruct.hexdump_pp buf);
-    Log.debug (fun l -> l "PROXY-NETIF: => %S" (Cstruct.to_string buf));
-    let rec write buf =
-      Lwt_cstruct.write fd.fd buf >>= function
-      | 0 -> Lwt.return_unit
-      | n -> write (Cstruct.shift buf n)
-    in
-    write buf >>= fun () ->
-    listen_rawlink ()
-  in
-  let listen_socket () =
-    let len = 16 * 1024 in
-    let buf = Cstruct.create len in
-    let rec loop () =
-      Lwt_cstruct.read fd.fd buf >>= fun len ->
-      let buf = Cstruct.sub buf 0 len in
-      Log.debug (fun l -> l "PROXY-NETIF: <= %a" Cstruct.hexdump_pp buf);
-      Lwt_rawlink.send_packet rawlink buf >>= fun () ->
-      loop ()
-    in
-    loop ()
-  in
-  Lwt.pick [
-    listen_rawlink ();
-    listen_socket ();
   ]
 
-let rec really_write dst buf off len =
+  let watch path =
-  match len with
+    Ctl.v path >>= fun db ->
-  | 0   -> Lwt.return_unit
+    Lwt_list.map_p (fun f -> f db) handlers >>= fun _ ->
-  | len ->
+    let t, _ = Lwt.task () in
-    Lwt_unix.write dst.fd buf off len >>= fun n ->
+    t
-    really_write dst buf (off+n) (len-n)
-
-let forward ~src ~dst =
-  Log.debug (fun l -> l "forward %a => %a" pp_fd src pp_fd dst);
-  let len = 16 * 1024 in
-  let buf = Bytes.create len in
-  let rec loop () =
-    Lwt_unix.read src.fd buf 0 len >>= fun len ->
-    if len = 0 then
-      (* FIXME: why this ever happen *)
-      Fmt.kstrf Lwt.fail_with "FORWARD[%a => %a]: EOF" pp_fd src pp_fd dst
-    else (
-      Log.debug (fun l ->
-          l "FORWARD[%a => %a]: %S (%d)"
-            pp_fd src pp_fd dst (Bytes.sub buf 0 len) len);
-      really_write dst buf 0 len >>= fun () ->
-      loop ()
-    )
-  in
-  loop ()
-
-let proxy x y =
-  Lwt.pick [
-    forward ~src:x ~dst:y;
-    forward ~src:y ~dst:x;
-  ]
-
-(* Prepare the fd space before we fork to run the calf *)
-
-let socketpair name =
-  let priv, calf = Lwt_unix.(socketpair PF_UNIX SOCK_STREAM 0) in
-  Lwt_unix.clear_close_on_exec priv;
-  Lwt_unix.clear_close_on_exec calf;
-  { name = name; fd = priv }, { name = name ^ "-calf"; fd = calf }
-
-let pipe name =
-  let priv, calf = Lwt_unix.pipe () in
-  Lwt_unix.clear_close_on_exec priv;
-  Lwt_unix.clear_close_on_exec calf;
-  { name = name; fd = priv }, { name = name ^ "-calf"; fd = calf }
-
-(* logs pipe *)
-let logs_out = pipe "logs-out"
-let logs_err = pipe "logs-err"
-
-(* store pipe *)
-let store = socketpair "store"
-
-(* network pipe *)
-let net = socketpair "net"
-
-(* metrics pipe *)
-(* let metrics = make "metrics" *)
-
-let child cmd =
-  close_and_dup stdin  >>= fun () ->
-
-  (* close parent fds *)
-  close (fst logs_out) >>= fun () ->
-  close (fst logs_err) >>= fun () ->
-  close (fst store)    >>= fun () ->
-  close (fst net)      >>= fun () ->
-  (*
-    close (fst metrics) >>= fun () ->
-  *)
-
-  let cmds = String.concat " " cmd in
-  Log.info (fun l -> l "Executing %s" cmds);
-  Log.debug (fun l ->
-      l "net-fd=%a store-fd=%a" pp_fd (snd net) pp_fd (snd store));
-
-  dup2 ~src:(snd logs_out) ~dst:stdout >>= fun () ->
-  dup2 ~src:(snd logs_err) ~dst:stderr >>= fun () ->
-
-  (* exec the calf *)
-  Unix.execve (List.hd cmd) (Array.of_list cmd) [||]
-
-module Store = struct
-
-  (* FIXME: to avoid linking with gmp *)
-  module IO = struct
-    type ic = unit
-    type oc = unit
-    type ctx = unit
-    let with_connection ?ctx:_ _uri ?init:_ _f = Lwt.fail_with "not allowed"
-    let read_all _ic = Lwt.fail_with "not allowed"
-    let read_exactly _ic _n = Lwt.fail_with "not allowed"
-    let write _oc _buf = Lwt.fail_with "not allowed"
-    let flush _oc = Lwt.fail_with "not allowed"
-    let ctx () = Lwt.return_none
-  end
-
-  (* FIXME: we don't use Irmin_unix.Git.FS.KV to avoid linking with gmp *)
-  module Store = Irmin_git.FS.KV(IO)(Inflator)(Io_fs)
-  module KV = Store(Irmin.Contents.String)
-
-  let client () =
-    let config = Irmin_git.config "/data/git" in
-    KV.Repo.v config >>= fun repo ->
-    KV.of_branch repo "calf"
-
-  module HTTP = struct
-
-    module Wm = struct
-      module Rd = Webmachine.Rd
-      include Webmachine.Make(Cohttp_lwt_unix.Server.IO)
-    end
-
-    let with_key rd f =
-      match KV.Key.of_string rd.Wm.Rd.dispatch_path with
-      | Ok x    -> f x
-      | Error _ -> Wm.respond 404 rd
-
-    let infof fmt =
-      Fmt.kstrf (fun msg () ->
-          let date = Int64.of_float (Unix.gettimeofday ()) in
-          Irmin.Info.v ~date ~author:"calf" msg
-        ) fmt
-
-    let ok = "{\"status\": \"ok\"}"
-
-    class item db = object(self)
-
-      inherit [Cohttp_lwt_body.t] Wm.resource
-
-      method private of_string rd =
-        Cohttp_lwt_body.to_string rd.Wm.Rd.req_body >>= fun value ->
-        with_key rd (fun key ->
-            let info = infof "Updating %a" KV.Key.pp key in
-            KV.set db ~info key value >>= fun () ->
-            let resp_body = `String ok in
-            let rd = { rd with Wm.Rd.resp_body } in
-            Wm.continue true rd
-          )
-
-      method private to_string rd =
-        with_key rd (fun key ->
-            KV.find db key >>= function
-            | Some value -> Wm.continue (`String value) rd
-            | None       -> assert false
-          )
-
-      method resource_exists rd =
-        with_key rd (fun key ->
-            KV.mem db key >>= fun mem ->
-            Wm.continue mem rd
-          )
-
-      method allowed_methods rd =
-        Wm.continue [`GET; `HEAD; `PUT; `DELETE] rd
-
-      method content_types_provided rd =
-        Wm.continue [
-          "plain", self#to_string
-        ] rd
-
-      method content_types_accepted rd =
-        Wm.continue [
-          "plain", self#of_string
-        ] rd
-
-      method delete_resource rd =
-        with_key rd (fun key ->
-            let info = infof "Deleting %a" KV.Key.pp key in
-            KV.remove db ~info key >>= fun () ->
-            let resp_body = `String ok in
-            Wm.continue true { rd with Wm.Rd.resp_body }
-          )
-    end
-
-    let v db =
-      let routes = [
-        ("/ip"          , fun () -> new item db);
-        ("/domain"      , fun () -> new item db);
-        ("/search"      , fun () -> new item db);
-        ("/mtu"         , fun () -> new item db);
-        ("/nameserver/*", fun () -> new item db);
-      ] in
-      let callback (_ch, _conn) request body =
-        let open Cohttp in
-        (Wm.dispatch' routes ~body ~request >|= function
-          | None        -> (`Not_found, Header.init (), `String "Not found", [])
-          | Some result -> result)
-        >>= fun (status, headers, body, path) ->
-        Log.info (fun l ->
-            l "%d - %s %s"
-              (Code.code_of_status status)
-              (Code.string_of_method (Request.meth request))
-              (Uri.path (Request.uri request)));
-        Log.debug (fun l -> l "path=%a" Fmt.(Dump.list string) path);
-        (* Finally, send the response to the client *)
-        Cohttp_lwt_unix.Server.respond ~headers ~body ~status ()
-      in
-      (* create the server and handle requests with the function defined above *)
-      let conn_closed (_, conn) =
-        Log.info (fun l ->
-            l "connection %s closed\n%!" (Cohttp.Connection.to_string conn))
-      in
-      Cohttp_lwt_unix.Server.make ~callback ~conn_closed ()
 
 end
 
-  let start () =
+external bpf_filter: unit -> string = "bpf_filter"
-    client () >>= fun db ->
-    let http = HTTP.v db in
-    let fd = fst store in
-    Log.info (fun l -> l "serving KV store on %a" pp_fd fd);
-    Cohttp_lwt_unix.Server.create ~mode:(`Fd fd.fd) http
 
-end
+let run () cmd ethif path =
-
-let rawlink () =
-  (* FIXME: enable DHCP filtering via eBPF *)
-  Lwt_rawlink.open_link (* ~filter:(Rawlink.dhcp_filter ())*) "eth0"
-
-let check_exit_status cmd status =
-  let cmds = String.concat " " cmd in
-  match status with
-  | Unix.WEXITED 0   -> Lwt.return_unit
-  | Unix.WEXITED i   -> failf "%s: exit %d" cmds i
-  | Unix.WSIGNALED i -> failf "%s: signal %d" cmds i
-  | Unix.WSTOPPED i  -> failf "%s: stopped %d" cmds i
-
-let parent cmd pid =
-  (* network traffic *)
-  let rawlink = rawlink () in
-
-  (* close child fds *)
-  close_and_dup stdin  >>= fun () ->
-  close (snd logs_out) >>= fun () ->
-  close (snd logs_err) >>= fun () ->
-  close (snd net)      >>= fun () ->
-  close (snd store)    >>= fun () ->
-  (*
-  close (snd metrics) >>= fun () ->
-  *)
-  let wait () =
-    Lwt_unix.waitpid [] pid >>= fun (_pid, w) ->
-    Lwt_io.flush_all () >>= fun () ->
-
-    check_exit_status cmd w
-  in
-  Lwt.pick [
-    wait ();
-    (* data *)
-    proxy_rawlink ~rawlink ~fd:(fst net);
-
-    (* redirect the calf stdout to the shim stdout *)
-    forward ~src:(fst logs_out) ~dst:stdout;
-    forward ~src:(fst logs_err) ~dst:stderr;
-    (* metrics: TODO *)
-    (* store: TODO *)
-  ]
-
-let run () cmd =
   Lwt_main.run (
-    Lwt_io.flush_all () >>= fun () ->
+    let net = Init.rawlink ~filter:(bpf_filter ()) ethif in
-    match Lwt_unix.fork () with
+    let routes = [
-    | 0   -> child cmd
+      "/ip";
-    | pid -> parent cmd pid
+      "/domain";
+      "/search";
+      "/mtu";
+      "/nameservers/*"
+    ] in
+    Ctl.v "/data" >>= fun ctl ->
+    let fd = Init.(Fd.fd @@ Pipe.(priv ctl)) in
+    let ctl () = Ctl.serve ~routes ctl fd in
+    let handlers () = Handlers.watch path in
+    Init.run ~net ~ctl ~handlers cmd
   )
 
 (* CLI *)
@@ -352,6 +72,9 @@ let setup_log style_renderer level =
 let setup_log =
   Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
 
+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 cmd =
   (* FIXME: use runc isolation
    let default_cmd = [
@@ -361,32 +84,23 @@ let cmd =
   ] in
   *)
   let default_cmd = [
-    "/dhcp-client-calf"; "--store=10"; "--net=12"
+    "/dhcp-client-calf"; "--ctl="^ctl; "--net="^net
   ] in
   let doc =
     Arg.info ~docv:"CMD" ~doc:"Command to run the calf process." ["cmd"]
   in
   Arg.(value & opt (list ~sep:' ' string) default_cmd & doc)
 
+let ethif =
+  let doc =
+    Arg.info ~docv:"NAME" ~doc:"The interface to listen too." ["ethif"]
+  in
+  Arg.(value & opt string "eth0" & doc)
+
 let run =
-  Term.(const run $ setup_log $ cmd),
+  Term.(const run $ setup_log $ cmd $ ethif),
   Term.info "dhcp-client" ~version:"0.0"
 
 let () = match Term.eval run with
   | `Error _ -> exit 1
   | _        -> exit 0
-
-(*
-
-let kv_store = Unix.pipe ()
-
-let install_logger () =
-  Logs_syslog_lwt.udp_reporter (Unix.inet_addr_of_string "127.0.0.1") ()
-  >|= fun r ->
-  Logs.set_reporter r
-
-let () = Lwt_main.run (
-    install_logger () >>= fun () ->
-    fd_of_tap0 >>= fun fd ->
-  )
-*)

projects/miragesdk/examples/mirage-dhcp.yml

@@ -1,7 +1,7 @@
 kernel:
   image: "mobylinux/kernel:4.9.x"
   cmdline: "console=ttyS0 page_poison=1"
-init: "mobylinux/init:d6d115d601e78f7909d4a2ff7eb4caa3fff65271"
+init: "mobylinux/init:67913d76e75bebd78b4b2cc3843178c290405547"
 system:
   - name: sysctl
     image: "mobylinux/sysctl:2cf2f9d5b4d314ba1bfc22b2fe931924af666d8c"
@@ -19,10 +19,13 @@ system:
     command: [/usr/bin/binfmt, -dir, /etc/binfmt.d/, -mount, /binfmt_misc]
   - name: dhcp-client
     network_mode: host
-    image: "mobylinux/dhcp-client:dc3fd177a588ca9a850cfc75dd9083fb26d278dc"
+    image: "mobylinux/dhcp-client:f6ef2cc4c3bf7dcad643f22fbd3d355af1725105"
     capabilities:
-     - CAP_NET_RAW
+     - CAP_NET_ADMIN # to bring eth0 up
-    command: [/dhcp-client]
+     - CAP_NET_RAW   # to read /dev/eth0
+    binds:
+     - /var/run/dhcp-client:/data
+    command: [/dhcp-client, -vv]
     read_only: true
 daemon:
   - name: rngd
@@ -32,18 +35,9 @@ daemon:
     oom_score_adj: -800
     read_only: true
     command: [/bin/tini, /usr/sbin/rngd, -f]
-  - name: nginx
-    image: "nginx:alpine"
-    capabilities:
-     - CAP_NET_BIND_SERVICE
-     - CAP_CHOWN
-     - CAP_SETUID
-     - CAP_SETGID
-     - CAP_DAC_OVERRIDE
-    network_mode: host
 files:
-  - path: etc/docker/daemon.json
+  - path: /var/run/dhcp-client/README
-    contents: '{"debug": true}'
+    contents: 'data for dhcp-client'
 outputs:
   - format: kernel+initrd
   - format: iso-bios

projects/miragesdk/init/.gitignore

@@ -0,0 +1,2 @@
+sbin/
+usr/

projects/miragesdk/init/Dockerfile

@@ -0,0 +1,10 @@
+FROM alpine:3.5
+
+RUN \
+  apk --no-cache update && \
+  apk --no-cache upgrade -a && \
+  apk --no-cache add \
+    strace \
+  && rm -rf /var/cache/apk/*
+
+COPY . ./

projects/miragesdk/init/Makefile

@@ -0,0 +1,52 @@
+CONTAINERD_IMAGE=mobylinux/containerd:a688df6aee1e3700eb8d54dbc81070361df397a2@sha256:59ee3da05fe4dad4fbecff582c86fc30ce75e19a225eeeb07e203c9cc36fe34f
+CONTAINERD_BINARIES=usr/bin/containerd usr/bin/containerd-shim usr/bin/ctr usr/bin/dist
+
+RUNC_IMAGE=mobylinux/runc:94c54debf9a3ebb6d31311bdddb881ea07486dcd@sha256:13cabc1017c6448498e74bae9892ebc9dbad9e5d68f7df6b3855a15522e3a86b
+RUNC_BINARY=usr/bin/runc
+
+C_COMPILE=mobylinux/c-compile:81a6bd8ff45d769b60a2ee1acdaccda11ab835c8@sha256:eac250997a3b9784d3285a03c0c8311d4ca6fb63dc75164c987411ba93006487
+START_STOP_DAEMON=sbin/start-stop-daemon
+
+default: push
+
+$(RUNC_BINARY):
+	mkdir -p $(dir $@)
+	docker run --rm --net=none $(RUNC_IMAGE) tar cf - $@ | tar xf -
+
+$(CONTAINERD_BINARIES):
+	mkdir -p $(dir $@)
+	docker run --rm --net=none $(CONTAINERD_IMAGE) tar cf - $@ | tar xf -
+
+$(START_STOP_DAEMON): start-stop-daemon.c
+	mkdir -p $(dir $@)
+	tar cf - $^ | docker run --rm --net=none --log-driver=none -i $(C_COMPILE) -o $@ | tar xf -
+
+.PHONY: tag push
+
+BASE=alpine:3.5
+IMAGE=init
+
+ETC=$(shell find etc -type f)
+
+hash: Dockerfile $(ETC) init $(RUNC_BINARY) $(CONTAINERD_BINARIES) $(START_STOP_DAEMON)
+	DOCKER_CONTENT_TRUST=1 docker pull $(BASE)
+	tar cf - $^ | docker build --no-cache -t $(IMAGE):build -
+	docker run --rm $(IMAGE):build sh -c 'cat $^ /lib/apk/db/installed | sha1sum' | sed 's/ .*//' > $@
+
+push: hash
+	docker pull mobylinux/$(IMAGE):$(shell cat hash) || \
+		(docker tag $(IMAGE):build mobylinux/$(IMAGE):$(shell cat hash) && \
+		 docker push mobylinux/$(IMAGE):$(shell cat hash))
+	docker rmi $(IMAGE):build
+	rm -f hash
+
+tag: hash
+	docker pull mobylinux/$(IMAGE):$(shell cat hash) || \
+		docker tag $(IMAGE):build mobylinux/$(IMAGE):$(shell cat hash)
+	docker rmi $(IMAGE):build
+	rm -f hash
+
+clean:
+	rm -rf hash sbin usr
+
+.DELETE_ON_ERROR:

projects/miragesdk/init/etc/init.d/containerd

@@ -0,0 +1,9 @@
+#!/bin/sh
+
+# bring up containerd
+ulimit -n 1048576
+ulimit -p unlimited
+
+printf "\nStarting containerd\n"
+mkdir -p /var/log
+/sbin/start-stop-daemon --start --exec /usr/bin/containerd

projects/miragesdk/init/etc/init.d/containers

@@ -0,0 +1,31 @@
+#!/bin/sh
+
+# TODO more robust
+# while [ ! -S /run/containerd/containerd.sock ]; do sleep 1; done
+# while ! ctr list 2> /dev/null; do sleep 1; done
+
+# start system containers
+# temporarily using runc not containerd
+
+if [ -d /containers/system ]
+then
+	for f in $(find /containers/system -mindepth 1 -maxdepth 1 | sort)
+	do
+		base="$(basename $f)"
+		/usr/bin/runc run --bundle "$f" "$(basename $f)"
+		printf " - $base\n"
+	done
+fi
+
+if [ -d /containers/daemon ]
+then
+	for f in $(find /containers/daemon -mindepth 1 -maxdepth 1 | sort)
+	do
+		base="$(basename $f)"
+		log="/var/log/$base.log"
+		/sbin/start-stop-daemon --start --pidfile /run/$base.pid --exec /usr/bin/runc -- run --bundle "$f" --pid-file /run/$base.pid "$(basename $f)" </dev/null 2>$log >$log &
+		printf " - $base\n"
+	done
+fi
+
+wait

projects/miragesdk/init/etc/init.d/rcS

@@ -0,0 +1,103 @@
+#!/bin/sh
+
+# mount filesystems
+mkdir -p -m 0755 /proc /run /tmp /sys /dev
+
+mount -n -t proc proc /proc -o ndodev,nosuid,noexec,relatime
+
+mount -n -t tmpfs tmpfs /run -o nodev,nosuid,noexec,relatime,size=10%,mode=755
+mount -n -t tmpfs tmpfs /tmp -o nodev,nosuid,noexec,relatime,size=10%,mode=1777
+
+# mount devfs
+mount -n -t devtmpfs dev /dev -o nosuid,noexec,relatime,size=10m,nr_inodes=248418,mode=755
+# devices
+[ -c /dev/console ] || mknod -m 600 /dev/console c 5 1
+[ -c /dev/tty1 ] || mknod -m 620 /dev/tty1 c 4 1
+[ -c /dev/tty ] || mknod -m 666 /dev/tty c 5 0
+
+[ -c /dev/null ] || mknod -m 666 /dev/null c 1 3
+[ -c /dev/kmsg ] || mknod -m 660 /dev/kmsg c 1 11
+
+# extra symbolic links not provided by default
+[ -e /dev/fd ] || ln -snf /proc/self/fd /dev/fd
+[ -e /dev/stdin ] || ln -snf /proc/self/fd/0 /dev/stdin
+[ -e /dev/stdout ] || ln -snf /proc/self/fd/1 /dev/stdout
+[ -e /dev/stderr ] || ln -snf /proc/self/fd/2 /dev/stderr
+[ -e /proc/kcore ] && ln -snf /proc/kcore /dev/core
+
+# devfs filesystems
+mkdir -p -m 1777 /dev/mqueue
+mkdir -p -m 1777 /dev/shm
+mkdir -p -m 0755 /dev/pts
+mount -n -t mqueue -o noexec,nosuid,nodev mqueue /dev/mqueue
+mount -n -t tmpfs -o noexec,nosuid,nodev,mode=1777 shm /dev/shm
+mount -n -t devpts -o noexec,nosuid,gid=5,mode=0620 devpts /dev/pts
+
+# mount sysfs
+sysfs_opts=nodev,noexec,nosuid
+mount -n -t sysfs -o ${sysfs_opts} sysfs /sys
+[ -d /sys/kernel/security ] && mount -n -t securityfs -o ${sysfs_opts} securityfs /sys/kernel/security
+[ -d /sys/kernel/debug ] && mount -n -t debugfs -o ${sysfs_opts} debugfs /sys/kernel/debug
+[ -d /sys/kernel/config ] && mount -n -t configfs -o ${sysfs_opts} configfs /sys/kernel/config
+[ -d /sys/fs/fuse/connections ] && mount -n -t fusectl -o ${sysfs_opts} fusectl /sys/fs/fuse/connections
+[ -d /sys/fs/selinux ] && mount -n -t selinuxfs -o nosuid,noexec selinuxfs /sys/fs/selinux
+[ -d /sys/fs/pstore ] && mount -n -t pstore pstore -o ${sysfs_opts} /sys/fs/pstore
+[ -d /sys/firmware/efi/efivars ] && mount -n -t efivarfs -o ro,${sysfs_opts} efivarfs /sys/firmware/efi/efivars
+
+# misc /proc mounted fs
+[ -d /proc/sys/fs/binfmt_misc ] && mount -t binfmt_misc -o nodev,noexec,nosuid binfmt_misc /proc/sys/fs/binfmt_misc
+
+# mount cgroups
+mount -n -t tmpfs -o nodev,noexec,nosuid,mode=755,size=10m cgroup_root /sys/fs/cgroup
+
+while read name hier groups enabled rest
+do
+	case "${enabled}" in
+	1)	mkdir -p /sys/fs/cgroup/${name}
+		mount -n -t cgroup -o ${sysfs_opts},${name} ${name} /sys/fs/cgroup/${name}
+	;;
+	esac
+done < /proc/cgroups
+
+# for compatibility
+mkdir -p /sys/fs/cgroup/systemd
+mount -t cgroup -o none,name=systemd cgroup /sys/fs/cgroup/systemd
+
+# set SELinux contexts
+if [ -x /sbin/restorecon ]
+then
+	restorecon -F /sys/devices/system/cpu/online >/dev/null 2>&1
+	restorecon -rF /sys/fs/cgroup >/dev/null 2>&1
+	restorecon -rF /dev >/dev/null 2>&1
+fi
+
+# start mdev for hotplug
+echo "/sbin/mdev" > /proc/sys/kernel/hotplug
+
+# mdev -s will not create /dev/usb[1-9] devices with recent kernels
+# so we trigger hotplug events for usb for now
+for i in $(find /sys/devices -name 'usb[0-9]*'); do
+	[ -e $i/uevent ] && echo add > $i/uevent
+done
+
+mdev -s
+
+# set hostname
+if [ -s /etc/hostname ]
+then
+	hostname -F /etc/hostname
+fi
+
+if [ $(hostname) = "moby" -a -f /sys/class/net/eth0/address ]
+then
+	mac=$(cat /sys/class/net/eth0/address)
+	hostname moby-$(echo $mac | sed 's/://g')
+fi
+
+# set system clock from hwclock
+hwclock --hctosys --utc
+
+# bring up loopback interface
+ip addr add 127.0.0.1/8 dev lo brd + scope host
+ip route add 127.0.0.0/8 dev lo scope host
+ip link set lo up

projects/miragesdk/init/etc/inittab

@@ -0,0 +1,15 @@
+# /etc/inittab
+
+::sysinit:/etc/init.d/rcS
+::once:/etc/init.d/containerd
+::once:/etc/init.d/containers
+
+# Stuff to do for the 3-finger salute
+::ctrlaltdel:/sbin/reboot
+
+# Stuff to do before rebooting
+::shutdown:/usr/sbin/killall5 -15
+::shutdown:/bin/sleep 5
+::shutdown:/usr/sbin/killall5 -9
+::shutdown:/bin/echo "Unmounting filesystems"
+::shutdown:/bin/umount -a -r

projects/miragesdk/init/etc/issue

@@ -0,0 +1,12 @@
+
+Welcome to Moby
+
+                        ##         .
+                  ## ## ##        ==
+               ## ## ## ## ##    ===
+           /"""""""""""""""""\___/ ===
+      ~~~ {~~ ~~~~ ~~~ ~~~~ ~~~ ~ /  ===- ~~~
+           \______ o           __/
+             \    \         __/
+              \____\_______/
+

projects/miragesdk/init/init

@@ -0,0 +1,44 @@
+#!/bin/sh
+
+setup_console() {
+	tty=${1%,*}
+	speed=${1#*,}
+	inittab="$2"
+	securetty="$3"
+	line=
+	term="linux"
+	[ "$speed" = "$1" ] && speed=115200
+
+	case "$tty" in
+	ttyS*|ttyAMA*|ttyUSB*|ttyMFD*)
+		line="-L"
+		term="vt100"
+		;;
+	tty0)
+		# skip current console
+		return 0
+		;;
+	esac
+	# skip consoles already in inittab
+	grep -q "^$tty:" "$inittab" && return
+
+	echo "$tty::once:cat /etc/issue" >> "$inittab"
+	echo "$tty::respawn:/sbin/getty -n -l /bin/sh $line $speed $tty $term" >> "$inittab"
+	if ! grep -q -w "$tty" "$securetty"; then
+		echo "$tty" >> "$securetty"
+	fi
+}
+
+/bin/mount -t tmpfs tmpfs /mnt
+
+/bin/cp -a / /mnt 2>/dev/null
+
+/bin/mount -t proc -o noexec,nosuid,nodev proc /proc
+for opt in $(cat /proc/cmdline); do
+	case "$opt" in
+	console=*)
+		setup_console ${opt#console=} /mnt/etc/inittab /mnt/etc/securetty;;
+	esac
+done
+
+exec /bin/busybox switch_root /mnt /sbin/init

projects/miragesdk/roadmap.md

@@ -125,7 +125,7 @@ and is able to get a DHCP lease on boot.
 ##### TODO
 
 - use runc to isolate the calf
-- eBPF filtering
+- system handler (see https://github.com/kobolabs/dhcpcd/tree/kobo/dhcpcd-hooks)
 - use seccomp to isolate the privileged container
 - use the DHCP results to actually update the system
 - add metrics aggregation (using prometheus)