Vmm_unix.check_commands : unit -> (unit, [> `Msg of string ]) result - which

checks (platform-dependent) all required executables
Vmm_unix.prepare/exec execute solo5-{spt/hvt} depending on the image type
 (solo5-elftool figures that out), use jsonm to parse output
Vmm_unix: use ip on linux, no longer ifconfig
This commit is contained in:
Hannes Mehnert 2019-10-27 20:46:07 +01:00
parent 01f6983325
commit 82782363b8
6 changed files with 110 additions and 21 deletions

View file

@ -19,6 +19,7 @@ depends: [
"cmdliner" {>= "1.0.0"} "cmdliner" {>= "1.0.0"}
"fmt" "fmt"
"astring" "astring"
"jsonm"
"x509" {>= "0.8.0"} "x509" {>= "0.8.0"}
"tls" {>= "0.9.0"} "tls" {>= "0.9.0"}
"nocrypto" "nocrypto"

View file

@ -147,6 +147,8 @@ let m = conn_metrics "unix"
let jump _ influx = let jump _ influx =
Sys.(set_signal sigpipe Signal_ignore); Sys.(set_signal sigpipe Signal_ignore);
Rresult.R.error_msg_to_invalid_arg
(Vmm_unix.check_commands ());
match Vmm_vmmd.restore_unikernels () with match Vmm_vmmd.restore_unikernels () with
| Error (`Msg msg) -> Logs.err (fun m -> m "bailing out: %s" msg) | Error (`Msg msg) -> Logs.err (fun m -> m "bailing out: %s" msg)
| Ok old_unikernels -> | Ok old_unikernels ->

View file

@ -2,5 +2,5 @@
(name albatross) (name albatross)
(public_name albatross) (public_name albatross)
(wrapped false) (wrapped false)
(libraries rresult logs ipaddr bos hex ptime astring duration cstruct (libraries rresult logs ipaddr bos hex ptime astring duration cstruct jsonm
decompress lwt lwt.unix ptime.clock.os asn1-combinators metrics)) decompress lwt lwt.unix ptime.clock.os asn1-combinators metrics))

38
src/vmm_json.ml Normal file
View file

@ -0,0 +1,38 @@
(* this is copied from the example (in a comment) in jsonm *)
(*
type json =
[ `Null | `Bool of bool | `Float of float| `String of string
| `A of json list | `O of (string * json) list ]
*)
exception Escape of ((int * int) * (int * int)) * Jsonm.error
let find_string_value k = function
| `Null | `Bool _ | `Float _ | `String _ | `A _ ->
Rresult.R.error_msgf "couldn't find %s in json" k
| `O dict ->
match List.find_opt (fun (key, _) -> String.equal k key) dict with
| Some (_, `String value) -> Ok value
| _ -> Rresult.R.error_msgf "couldn't find %s in json dictionary" k
let json_of_string src =
let dec d = match Jsonm.decode d with
| `Lexeme l -> l
| `Error e -> raise (Escape (Jsonm.decoded_range d, e))
| `End | `Await -> assert false
in
let rec value v k d = match v with
| `Os -> obj [] k d | `As -> arr [] k d
| `Null | `Bool _ | `String _ | `Float _ as v -> k v d
| _ -> assert false
and arr vs k d = match dec d with
| `Ae -> k (`A (List.rev vs)) d
| v -> value v (fun v -> arr (v :: vs) k) d
and obj ms k d = match dec d with
| `Oe -> k (`O (List.rev ms)) d
| `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d
| _ -> assert false
in
let d = Jsonm.decoder (`String src) in
try Ok (value (dec d) (fun v _ -> v) d) with Escape (_, e) -> Error e

View file

@ -1,6 +1,47 @@
(* (c) 2017 Hannes Mehnert, all rights reserved *) (* (c) 2017 Hannes Mehnert, all rights reserved *)
open Rresult open Rresult
open Vmm_core
let dbdir = Fpath.(v "/var" / "db" / "albatross")
type supported = FreeBSD | Linux
let uname =
let cmd = Bos.Cmd.(v "uname" % "-s") in
lazy (match Bos.OS.Cmd.(run_out cmd |> out_string) with
| Ok (s, _) when s = "FreeBSD" -> FreeBSD
| Ok (s, _) when s = "Linux" -> Linux
| Ok (s, _) -> invalid_arg (Printf.sprintf "OS %s not supported" s)
| Error (`Msg m) -> invalid_arg m)
let check_solo5_cmd name =
match
Bos.OS.Cmd.must_exist (Bos.Cmd.v name),
Bos.OS.Cmd.must_exist Bos.Cmd.(v (p Fpath.(dbdir / name)))
with
| Ok cmd, _ | _, Ok cmd -> Ok cmd
| _ -> R.error_msgf "%s does not exist" name
(* here we check that the binaries we use in this file are actually present *)
let check_commands () =
let uname_cmd = Bos.Cmd.v "uname" in
Bos.OS.Cmd.must_exist uname_cmd >>= fun _ ->
let cmds =
match Lazy.force uname with
| Linux -> [ "ip" ; "brctl" ; "taskset" ]
| FreeBSD -> [ "ifconfig" ; "cpuset" ]
in
List.fold_left
(fun acc cmd -> acc >>= fun _ ->
Bos.OS.Cmd.must_exist (Bos.Cmd.v cmd))
(Ok uname_cmd) cmds >>= fun _ ->
check_solo5_cmd "solo5-elftool" >>| fun _ ->
()
(* we could check for solo5-hvt OR solo5-spt, but in practise we need
to handle either being absent and we get an image of that type anyways *)
(* bits copied over from Bos *) (* bits copied over from Bos *)
(*--------------------------------------------------------------------------- (*---------------------------------------------------------------------------
Copyright (c) 2014 Daniel C. Bünzli Copyright (c) 2014 Daniel C. Bünzli
@ -51,10 +92,6 @@ let close_no_err fd = try close fd with _ -> ()
(* own code starts here (* own code starts here
(c) 2017, 2018 Hannes Mehnert, all rights reserved *) (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
open Vmm_core
let dbdir = Fpath.(v "/var" / "db" / "albatross")
let dump, restore = let dump, restore =
let open R.Infix in let open R.Infix in
let state_file = Fpath.(dbdir / "state") in let state_file = Fpath.(dbdir / "state") in
@ -89,16 +126,6 @@ let rec fifo_exists file =
| Unix.Unix_error (e, _, _) -> | Unix.Unix_error (e, _, _) ->
R.error_msgf "file %a exists: %s" Fpath.pp file (Unix.error_message e) R.error_msgf "file %a exists: %s" Fpath.pp file (Unix.error_message e)
type supported = FreeBSD | Linux
let uname =
let cmd = Bos.Cmd.(v "uname" % "-s") in
lazy (match Bos.OS.Cmd.(run_out cmd |> out_string) with
| Ok (s, _) when s = "FreeBSD" -> FreeBSD
| Ok (s, _) when s = "Linux" -> Linux
| Ok (s, _) -> invalid_arg (Printf.sprintf "OS %s not supported" s)
| Error (`Msg m) -> invalid_arg m)
let create_tap bridge = let create_tap bridge =
match Lazy.force uname with match Lazy.force uname with
| FreeBSD -> | FreeBSD ->
@ -110,7 +137,7 @@ let create_tap bridge =
let prefix = "vmmtap" in let prefix = "vmmtap" in
let rec find_n x = let rec find_n x =
let nam = prefix ^ string_of_int x in let nam = prefix ^ string_of_int x in
match Bos.OS.Cmd.run Bos.Cmd.(v "ifconfig" % nam) with match Bos.OS.Cmd.run Bos.Cmd.(v "ip" % "link" % "show" % nam) with
| Error _ -> nam | Error _ -> nam
| Ok _ -> find_n (succ x) | Ok _ -> find_n (succ x)
in in
@ -127,6 +154,20 @@ let destroy_tap tap =
in in
Bos.OS.Cmd.run cmd Bos.OS.Cmd.run cmd
type solo5_target = Spt | Hvt
let solo5_image_target image =
check_solo5_cmd "solo5-elftool" >>= fun cmd ->
let cmd = Bos.Cmd.(cmd % "query-abi" % p image) in
Bos.OS.Cmd.(run_out cmd |> out_string) >>= fun (s, _) ->
R.error_to_msg ~pp_error:Jsonm.pp_error
(Vmm_json.json_of_string s) >>= fun data ->
Vmm_json.find_string_value "target" data >>= function
| "spt" -> Ok Spt | "hvt" -> Ok Hvt
| x -> R.error_msgf "unsupported solo5 target %s" x
let solo5_tender = function Spt -> "solo5-spt" | Hvt -> "solo5-hvt"
let prepare name vm = let prepare name vm =
(match vm.Unikernel.typ with (match vm.Unikernel.typ with
| `Solo5 -> | `Solo5 ->
@ -136,6 +177,10 @@ let prepare name vm =
| Error () -> Error (`Msg "failed to uncompress") | Error () -> Error (`Msg "failed to uncompress")
else else
Ok vm.Unikernel.image) >>= fun image -> Ok vm.Unikernel.image) >>= fun image ->
let filename = Name.image_file name in
Bos.OS.File.write filename (Cstruct.to_string image) >>= fun () ->
solo5_image_target filename >>= fun target ->
check_solo5_cmd (solo5_tender target) >>= fun _ ->
let fifo = Name.fifo_file name in let fifo = Name.fifo_file name in
begin match fifo_exists fifo with begin match fifo_exists fifo with
| Ok true -> Ok () | Ok true -> Ok ()
@ -143,15 +188,13 @@ let prepare name vm =
| Error _ -> | Error _ ->
try Ok (mkfifo fifo) with try Ok (mkfifo fifo) with
| Unix.Unix_error (e, f, _) -> | Unix.Unix_error (e, f, _) ->
Logs.err (fun m -> m "%a error in %s: %a" Fpath.pp fifo f pp_unix_err e); R.error_msgf "file %a error in %s: %a" Fpath.pp fifo f pp_unix_err e
Error (`Msg "while creating fifo")
end >>= fun () -> end >>= fun () ->
List.fold_left (fun acc b -> List.fold_left (fun acc b ->
acc >>= fun acc -> acc >>= fun acc ->
create_tap b >>= fun tap -> create_tap b >>= fun tap ->
Ok (tap :: acc)) Ok (tap :: acc))
(Ok []) vm.Unikernel.bridges >>= fun taps -> (Ok []) vm.Unikernel.bridges >>= fun taps ->
Bos.OS.File.write (Name.image_file name) (Cstruct.to_string image) >>= fun () ->
Ok (List.rev taps) Ok (List.rev taps)
let vm_device vm = let vm_device vm =
@ -184,8 +227,11 @@ let exec name config bridge_taps blocks =
and mem = "--mem=" ^ string_of_int config.Unikernel.memory and mem = "--mem=" ^ string_of_int config.Unikernel.memory
in in
cpuset config.Unikernel.cpuid >>= fun cpuset -> cpuset config.Unikernel.cpuid >>= fun cpuset ->
let filename = Name.image_file name in
solo5_image_target filename >>= fun target ->
check_solo5_cmd (solo5_tender target) >>= fun tender ->
let cmd = let cmd =
Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt") % mem %% Bos.Cmd.(of_list cpuset %% tender % mem %%
of_list net %% of_list macs %% 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

View file

@ -4,6 +4,8 @@ open Rresult
open Vmm_core open Vmm_core
val check_commands : unit -> (unit, [> R.msg ]) result
val prepare : Name.t -> Unikernel.config -> (string list, [> R.msg ]) result val prepare : Name.t -> Unikernel.config -> (string list, [> R.msg ]) result
val exec : Name.t -> Unikernel.config -> (string * string) list -> val exec : Name.t -> Unikernel.config -> (string * string) list ->