deterministic mac addresses!

src/vmm_core.ml

@@ -116,6 +116,14 @@ module Name = struct
 
   let pp ppf ids =
     Fmt.(pf ppf "[vm: %a]" (list ~sep:(unit ".") string) ids)
+
+  let mac name bridge =
+    (* deterministic mac address computation: VEB Kombinat Robotron prefix
+       vielen dank, liebe genossen! *)
+    let prefix = "\x00\x80\x41"
+    and ours = Digest.string (to_string (bridge :: name))
+    in
+    Macaddr.of_octets_exn (prefix ^ String.take ~min:3 ~max:3 ours)
 end
 
 module Policy = struct

src/vmm_core.mli

@@ -38,6 +38,14 @@ module Name : sig
   val domain : t -> t
   val pp : t Fmt.t
   val block_name : t -> string -> t
+
+  val mac : t -> string -> Macaddr.t
+(** [mac t bridge] outputs deterministically a mac address for [t] on [bridge].
+    The resulting mac address is computed as follows: as prefix, the (no longer
+    active) 00:80:41 (VEB Kombinat Robotron) is used, the remaining three bytes
+    are the first three bytes of the MD5 digest of [bridge ^ "." ^ to_string t].
+
+    i.e., [mac ["foo";"bar"] "default" = 00:80:41:1b:11:78] *)
 end
 
 module Policy : sig

src/vmm_unix.ml

@@ -172,7 +172,13 @@ let cpuset cpu =
   | x -> Error (`Msg ("unsupported operating system " ^ x))
 
 let exec name config bridge_taps blocks =
-  let net = List.map (fun (bridge, tap) -> "--net:" ^ bridge ^ "=" ^ tap) bridge_taps
+  let net, macs =
+    List.split
+      (List.map (fun (bridge, tap) ->
+           let mac = Name.mac name bridge in
+           "--net:" ^ bridge ^ "=" ^ tap,
+           "--net-mac:" ^ bridge ^ "=" ^ Macaddr.to_string mac)
+          bridge_taps)
   and blocks = List.map (fun (name, dev) -> "--disk:" ^ name ^ "=" ^ Fpath.to_string (block_file dev)) blocks
   and argv = match config.Unikernel.argv with None -> [] | Some xs -> xs
   and mem = "--mem=" ^ string_of_int config.Unikernel.memory
@@ -180,7 +186,7 @@ let exec name config bridge_taps blocks =
   cpuset config.Unikernel.cpuid >>= fun cpuset ->
   let cmd =
     Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt") % mem %%
-             of_list net %% of_list blocks %
+             of_list net %% of_list macs %% of_list blocks %
              "--" % p (Name.image_file name) %% of_list argv)
   in
   let line = Bos.Cmd.to_list cmd in