Merge pull request #1543 from samoht/mac

miragesdk: do not generate a random mac
This commit is contained in:
Thomas Gazagnaire 2017-04-12 14:29:19 +02:00 committed by GitHub
commit 2cc09805c9
15 changed files with 182 additions and 112 deletions

View File

@ -2,10 +2,13 @@ kernel:
image: "mobylinux/kernel:4.9.x"
cmdline: "console=ttyS0 page_poison=1"
init:
- "mobylinux/init:9d755f7e7d108d523448e4a503f1613b7d870389@sha256:9ccb16f2d8b3a09d12f5459106763f1836c064e420a13360e2e25599337960dc"
- mobylinux/init:286e9864b12beaff71b06809b6f0d832b6408eb5 # base init + strace + git
- mobylinux/runc:b0fb122e10dbb7e4e45115177a61a3f8d68c19a9
- mobylinux/containerd:18eaf72f3f4f9a9f29ca1951f66df701f873060b
- mobylinux/ca-certificates:eabc5a6e59f05aa91529d80e9a595b85b046f935
onboot:
- name: sysctl
image: "mobylinux/sysctl:2cf2f9d5b4d314ba1bfc22b2fe931924af666d8c"
image: mobylinux/sysctl:2cf2f9d5b4d314ba1bfc22b2fe931924af666d8c
net: host
pid: host
ipc: host
@ -13,19 +16,19 @@ onboot:
- CAP_SYS_ADMIN
readonly: true
- name: binfmt
image: "mobylinux/binfmt:bdb754f25a5d851b4f5f8d185a43dfcbb3c22d01"
image: mobylinux/binfmt:bdb754f25a5d851b4f5f8d185a43dfcbb3c22d01
binds:
- /proc/sys/fs/binfmt_misc:/binfmt_misc
readonly: true
services:
- name: rngd
image: "mobylinux/rngd:3dad6dd43270fa632ac031e99d1947f20b22eec9@sha256:1c93c1db7196f6f71f8e300bc1d15f0376dd18e8891c8789d77c8ff19f3a9a92"
image: mobylinux/rngd:3dad6dd43270fa632ac031e99d1947f20b22eec9
capabilities:
- CAP_SYS_ADMIN
oomScoreAdj: -800
readonly: true
- name: dhcp-client
image: "mobylinux/dhcp-client:9e7009ae469ddd4d37f9cffaad2cf612114a3fb0@sha256:4421e05a0082b56c4ef83ca652e1da1a5af3a24e5baec61e7ba5b981f3b94a09"
image: mobylinux/dhcp-client:882ad65d1ef89a9a307b019c61f5f69301f59214
net: host
capabilities:
- CAP_NET_ADMIN # to bring eth0 up

View File

@ -1,22 +1,8 @@
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:f225fb93dc3e6dda1cc9004962893015b29dc2d6@sha256:e75c4b274236bd3ad9f4db0a91a6f2174c8c77009c361ab5dd7a4169406675bc
RUNC_BINARY=usr/bin/runc
C_COMPILE=mobylinux/c-compile:81a6bd8ff45d769b60a2ee1acdaccda11ab835c8@sha256:eac250997a3b9784d3285a03c0c8311d4ca6fb63dc75164c987411ba93006487
START_STOP_DAEMON=sbin/start-stop-daemon
default: push
$(RUNC_BINARY): Makefile
mkdir -p $(dir $@)
docker run --rm --net=none $(RUNC_IMAGE) tar cf - $@ | tar xf -
$(CONTAINERD_BINARIES): Makefile
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 -
@ -28,7 +14,7 @@ IMAGE=init
ETC=$(shell find etc -type f)
hash: Dockerfile $(ETC) init $(RUNC_BINARY) $(CONTAINERD_BINARIES) $(START_STOP_DAEMON)
hash: Dockerfile $(ETC) init $(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/ .*//' > $@

View File

@ -1,12 +1,14 @@
FROM ocaml/opam:alpine-3.5_ocaml-4.04.0
RUN git -C /home/opam/opam-repository pull origin master && opam update -u
RUN cd /home/opam/opam-repository && git pull && opam update -u
RUN opam info mirage-net-fd
# to be able to use cstruct.ppx + jbuilder
RUN opam pin add cstruct 2.4.0 -n
# to bring eth0 up
RUN opam pin add tuntap 1.0.0 -n
RUN opam pin add mirage-net-fd --dev -n
RUN opam depext -iy mirage-net-unix logs-syslog irmin-unix cohttp decompress
RUN opam depext -iy rawlink tuntap.1.0.0 jbuilder irmin-watcher inotify
RUN opam install rresult
RUN opam pin add tuntap 1.0.0
RUN opam depext -iy rawlink tuntap jbuilder irmin-watcher inotify rresult
# TMP: to compile the calf
RUN opam pin add -n charrua-client https://github.com/yomimono/charrua-client.git#state-halfway
@ -22,6 +24,8 @@ RUN sudo chown opam -R /src
USER opam
WORKDIR /src
RUN opam list
RUN opam config exec -- jbuilder build dhcp-client/main.exe
RUN sudo cp /src/_build/default/dhcp-client/main.exe /dhcp-client

View File

@ -1,23 +1,26 @@
FROM mobylinux/mirage-compile:4e4686b60909d88a75f3f24c0429d0a8e415faa3
FROM ocaml/opam:alpine-3.5_ocaml-4.04.0
RUN cd /home/opam/opam-repository && git pull && opam update -u
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
# to be able to use cstruct.ppx + jbuilder
RUN opam pin add cstruct 2.4.0 -n
# to bring eth0 up
RUN opam pin add tuntap 1.0.0 -n
RUN opam pin add mirage-net-fd --dev -n
RUN opam depext -iy mirage-net-unix logs-syslog cohttp decompress
RUN opam depext -iy rawlink tuntap.1.0.0 jbuilder
RUN opam depext -iy mirage-net-unix logs-syslog irmin-unix cohttp decompress
RUN opam depext -iy rawlink tuntap jbuilder irmin-watcher inotify rresult
RUN opam pin add tuntap 1.0.0
# TMP: to compile the calf
RUN opam pin add -n charrua-client https://github.com/yomimono/charrua-client.git#state-halfway
RUN opam depext -uiy ocamlfind topkg-care ocamlbuild lwt mirage-types-lwt mirage
RUN opam depext -uiy charrua-client cohttp conduit mirage-unix
RUN opam depext -uiy mirage-net-fd ptime mirage-logs
RUN sudo mkdir -p /src /bin
COPY calf /src/calf
RUN sudo chown opam -R /src
RUN cd /src/calf && opam config exec -- mirage configure && make depend
COPY . /src
COPY init-dev.sh /home/opam/init-dev.sh
USER opam
WORKDIR /src
ENTRYPOINT ["/bin/sh", "/home/opam/init-dev.sh"]

View File

@ -178,15 +178,22 @@ module Dhcp_client = Dhcp_client_mirage.Make(Time)(Net)
let set_ip ctl k ip =
let str = Ipaddr.V4.to_string ip ^ "\n" in
Sdk.Ctl.Client.write ctl k str >>= function
| Ok () -> Lwt.return_unit
| Error (`Msg e) -> failf "error while writing %s: %s" k e
| Ok () -> Lwt.return_unit
| Error e -> failf "error while writing %s: %a" k Sdk.Ctl.Client.pp_error e
let set_ip_opt ctl k = function
| None -> Lwt.return_unit
| Some ip -> set_ip ctl k ip
let get_mac ctl =
Sdk.Ctl.Client.read ctl "/mac" >>= function
| Ok None -> Lwt.return None
| Ok Some s -> Lwt.return @@ Macaddr.of_string (String.trim s)
| Error e -> failf "get_mac: %a" Sdk.Ctl.Client.pp_error e
let start () dhcp_codes net ctl =
Netif_fd.connect net >>= fun net ->
get_mac ctl >>= fun mac ->
Netif_fd.connect ?mac net >>= fun net ->
let requests = match dhcp_codes with
| [] -> default_options
| l ->

View File

@ -5,15 +5,6 @@ open Astring
let src = Logs.Src.create "dhcp-client" ~doc:"DHCP client"
module Log = (val Logs.src_log src : Logs.LOG)
let failf fmt = Fmt.kstrf Lwt.fail_with fmt
let run fmt =
Fmt.kstrf (fun str ->
match Sys.command str with
| 0 -> Lwt.return ()
| i -> Fmt.kstrf Lwt.fail_with "%S exited with code %d" str i
) fmt
module Handlers = struct
(* System handlers *)
@ -23,27 +14,27 @@ module Handlers = struct
| `Updated (_, (_, `Contents (v, _))) -> Some v
| _ -> None
let with_ip str f =
match Ipaddr.V4.of_string (String.trim str) with
| Some ip ->
Log.info (fun l -> l "SET IP to %a" Ipaddr.V4.pp_hum ip);
f ip
| None ->
Log.err (fun l -> l "%s is not a valid IP" str);
Lwt.return_unit
let ip ~ethif t =
Ctl.KV.watch_key t ["ip"] (fun diff ->
match contents_of_diff diff with
| None -> Lwt.return_unit
| Some ip ->
let ip = String.trim ip in
Log.info (fun l -> l "SET IP to %s" ip);
(* FIXME: use language bindings to netlink instead *)
run "ifconfig %s %s netmask 255.255.255.0" ethif ip
(* run "ip addr add %s/24 dev %s" ip ethif *)
| Some ip -> with_ip ip (fun ip -> Net.set_ip ethif ip)
)
let gateway t =
Ctl.KV.watch_key t ["gateway"] (fun diff ->
match contents_of_diff diff with
| None -> Lwt.return_unit
| Some gw ->
let gw = String.trim gw in
Log.info (fun l -> l "SET GATEWAY to %s" gw);
(* FIXME: use language bindings to netlink instead *)
run "ip route add default via %s" gw
| Some gw -> with_ip gw (fun gw -> Net.set_gateway gw)
)
let handlers ~ethif = [
@ -52,7 +43,7 @@ module Handlers = struct
]
let watch ~ethif db =
Lwt_list.map_p (fun f -> f db) (handlers ethif) >>= fun _ ->
Lwt_list.map_p (fun f -> f db) (handlers ~ethif) >>= fun _ ->
let t, _ = Lwt.task () in
t
@ -80,24 +71,30 @@ let read_cmd file =
else
failwith ("Cannot read " ^ file)
let run () cmd ethif path =
let infof fmt =
Fmt.kstrf (fun msg () ->
let date = Int64.of_float (Unix.gettimeofday ()) in
Irmin.Info.v ~date ~author:"priv" msg
) fmt
let run () cmd ethif path =
let cmd = match cmd with
| None -> default_cmd
| Some f -> read_cmd f
in
Lwt_main.run (
let routes = [
"/ip";
"/gateway";
"/domain";
"/search";
"/mtu";
"/nameservers/*"
"/ip" , [`Write];
"/mac" , [`Read ];
"/gateway", [`Write];
] in
Ctl.v path >>= fun db ->
let ctl fd = Ctl.Server.listen ~routes db fd in
let handlers () = Handlers.watch ~ethif db in
let net = Init.rawlink ~filter:(dhcp_filter ()) ethif in
Net.mac ethif >>= fun mac ->
let mac = Macaddr.to_string mac ^ "\n" in
Ctl.KV.set db ~info:(infof "Add mac") ["mac"] mac >>= fun () ->
Init.run t ~net ~ctl ~handlers cmd
)

View File

@ -35,7 +35,7 @@ let pp ppf (Flow (name, _, _)) = Fmt.string ppf name
type t = flow
let forward ~src ~dst =
let forward ?(verbose=false) ~src ~dst =
let rec loop () =
read src >>= function
| Ok `Eof ->
@ -45,8 +45,12 @@ let forward ~src ~dst =
Log.err (fun l -> l "forward[%a => %a] %a" pp src pp dst pp_error e);
Lwt.return_unit
| Ok (`Data buf) ->
Log.debug (fun l -> l "forward[%a => %a] %a"
pp src pp dst Cstruct.hexdump_pp buf);
Log.debug (fun l ->
let payload =
if verbose then Fmt.strf "[%S]" @@ Cstruct.to_string buf
else Fmt.strf "%d bytes" (Cstruct.len buf)
in
l "forward[%a => %a] %s" pp src pp dst payload);
write dst buf >>= function
| Ok () -> loop ()
| Error e ->
@ -56,8 +60,8 @@ let forward ~src ~dst =
in
loop ()
let proxy f1 f2 =
let proxy ?verbose f1 f2 =
Lwt.join [
forward ~src:f1 ~dst:f2;
forward ~src:f2 ~dst:f1;
forward ?verbose ~src:f1 ~dst:f2;
forward ?verbose ~src:f2 ~dst:f1;
]

View File

@ -12,10 +12,14 @@ val create: (module Mirage_flow_lwt.S with type flow = 'a) -> 'a -> string -> fl
val pp: flow Fmt.t
(** [pp] is the pretty-printer for IO flows. *)
val forward: src:t -> dst:t -> unit Lwt.t
(** [forward ~src ~dst] forwards writes from [src] to [dst]. Block
until either [src] or [dst] is closed. *)
val forward: ?verbose:bool -> src:t -> dst:t -> unit Lwt.t
(** [forward ?verbose ~src ~dst] forwards writes from [src] to
[dst]. Block until either [src] or [dst] is closed. If [verbose]
is set (by default it is not), show the raw flow in debug mode,
otherwise just show the lenght. *)
val proxy: t -> t -> unit Lwt.t
(** [proxy x y] is the same as [forward x y <*> forward y x]. Block
until both flows are closed. *)
val proxy: ?verbose:bool -> t -> t -> unit Lwt.t
(** [proxy ?verbose x y] is the same as [forward x y <*> forward y
x]. Block until both flows are closed. If [verbose] is set (by
default it is not), show the raw flow in debug mode, otherwise
just show the lenght. *)

View File

@ -257,6 +257,9 @@ module Client = struct
let version = 0l
type error = [`Msg of string]
let pp_error ppf (`Msg s) = Fmt.string ppf s
module K = struct
type t = int32
let equal = Int32.equal
@ -327,6 +330,8 @@ end
module Server = struct
type op = [ `Read | `Write | `Delete ]
let ok q payload =
{ Reply.id = q.Query.id; status = Reply.Ok; payload }
@ -345,21 +350,29 @@ module Server = struct
Irmin.Info.v ~date ~author:"calf" msg
) fmt
let dispatch db q =
let not_allowed q =
let path = q.Query.path in
let err = Fmt.strf "%s is not an allowed path" path in
Log.err (fun l -> l "%ld: %s" q.Query.id path);
error q err
let dispatch db op q =
with_key q (fun key ->
let can x = List.mem x op in
match q.Query.operation with
| Write ->
| Write when can `Write ->
let info = infof "Updating %a" KV.Key.pp key in
KV.set db ~info key q.payload >|= fun () ->
ok q ""
| Delete ->
| Delete when can `Delete ->
let info = infof "Removing %a" KV.Key.pp key in
KV.remove db ~info key >|= fun () ->
ok q ""
| Read ->
KV.find db key >|= function
| Read when can `Read ->
(KV.find db key >|= function
| None -> error q err_not_found
| Some v -> ok q v
| Some v -> ok q v)
| _ -> Lwt.return (not_allowed q)
)
let listen ~routes db fd =
@ -381,13 +394,12 @@ module Server = struct
Lwt_condition.wait cond >>= fun () ->
let q = Queue.pop queries in
let path = q.Query.path in
(if List.mem path routes then (
dispatch db q >>= fun r ->
(if List.mem_assoc path routes then (
let op = List.assoc path routes in
dispatch db op q >>= fun r ->
Reply.write fd r
) else (
let err = Fmt.strf "%s is not an allowed path" path in
Log.err (fun l -> l "%ld: %s" q.Query.id path);
Reply.write fd (error q err)
Reply.write fd (not_allowed q)
)) >>= fun () ->
process ()
in

View File

@ -92,21 +92,27 @@ module Client: sig
type t
(** The type for client state. *)
type error
(** The type for client errors. *)
val pp_error: error Fmt.t
(** [pp_error] is the pretty-printer for client errors. *)
val v: IO.t -> t
(** [v fd] is the client state using [fd] to send requests to the
server. A client state also stores some state for all the
incomplete client queries. *)
val read: t -> string -> (string option, [`Msg of string]) result Lwt.t
val read: t -> string -> (string option, error) result Lwt.t
(** [read t k] is the value associated with the key [k] in the
control plane state. Return [None] if no value is associated to
[k]. *)
val write: t -> string -> string -> (unit, [`Msg of string]) result Lwt.t
val write: t -> string -> string -> (unit, error) result Lwt.t
(** [write t p v] associates [v] to the key [k] in the control plane
state. *)
val delete: t -> string -> (unit, [`Msg of string]) result Lwt.t
val delete: t -> string -> (unit, error) result Lwt.t
(** [delete t k] remove [k]'s binding in the control plane state. *)
end
@ -120,7 +126,10 @@ val v: string -> KV.t Lwt.t
module Server: sig
val listen: routes:string list -> KV.t -> IO.t -> unit Lwt.t
type op = [ `Read | `Write | `Delete ]
(** The type for operations to perform on routes. *)
val listen: routes:(string * op list) list -> KV.t -> IO.t -> unit Lwt.t
(** [listen ~routes kv fd] is the thread exposing the KV store [kv],
holding control plane state, running inside the privileged
container. [routes] are the routes exposed by the server to the

View File

@ -291,11 +291,11 @@ let exec_and_forward ?(handlers=block_for_ever) ~pid ~cmd ~net ~ctl t =
Lwt.pick ([
wait ();
(* data *)
IO.proxy net priv_net;
IO.proxy ~verbose:true net priv_net;
(* redirect the calf stdout to the shim stdout *)
IO.forward ~src:priv_stdout ~dst:Fd.(flow stdout);
IO.forward ~src:priv_stderr ~dst:Fd.(flow stderr);
IO.forward ~verbose:false ~src:priv_stdout ~dst:Fd.(flow stdout);
IO.forward ~verbose:false ~src:priv_stderr ~dst:Fd.(flow stderr);
(* TODO: Init.Fd.forward ~src:Init.Pipe.(priv metrics)
~dst:Init.Fd.metric; *)
ctl priv_ctl;

View File

@ -5,6 +5,6 @@
(libraries (threads cstruct.lwt cmdliner fmt.cli logs.fmt logs.cli fmt.tty
decompress irmin irmin-git lwt.unix rawlink tuntap dispatch
irmin-watcher inotify astring rresult mirage-flow-lwt
mirage-channel-lwt io-page.unix))
mirage-channel-lwt io-page.unix ipaddr))
(preprocess (per_file ((pps (cstruct.ppx)) (ctl))))
))

View File

@ -0,0 +1,28 @@
(* This file is a big hack and should be replaced ASAP with proper bindings *)
open Lwt.Infix
let run fmt =
Fmt.kstrf (fun str ->
match Sys.command str with
| 0 -> Lwt.return ()
| i -> Fmt.kstrf Lwt.fail_with "%S exited with code %d" str i
) fmt
let read fmt =
Fmt.kstrf (fun str ->
Lwt_process.pread ("/bin/sh", [|"/bin/sh"; "-c"; str|])
) fmt
let mac ethif =
read "ifconfig -a %s | grep -o -E '([[:xdigit:]]{1,2}:){5}[[:xdigit:]]{1,2}'"
ethif >|= fun mac ->
Macaddr.of_string_exn (String.trim mac)
let set_ip ethif ip =
(* FIXME: use language bindings to netlink instead *)
(* run "ip addr add %s/24 dev %s" ip ethif *)
run "ifconfig %s %a netmask 255.255.255.0" ethif Ipaddr.V4.pp_hum ip
let set_gateway gw =
run "ip route add default via %a" Ipaddr.V4.pp_hum gw

View File

@ -0,0 +1,10 @@
(** [Net] exposes low-level system functions related to network. *)
val mac: string -> Macaddr.t Lwt.t
(** [mac e] is the MAC address of the interface [e]. *)
val set_ip: string -> Ipaddr.V4.t -> unit Lwt.t
(** [set_ip e ip] sets [e]'s IP address to [ip]. *)
val set_gateway: Ipaddr.V4.t -> unit Lwt.t
(** [set_gateway ip] set the default host gateway to [ip]. *)

View File

@ -154,23 +154,25 @@ let failf fmt = Fmt.kstrf Alcotest.fail fmt
(* read ops *)
let pp_error = Ctl.Client.pp_error
let read_should_err t k =
Ctl.Client.read t k >|= function
| Error (`Msg _) -> ()
| Ok None -> failf "read(%s) -> got: none, expected: err" k
| Ok Some v -> failf "read(%s) -> got: found:%S, expected: err" k v
| Error _ -> ()
| Ok None -> failf "read(%s) -> got: none, expected: err" k
| Ok Some v -> failf "read(%s) -> got: found:%S, expected: err" k v
let read_should_none t k =
Ctl.Client.read t k >|= function
| Error (`Msg e) -> failf "read(%s) -> got: error:%s, expected none" k e
| Ok None -> ()
| Ok Some v -> failf "read(%s) -> got: found:%S, expected none" k v
| Error e -> failf "read(%s) -> got: error:%a, expected none" k pp_error e
| Ok None -> ()
| Ok Some v -> failf "read(%s) -> got: found:%S, expected none" k v
let read_should_work t k v =
Ctl.Client.read t k >|= function
| Error (`Msg e) -> failf "read(%s) -> got: error:%s, expected ok" k e
| Ok None -> failf "read(%s) -> got: none, expected ok" k
| Ok Some v' ->
| Error e -> failf "read(%s) -> got: error:%a, expected ok" k pp_error e
| Ok None -> failf "read(%s) -> got: none, expected ok" k
| Ok Some v' ->
if v <> v' then failf "read(%s) -> got: ok:%S, expected: ok:%S" k v' v
(* write ops *)
@ -182,8 +184,8 @@ let write_should_err t k v =
let write_should_work t k v =
Ctl.Client.write t k v >|= function
| Ok () -> ()
| Error (`Msg e) -> failf "write(%s) -> error: %s" k e
| Ok () -> ()
| Error e -> failf "write(%s) -> error: %a" k pp_error e
(* del ops *)
@ -194,8 +196,8 @@ let delete_should_err t k =
let delete_should_work t k =
Ctl.Client.delete t k >|= function
| Ok () -> ()
| Error (`Msg e) -> failf "write(%s) -> error: %s" k e
| Ok () -> ()
| Error e -> failf "write(%s) -> error: %a" k pp_error e
let test_ctl t () =
let calf = calf Init.Pipe.(ctl t) in
@ -204,7 +206,8 @@ let test_ctl t () =
let k2 = "a" in
let k3 = "b/c" in
let k4 = "xxxxxx" in
let routes = [k1; k2; k3] in
let all = [`Read; `Write; `Delete] in
let routes = [k1,all; k2,all; k3,all ] in
let git_root = "/tmp/sdk/ctl" in
let _ = Sys.command (Fmt.strf "rm -rf %s" git_root) in
Ctl.v git_root >>= fun ctl ->