deterministic mac addresses!

This commit is contained in:
Hannes Mehnert 2019-10-12 00:20:58 +02:00
parent 0808c20583
commit c9820f3106
3 changed files with 24 additions and 2 deletions

View file

@ -116,6 +116,14 @@ module Name = struct
let pp ppf ids = let pp ppf ids =
Fmt.(pf ppf "[vm: %a]" (list ~sep:(unit ".") string) 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 end
module Policy = struct module Policy = struct

View file

@ -38,6 +38,14 @@ module Name : sig
val domain : t -> t val domain : t -> t
val pp : t Fmt.t val pp : t Fmt.t
val block_name : t -> string -> 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 end
module Policy : sig module Policy : sig

View file

@ -172,7 +172,13 @@ let cpuset cpu =
| x -> Error (`Msg ("unsupported operating system " ^ x)) | x -> Error (`Msg ("unsupported operating system " ^ x))
let exec name config bridge_taps blocks = 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 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 argv = match config.Unikernel.argv with None -> [] | Some xs -> xs
and mem = "--mem=" ^ string_of_int config.Unikernel.memory 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 -> cpuset config.Unikernel.cpuid >>= fun cpuset ->
let cmd = let cmd =
Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt") % mem %% 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) "--" % p (Name.image_file name) %% of_list argv)
in in
let line = Bos.Cmd.to_list cmd in let line = Bos.Cmd.to_list cmd in