reynir/albatross
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

stats: pass bridge device through, vmm device name as well to allow arbitrary bhyve statistics, vmmc_local: add stats_add and stats_remove subcommands

Browse source
This commit is contained in:
Hannes Mehnert 2019-01-15 00:25:59 +01:00
parent c0189178e5
commit 58bd77bc5f
12 changed files with 167 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
app/vmm_cli.ml
View file

@ -62,6 +62,26 @@ let vm_c =
in in
(parse, Name.pp) (parse, Name.pp)
let bridge_tap_c =
let parse s = match Astring.String.cut ~sep:":" s with
| None -> `Error "broken, format is bridge:tap"
| Some (bridge, tap) -> `Ok (bridge, tap)
in
(parse, fun ppf (bridge, tap) -> Format.fprintf ppf "%s:%s" bridge tap)
let bridge_taps =
let doc = "Bridge and tap device names" in
Arg.(value & opt_all bridge_tap_c [] & info [ "bridge" ] ~doc)
let pid_req1 =
let doc = "Process id" in
Arg.(required & pos 1 (some int) None & info [] ~doc ~docv:"PID")
let vmm_dev_req0 =
let doc = "VMM device name" in
Arg.(required & pos 0 (some string) None & info [] ~doc ~docv:"VMMDEV")
let opt_vm_name = let opt_vm_name =
let doc = "name of virtual machine." in let doc = "name of virtual machine." in
Arg.(value & opt vm_c Name.root & info [ "n" ; "name"] ~doc) Arg.(value & opt vm_c Name.root & info [ "n" ; "name"] ~doc)

63
app/vmm_stats_pure.ml
View file

@ -22,12 +22,15 @@ let my_version = `AV3
let descr = ref [] let descr = ref []
type 'a t = { type 'a t = {
pid_nic : ((vmctx, int) result * (int * string) list) IM.t ; pid_nic : ((vmctx, int) result * string * (string * int * string) list) IM.t ;
vmid_pid : int Vmm_trie.t ; vmid_pid : int Vmm_trie.t ;
name_sockets : 'a Vmm_trie.t ; name_sockets : 'a Vmm_trie.t ;
} }
let pp_strings pp taps = Fmt.(list ~sep:(unit ",@ ") string) pp taps let pp_strings pp strs = Fmt.(list ~sep:(unit ",@ ") string) pp strs
let pp_nics pp nets =
Fmt.(list ~sep:(unit ",@ ") (pair ~sep:(unit ": ") string string)) pp nets
let empty () = let empty () =
{ pid_nic = IM.empty ; vmid_pid = Vmm_trie.empty ; name_sockets = Vmm_trie.empty } { pid_nic = IM.empty ; vmid_pid = Vmm_trie.empty ; name_sockets = Vmm_trie.empty }
@ -56,30 +59,29 @@ let fill_descr ctx =
end end
| ds -> Logs.debug (fun m -> m "%d descr are already present" (List.length ds)) | ds -> Logs.debug (fun m -> m "%d descr are already present" (List.length ds))
let open_vmmapi ?(retries = 4) pid = let open_vmmapi ?(retries = 4) name =
let name = "solo5-" ^ string_of_int pid in
if retries = 0 then begin if retries = 0 then begin
Logs.debug (fun m -> m "(ignored 0) vmmapi_open failed for %d" pid) ; Logs.debug (fun m -> m "(ignored 0) vmmapi_open failed for %s" name) ;
Error 0 Error 0
end else end else
match wrap vmmapi_open name with match wrap vmmapi_open name with
| None -> | None ->
let left = max 0 (pred retries) in let left = max 0 (pred retries) in
Logs.warn (fun m -> m "(ignored, %d attempts left) vmmapi_open failed for %d" left pid) ; Logs.warn (fun m -> m "(ignored, %d attempts left) vmmapi_open failed for %s" left name) ;
Error left Error left
| Some vmctx -> | Some vmctx ->
Logs.info (fun m -> m "vmmapi_open succeeded for %d" pid) ; Logs.info (fun m -> m "vmmapi_open succeeded for %s" name) ;
fill_descr vmctx ; fill_descr vmctx ;
Ok vmctx Ok vmctx
let try_open_vmmapi pid_nic = let try_open_vmmapi pid_nic =
IM.fold (fun pid (vmctx, nics) fresh -> IM.fold (fun pid (vmctx, vmmdev, nics) fresh ->
let vmctx = let vmctx =
match vmctx with match vmctx with
| Ok vmctx -> Ok vmctx | Ok vmctx -> Ok vmctx
| Error retries -> open_vmmapi ~retries pid | Error retries -> open_vmmapi ~retries vmmdev
in in
IM.add pid (vmctx, nics) fresh) IM.add pid (vmctx, vmmdev, nics) fresh)
pid_nic IM.empty pid_nic IM.empty
let gather pid vmctx nics = let gather pid vmctx nics =
@ -88,12 +90,12 @@ let gather pid vmctx nics =
(match vmctx with (match vmctx with
| Error _ -> None | Error _ -> None
| Ok vmctx -> wrap vmmapi_stats vmctx), | Ok vmctx -> wrap vmmapi_stats vmctx),
List.fold_left (fun ifd (nic, nname) -> List.fold_left (fun ifd (bridge, nic, nname) ->
match wrap sysctl_ifdata nic with match wrap sysctl_ifdata nic with
| None -> | None ->
Logs.warn (fun m -> m "failed to get ifdata for %s" nname) ; Logs.warn (fun m -> m "failed to get ifdata for %s" nname) ;
ifd ifd
| Some data -> data::ifd) | Some data -> { data with bridge }::ifd)
[] nics [] nics
let tick t = let tick t =
@ -106,7 +108,7 @@ let tick t =
| [] -> Logs.info (fun m -> m "nobody is listening") ; out | [] -> Logs.info (fun m -> m "nobody is listening") ; out
| xs -> match IM.find_opt pid t.pid_nic with | xs -> match IM.find_opt pid t.pid_nic with
| None -> Logs.warn (fun m -> m "couldn't find nics of %d" pid) ; out | None -> Logs.warn (fun m -> m "couldn't find nics of %d" pid) ; out
| Some (vmctx, nics) -> | Some (vmctx, _, nics) ->
let ru, mem, vmm, ifd = gather pid vmctx nics in let ru, mem, vmm, ifd = gather pid vmctx nics in
match ru with match ru with
| None -> Logs.err (fun m -> m "failed to get rusage for %d" pid) ; out | None -> Logs.err (fun m -> m "failed to get rusage for %d" pid) ; out
@ -126,26 +128,28 @@ let tick t =
in in
(t', outs) (t', outs)
let add_pid t vmid pid nics = let add_pid t vmid vmmdev pid nics =
match wrap sysctl_ifcount () with match wrap sysctl_ifcount () with
| None -> | None ->
Logs.err (fun m -> m "sysctl ifcount failed for %d %a" pid pp_strings nics) ; Logs.err (fun m -> m "sysctl ifcount failed for %d %a" pid pp_nics nics) ;
Error (`Msg "sysctl ifcount failed") Error (`Msg "sysctl ifcount failed")
| Some max_nic -> | Some max_nic ->
let rec go cnt acc id = let rec go cnt acc id =
if id > 0 && cnt > 0 then if id > 0 && cnt > 0 then
match wrap sysctl_ifdata id with match wrap sysctl_ifdata id with
| Some ifd when List.mem ifd.Vmm_core.Stats.ifname nics -> | None -> go cnt acc (pred id)
go (pred cnt) ((id, ifd.Vmm_core.Stats.ifname) :: acc) (pred id) | Some ifd ->
| _ -> go cnt acc (pred id) match List.find_opt (fun (_, tap) -> String.equal tap ifd.Stats.ifname) nics with
| Some (bridge, tap) -> go (pred cnt) ((bridge, id, tap) :: acc) (pred id)
| None -> go cnt acc (pred id)
else else
List.rev acc List.rev acc
in in
Ok (go (List.length nics) [] max_nic) >>= fun nic_ids -> Ok (go (List.length nics) [] max_nic) >>= fun nic_ids ->
let vmctx = open_vmmapi pid in let vmctx = open_vmmapi vmmdev in
Logs.info (fun m -> m "adding %d %a with vmctx %b" pid pp_strings nics Logs.info (fun m -> m "adding %d %a with vmctx %b" pid pp_nics nics
(match vmctx with Error _ -> false | Ok _ -> true)) ; (match vmctx with Error _ -> false | Ok _ -> true)) ;
let pid_nic = IM.add pid (vmctx, nic_ids) t.pid_nic let pid_nic = IM.add pid (vmctx, vmmdev, nic_ids) t.pid_nic
and vmid_pid, ret = Vmm_trie.insert vmid pid t.vmid_pid and vmid_pid, ret = Vmm_trie.insert vmid pid t.vmid_pid
in in
assert (ret = None) ; assert (ret = None) ;
@ -159,8 +163,8 @@ let remove_vmid t vmid =
Logs.info (fun m -> m "removing pid %d" pid) ; Logs.info (fun m -> m "removing pid %d" pid) ;
(try (try
match IM.find pid t.pid_nic with match IM.find pid t.pid_nic with
| Ok vmctx, _ -> ignore (wrap vmmapi_close vmctx) | Ok vmctx, _, _ -> ignore (wrap vmmapi_close vmctx)
| Error _, _ -> () | Error _, _, _ -> ()
with with
_ -> ()) ; _ -> ()) ;
let pid_nic = IM.remove pid t.pid_nic let pid_nic = IM.remove pid t.pid_nic
@ -168,9 +172,6 @@ let remove_vmid t vmid =
in in
{ t with pid_nic ; vmid_pid } { t with pid_nic ; vmid_pid }
let remove_vmids t vmids =
List.fold_left remove_vmid t vmids
let handle t socket (header, wire) = let handle t socket (header, wire) =
if not (Vmm_commands.version_eq my_version header.Vmm_commands.version) then begin if not (Vmm_commands.version_eq my_version header.Vmm_commands.version) then begin
Logs.err (fun m -> m "invalid version %a (mine is %a)" Logs.err (fun m -> m "invalid version %a (mine is %a)"
@ -183,15 +184,15 @@ let handle t socket (header, wire) =
begin begin
let id = header.Vmm_commands.name in let id = header.Vmm_commands.name in
match cmd with match cmd with
| `Stats_add (pid, taps) -> | `Stats_add (vmmdev, pid, taps) ->
add_pid t id pid taps >>= fun t -> add_pid t id vmmdev pid taps >>= fun t ->
Ok (t, `Add id, "added") Ok (t, None, "added")
| `Stats_remove -> | `Stats_remove ->
let t = remove_vmid t id in let t = remove_vmid t id in
Ok (t, `Remove id, "removed") Ok (t, None, "removed")
| `Stats_subscribe -> | `Stats_subscribe ->
let name_sockets, close = Vmm_trie.insert id socket t.name_sockets in let name_sockets, close = Vmm_trie.insert id socket t.name_sockets in
Ok ({ t with name_sockets }, `Close close, "subscribed") Ok ({ t with name_sockets }, close, "subscribed")
end end
| _ -> | _ ->
Logs.err (fun m -> m "unexpected wire %a" Vmm_commands.pp_wire (header, wire)) ; Logs.err (fun m -> m "unexpected wire %a" Vmm_commands.pp_wire (header, wire)) ;

37
app/vmm_stats_stubs.c
View file

@ -198,25 +198,26 @@ CAMLprim value vmmanage_sysctl_ifdata (value num) {
if (sysctl(name, nitems(name), &data, &datalen, NULL, 0) != 0) if (sysctl(name, nitems(name), &data, &datalen, NULL, 0) != 0)
uerror("sysctl", Nothing); uerror("sysctl", Nothing);
res = caml_alloc(18, 0); res = caml_alloc(19, 0);
Store_field(res, 0, caml_copy_string(data.ifmd_name)); Store_field(res, 0, caml_copy_string(data.ifmd_name));
Store_field(res, 1, Val32(data.ifmd_flags)); Store_field(res, 1, caml_copy_string(data.ifmd_name));
Store_field(res, 2, Val32(data.ifmd_snd_len)); Store_field(res, 2, Val32(data.ifmd_flags));
Store_field(res, 3, Val32(data.ifmd_snd_maxlen)); Store_field(res, 3, Val32(data.ifmd_snd_len));
Store_field(res, 4, Val32(data.ifmd_snd_drops)); Store_field(res, 4, Val32(data.ifmd_snd_maxlen));
Store_field(res, 5, Val32(data.ifmd_data.ifi_mtu)); Store_field(res, 5, Val32(data.ifmd_snd_drops));
Store_field(res, 6, Val64(data.ifmd_data.ifi_baudrate)); Store_field(res, 6, Val32(data.ifmd_data.ifi_mtu));
Store_field(res, 7, Val64(data.ifmd_data.ifi_ipackets)); Store_field(res, 7, Val64(data.ifmd_data.ifi_baudrate));
Store_field(res, 8, Val64(data.ifmd_data.ifi_ierrors)); Store_field(res, 8, Val64(data.ifmd_data.ifi_ipackets));
Store_field(res, 9, Val64(data.ifmd_data.ifi_opackets)); Store_field(res, 9, Val64(data.ifmd_data.ifi_ierrors));
Store_field(res, 10, Val64(data.ifmd_data.ifi_oerrors)); Store_field(res, 10, Val64(data.ifmd_data.ifi_opackets));
Store_field(res, 11, Val64(data.ifmd_data.ifi_collisions)); Store_field(res, 11, Val64(data.ifmd_data.ifi_oerrors));
Store_field(res, 12, Val64(data.ifmd_data.ifi_ibytes)); Store_field(res, 12, Val64(data.ifmd_data.ifi_collisions));
Store_field(res, 13, Val64(data.ifmd_data.ifi_obytes)); Store_field(res, 13, Val64(data.ifmd_data.ifi_ibytes));
Store_field(res, 14, Val64(data.ifmd_data.ifi_imcasts)); Store_field(res, 14, Val64(data.ifmd_data.ifi_obytes));
Store_field(res, 15, Val64(data.ifmd_data.ifi_omcasts)); Store_field(res, 15, Val64(data.ifmd_data.ifi_imcasts));
Store_field(res, 16, Val64(data.ifmd_data.ifi_iqdrops)); Store_field(res, 16, Val64(data.ifmd_data.ifi_omcasts));
Store_field(res, 17, Val64(data.ifmd_data.ifi_oqdrops)); Store_field(res, 17, Val64(data.ifmd_data.ifi_iqdrops));
Store_field(res, 18, Val64(data.ifmd_data.ifi_oqdrops));
CAMLreturn(res); CAMLreturn(res);
} }

33
app/vmmc_local.ml
View file

@ -67,7 +67,13 @@ let create _ opt_socket force name image cpuid memory argv block network compres
let console _ opt_socket name since = let console _ opt_socket name since =
jump opt_socket name (`Console_cmd (`Console_subscribe since)) jump opt_socket name (`Console_cmd (`Console_subscribe since))
let stats _ opt_socket name = let stats_add _ opt_socket name vmmdev pid bridge_taps =
jump opt_socket name (`Stats_cmd (`Stats_add (vmmdev, pid, bridge_taps)))
let stats_remove _ opt_socket name =
jump opt_socket name (`Stats_cmd `Stats_remove)
let stats_subscribe _ opt_socket name =
jump opt_socket name (`Stats_cmd `Stats_subscribe) jump opt_socket name (`Stats_cmd `Stats_subscribe)
let event_log _ opt_socket name since = let event_log _ opt_socket name since =
@ -157,15 +163,33 @@ let console_cmd =
Term.(ret (const console $ setup_log $ socket $ vm_name $ since)), Term.(ret (const console $ setup_log $ socket $ vm_name $ since)),
Term.info "console" ~doc ~man Term.info "console" ~doc ~man
let stats_cmd = let stats_subscribe_cmd =
let doc = "statistics of VMs" in let doc = "statistics of VMs" in
let man = let man =
[`S "DESCRIPTION"; [`S "DESCRIPTION";
`P "Shows statistics of VMs."] `P "Shows statistics of VMs."]
in in
Term.(ret (const stats $ setup_log $ socket $ opt_vm_name)), Term.(ret (const stats_subscribe $ setup_log $ socket $ opt_vm_name)),
Term.info "stats" ~doc ~man Term.info "stats" ~doc ~man
let stats_remove_cmd =
let doc = "remove statistics of VM" in
let man =
[`S "DESCRIPTION";
`P "Removes statistics of VM."]
in
Term.(ret (const stats_remove $ setup_log $ socket $ opt_vm_name)),
Term.info "stats_remove" ~doc ~man
let stats_add_cmd =
let doc = "Add VM to statistics gathering" in
let man =
[`S "DESCRIPTION";
`P "Add VM to statistics gathering."]
in
Term.(ret (const stats_add $ setup_log $ socket $ opt_vm_name $ vmm_dev_req0 $ pid_req1 $ bridge_taps)),
Term.info "stats_add" ~doc ~man
let log_cmd = let log_cmd =
let doc = "Event log" in let doc = "Event log" in
let man = let man =
@ -228,7 +252,8 @@ let cmds = [ help_cmd ; info_cmd ;
policy_cmd ; remove_policy_cmd ; add_policy_cmd ; policy_cmd ; remove_policy_cmd ; add_policy_cmd ;
destroy_cmd ; create_cmd ; destroy_cmd ; create_cmd ;
block_info_cmd ; block_create_cmd ; block_destroy_cmd ; block_info_cmd ; block_create_cmd ; block_destroy_cmd ;
console_cmd ; stats_cmd ; log_cmd ] console_cmd ;
stats_subscribe_cmd ; stats_add_cmd ; stats_remove_cmd ; log_cmd ]
let () = let () =
match Term.eval_choice default_cmd cmds match Term.eval_choice default_cmd cmds

4
app/vmmd_influx.ml
View file

@ -149,8 +149,8 @@ module P = struct
] ]
in in
let fields = List.map (fun (k, v) -> k ^ "=" ^ v) fields in let fields = List.map (fun (k, v) -> k ^ "=" ^ v) fields in
Printf.sprintf "interface,vm=%s,ifname=%s %s" Printf.sprintf "interface,vm=%s,ifname=%s,bridge=%s %s"
vm ifd.ifname (String.concat ~sep:"," fields) vm ifd.ifname ifd.bridge (String.concat ~sep:"," fields)
end end
let my_version = `AV3 let my_version = `AV3

29
app/vmmd_stats.ml
View file

@ -25,39 +25,32 @@ let pp_sockaddr ppf = function
let handle s addr () = let handle s addr () =
Logs.info (fun m -> m "handling stats connection %a" pp_sockaddr addr) ; Logs.info (fun m -> m "handling stats connection %a" pp_sockaddr addr) ;
let rec loop pids = let rec loop () =
Vmm_lwt.read_wire s >>= function Vmm_lwt.read_wire s >>= function
| Error _ -> | Error _ ->
Logs.err (fun m -> m "exception while reading") ; Logs.err (fun m -> m "exception while reading") ;
Lwt.return pids Lwt.return_unit
| Ok wire -> | Ok wire ->
match handle !t s wire with match handle !t s wire with
| Error (`Msg msg) -> | Error (`Msg msg) ->
Vmm_lwt.write_wire s (fst wire, `Failure msg) >>= fun _ -> Vmm_lwt.write_wire s (fst wire, `Failure msg) >>= fun _ ->
Lwt.return pids Lwt.return_unit
| Ok (t', action, out) -> | Ok (t', close, out) ->
t := t' ; t := t' ;
let pids = match action with
| `Add pid -> pid :: pids
| `Remove pid -> List.filter (fun m -> m <> pid) pids
| `Close _ -> pids
in
Vmm_lwt.write_wire s (fst wire, `Success (`String out)) >>= function Vmm_lwt.write_wire s (fst wire, `Success (`String out)) >>= function
| Ok () -> | Ok () ->
(match action with (match close with
| `Close (Some s') -> | Some s' ->
Vmm_lwt.safe_close s' >>= fun () -> Vmm_lwt.safe_close s' >>= fun () ->
(* read the next *) (* read the next *)
Vmm_lwt.read_wire s >|= fun _ -> pids loop ()
| _ -> loop pids) | None -> loop ())
| Error _ -> | Error _ ->
Logs.err (fun m -> m "error while writing") ; Logs.err (fun m -> m "error while writing") ;
Lwt.return pids Lwt.return_unit
in in
loop [] >>= fun vmids -> loop () >>= fun () ->
Vmm_lwt.safe_close s >|= fun () -> Vmm_lwt.safe_close s
Logs.warn (fun m -> m "disconnect, dropping %d vms!" (List.length vmids)) ;
t := remove_vmids !t vmids
let timer () = let timer () =
let t', outs = tick !t in let t', outs = tick !t in

44
src/vmm_asn.ml
View file

@ -144,14 +144,15 @@ let int32 =
let ifdata = let ifdata =
let open Stats in let open Stats in
let f (ifname, (flags, (send_length, (max_send_length, (send_drops, (mtu, (baudrate, (input_packets, (input_errors, (output_packets, (output_errors, (collisions, (input_bytes, (output_bytes, (input_mcast, (output_mcast, (input_dropped, output_dropped))))))))))))))))) = let f (bridge, (ifname, (flags, (send_length, (max_send_length, (send_drops, (mtu, (baudrate, (input_packets, (input_errors, (output_packets, (output_errors, (collisions, (input_bytes, (output_bytes, (input_mcast, (output_mcast, (input_dropped, output_dropped)))))))))))))))))) =
{ ifname; flags; send_length; max_send_length; send_drops; mtu; baudrate; input_packets; input_errors; output_packets; output_errors; collisions; input_bytes; output_bytes; input_mcast; output_mcast; input_dropped; output_dropped } { bridge ; ifname; flags; send_length; max_send_length; send_drops; mtu; baudrate; input_packets; input_errors; output_packets; output_errors; collisions; input_bytes; output_bytes; input_mcast; output_mcast; input_dropped; output_dropped }
and g i = and g i =
(i.ifname, (i.flags, (i.send_length, (i.max_send_length, (i.send_drops, (i.mtu, (i.baudrate, (i.input_packets, (i.input_errors, (i.output_packets, (i.output_errors, (i.collisions, (i.input_bytes, (i.output_bytes, (i.input_mcast, (i.output_mcast, (i.input_dropped, i.output_dropped))))))))))))))))) (i.bridge, (i.ifname, (i.flags, (i.send_length, (i.max_send_length, (i.send_drops, (i.mtu, (i.baudrate, (i.input_packets, (i.input_errors, (i.output_packets, (i.output_errors, (i.collisions, (i.input_bytes, (i.output_bytes, (i.input_mcast, (i.output_mcast, (i.input_dropped, i.output_dropped))))))))))))))))))
in in
Asn.S.map f g @@ Asn.S.map f g @@
Asn.S.(sequence @@ Asn.S.(sequence @@
(required ~label:"ifname" utf8_string) (required ~label:"bridge" utf8_string)
@ (required ~label:"ifname" utf8_string)
@ (required ~label:"flags" int32) @ (required ~label:"flags" int32)
@ (required ~label:"send_length" int32) @ (required ~label:"send_length" int32)
@ (required ~label:"max_send_length" int32) @ (required ~label:"max_send_length" int32)
@ -172,19 +173,24 @@ let ifdata =
let stats_cmd = let stats_cmd =
let f = function let f = function
| `C1 (pid, taps) -> `Stats_add (pid, taps) | `C1 (name, pid, taps) -> `Stats_add (name, pid, taps)
| `C2 () -> `Stats_remove | `C2 () -> `Stats_remove
| `C3 () -> `Stats_subscribe | `C3 () -> `Stats_subscribe
and g = function and g = function
| `Stats_add (pid, taps) -> `C1 (pid, taps) | `Stats_add (name, pid, taps) -> `C1 (name, pid, taps)
| `Stats_remove -> `C2 () | `Stats_remove -> `C2 ()
| `Stats_subscribe -> `C3 () | `Stats_subscribe -> `C3 ()
in in
Asn.S.map f g @@ Asn.S.map f g @@
Asn.S.(choice3 Asn.S.(choice3
(explicit 0 (sequence2 (explicit 0 (sequence3
(required ~label:"vmmdev" utf8_string)
(required ~label:"pid" int) (required ~label:"pid" int)
(required ~label:"taps" (sequence_of utf8_string)))) (required ~label:"network"
(sequence_of
(sequence2
(required ~label:"bridge" utf8_string)
(required ~label:"tap" utf8_string))))))
(explicit 1 null) (explicit 1 null)
(explicit 2 null)) (explicit 2 null))
@ -456,6 +462,28 @@ let wire =
let wire_of_cstruct, wire_to_cstruct = projections_of wire let wire_of_cstruct, wire_to_cstruct = projections_of wire
(* maybe one day to smoothly transition to a new version,
but this requires version handshaking in all communication (i.e. server
sends: supported versions, client picks one to talk over this channel)
let payload_of_cstruct, _ = projections_of payload
let wire_of_cstruct versions buf =
let wire_header =
Asn.S.(sequence2
(required ~label:"header" header)
(required ~label:"payload" octet_string))
in
let wire_header_of_cstruct, _ = projections_of wire_header in
match wire_header_of_cstruct buf with
| Error e -> Error e
| Ok (header, payload) ->
if List.mem header.version versions then
match payload_of_cstruct payload with
| Ok p -> Ok (header, p)
| Error e -> Error e
else
Error (`Msg "unsupported version")
*)
let log_entry = let log_entry =
Asn.S.(sequence2 Asn.S.(sequence2
(required ~label:"timestamp" utc_time) (required ~label:"timestamp" utc_time)

9
src/vmm_commands.ml
View file

@ -29,13 +29,15 @@ let pp_console_cmd ppf = function
Fmt.(option ~none:(unit "epoch") (Ptime.pp_rfc3339 ())) ts Fmt.(option ~none:(unit "epoch") (Ptime.pp_rfc3339 ())) ts
type stats_cmd = [ type stats_cmd = [
| `Stats_add of int * string list | `Stats_add of string * int * (string * string) list
| `Stats_remove | `Stats_remove
| `Stats_subscribe | `Stats_subscribe
] ]
let pp_stats_cmd ppf = function let pp_stats_cmd ppf = function
| `Stats_add (pid, taps) -> Fmt.pf ppf "stats add: pid %d taps %a" pid Fmt.(list ~sep:(unit ", ") string) taps | `Stats_add (vmmdev, pid, taps) ->
Fmt.pf ppf "stats add: vmm device %s pid %d taps %a" vmmdev pid
Fmt.(list ~sep:(unit ", ") (pair ~sep:(unit ": ") string string)) taps
| `Stats_remove -> Fmt.string ppf "stat remove" | `Stats_remove -> Fmt.string ppf "stat remove"
| `Stats_subscribe -> Fmt.string ppf "stat subscribe" | `Stats_subscribe -> Fmt.string ppf "stat subscribe"
@ -154,7 +156,8 @@ let endpoint = function
| `Unikernel_cmd _ -> `Vmmd, `End | `Unikernel_cmd _ -> `Vmmd, `End
| `Policy_cmd _ -> `Vmmd, `End | `Policy_cmd _ -> `Vmmd, `End
| `Block_cmd _ -> `Vmmd, `End | `Block_cmd _ -> `Vmmd, `End
| `Stats_cmd _ -> `Stats, `Read | `Stats_cmd `Stats_subscribe -> `Stats, `Read
| `Stats_cmd _ -> `Stats, `End
| `Console_cmd _ -> `Console, `Read | `Console_cmd _ -> `Console, `Read
| `Log_cmd _ -> `Log, `Read | `Log_cmd _ -> `Log, `Read

2
src/vmm_commands.mli
View file

@ -17,7 +17,7 @@ type console_cmd = [
] ]
type stats_cmd = [ type stats_cmd = [
| `Stats_add of int * string list | `Stats_add of string * int * (string * string) list
| `Stats_remove | `Stats_remove
| `Stats_subscribe | `Stats_subscribe
] ]

5
src/vmm_core.ml
View file

@ -237,6 +237,7 @@ module Stats = struct
(List.filter (fun (k, _) -> k = "Resident memory" || k = "Wired memory") vmm) (List.filter (fun (k, _) -> k = "Resident memory" || k = "Wired memory") vmm)
type ifdata = { type ifdata = {
bridge : string ;
ifname : string ; ifname : string ;
flags : int32 ; flags : int32 ;
send_length : int32 ; send_length : int32 ;
@ -258,8 +259,8 @@ module Stats = struct
} }
let pp_ifdata ppf i = let pp_ifdata ppf i =
Fmt.pf ppf "ifname %s flags %lX send_length %lu max_send_length %lu send_drops %lu mtu %lu baudrate %Lu input_packets %Lu input_errors %Lu output_packets %Lu output_errors %Lu collisions %Lu input_bytes %Lu output_bytes %Lu input_mcast %Lu output_mcast %Lu input_dropped %Lu output_dropped %Lu" Fmt.pf ppf "bridge %s ifname %s flags %lX send_length %lu max_send_length %lu send_drops %lu mtu %lu baudrate %Lu input_packets %Lu input_errors %Lu output_packets %Lu output_errors %Lu collisions %Lu input_bytes %Lu output_bytes %Lu input_mcast %Lu output_mcast %Lu input_dropped %Lu output_dropped %Lu"
i.ifname i.flags i.send_length i.max_send_length i.send_drops i.mtu i.baudrate i.input_packets i.input_errors i.output_packets i.output_errors i.collisions i.input_bytes i.output_bytes i.input_mcast i.output_mcast i.input_dropped i.output_dropped i.bridge i.ifname i.flags i.send_length i.max_send_length i.send_drops i.mtu i.baudrate i.input_packets i.input_errors i.output_packets i.output_errors i.collisions i.input_bytes i.output_bytes i.input_mcast i.output_mcast i.input_dropped i.output_dropped
type t = rusage * kinfo_mem option * vmm option * ifdata list type t = rusage * kinfo_mem option * vmm option * ifdata list
let pp ppf (ru, mem, vmm, ifs) = let pp ppf (ru, mem, vmm, ifs) =

1
src/vmm_core.mli
View file

@ -118,6 +118,7 @@ module Stats : sig
val pp_vmm_mem : vmm Fmt.t val pp_vmm_mem : vmm Fmt.t
type ifdata = { type ifdata = {
bridge : string;
ifname : string; ifname : string;
flags : int32; flags : int32;
send_length : int32; send_length : int32;

8
src/vmm_vmmd.ml
View file

@ -86,7 +86,13 @@ let handle_create t reply name vm_config =
Ok (t, [ reply (`String "created VM") ; out ], name, vm))) Ok (t, [ reply (`String "created VM") ; out ], name, vm)))
let setup_stats t name vm = let setup_stats t name vm =
let stat_out = `Stats_add (vm.Unikernel.pid, vm.Unikernel.taps) in let stat_out =
let pid = vm.Unikernel.pid in
let name = "solo5-" ^ string_of_int pid
and ifs = Unikernel.(List.combine vm.config.network_interfaces vm.taps)
in
`Stats_add (name, pid, ifs)
in
let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in
let t = { t with stats_counter = Int64.succ t.stats_counter } in let t = { t with stats_counter = Int64.succ t.stats_counter } in
t, `Stat (header, `Command (`Stats_cmd stat_out)) t, `Stat (header, `Command (`Stats_cmd stat_out))