miragesdk: use a custom BPF filter to allow the calf to get a DHCP lease

Plus a few more minor improvements:

- compile with jbuilder.
- start working on the control path.

Signed-off-by: Thomas Gazagnaire <thomas@gazagnaire.org>

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=src/main.ml src/inflator.ml src/io_fs.ml 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/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/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

@@ -39,7 +39,7 @@ let dup2 ~src ~dst =
   close src
 
 let proxy_rawlink ~rawlink ~fd =
-  Log.debug (fun l -> l "proxy-netif tap0 <=> %a" pp_fd fd);
+  Log.debug (fun l -> l "proxy-netif eth0 <=> %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);
@@ -171,10 +171,13 @@ module Store = struct
   module KV = Store(Irmin.Contents.String)
 
   let client () =
-    let config = Irmin_git.config "/data/git" in
+    let config = Irmin_git.config "/data" 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
@@ -265,7 +268,7 @@ module Store = struct
               (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 ()
+        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) =
@@ -273,21 +276,56 @@ module Store = struct
             l "connection %s closed\n%!" (Cohttp.Connection.to_string conn))
       in
       Cohttp_lwt_unix.Server.make ~callback ~conn_closed ()
-
     end
 
-  let start () =
+  let serve () =
     client () >>= fun db ->
     let http = HTTP.v db in
     let fd = fst store in
+    let on_exn e = Log.err (fun l -> l "XXX %a" Fmt.exn e) in
     Log.info (fun l -> l "serving KV store on %a" pp_fd fd);
-    Cohttp_lwt_unix.Server.create ~mode:(`Fd fd.fd) http
+    Cohttp_lwt_unix.Server.create ~on_exn ~mode:(`Fd fd.fd) http
 
 end
 
-let rawlink () =
+module Handlers = struct
-  (* FIXME: enable DHCP filtering via eBPF *)
+
-  Lwt_rawlink.open_link (* ~filter:(Rawlink.dhcp_filter ())*) "eth0"
+  (* System handlers *)
+
+  let contents_of_diff = function
+    | `Added (_, `Contents (v, _))
+    | `Updated (_, (_, `Contents (v, _))) -> Some v
+    | _ -> None
+
+  let ip t =
+    Store.KV.watch_key t ["ip"] (fun diff ->
+        match contents_of_diff diff with
+        | Some ip ->
+          Log.info (fun l -> l "SET IP to %s" ip);
+          Lwt.return ()
+        | _ ->
+          Lwt.return ()
+      )
+
+  let handlers = [
+    ip;
+  ]
+
+  let install () =
+    Store.client () >>= fun db ->
+    Lwt_list.map_p (fun f -> f db) handlers >>= fun _ ->
+    let t, _ = Lwt.task () in
+    t
+
+end
+
+external bpf_filter: unit -> string = "bpf_filter"
+
+let rawlink ethif =
+  Log.debug (fun l -> l "bringing up %s" ethif);
+  (try Tuntap.set_up_and_running ethif
+   with e -> Log.err (fun l -> l "rawling: %a" Fmt.exn e));
+  Lwt_rawlink.open_link ~filter:(bpf_filter ()) ethif
 
 let check_exit_status cmd status =
   let cmds = String.concat " " cmd in
@@ -297,9 +335,9 @@ 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 parent cmd pid =
+let parent cmd pid ethif =
   (* network traffic *)
-  let rawlink = rawlink () in
+  let rawlink = rawlink ethif in
 
   (* close child fds *)
   close_and_dup stdin  >>= fun () ->
@@ -325,15 +363,17 @@ let parent cmd pid =
     forward ~src:(fst logs_out) ~dst:stdout;
     forward ~src:(fst logs_err) ~dst:stderr;
     (* metrics: TODO *)
-    (* store: TODO *)
+
+    Store.serve ();
+    Handlers.install ();
   ]
 
-let run () cmd =
+let run () cmd ethif =
   Lwt_main.run (
     Lwt_io.flush_all () >>= fun () ->
     match Lwt_unix.fork () with
     | 0   -> child cmd
-    | pid -> parent cmd pid
+    | pid -> parent cmd pid ethif
   )
 
 (* CLI *)
@@ -368,8 +408,14 @@ let 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

projects/miragesdk/examples/mirage-dhcp.yml

@@ -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:d910ad5712a86cf2848753eecd1b7d07d80ad095"
     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/roadmap.md

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