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

vmm_tls: ensure that add_policy commands carry a non-empty name

Browse source
This commit is contained in:
Hannes Mehnert 2018-10-28 22:29:45 +01:00
parent d08de432b6
commit 947b82f4f0
1 changed files with 19 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/vmm_tls.ml
View file

@ -6,21 +6,24 @@ open Rresult.R.Infix
(* we skip all non-albatross certificates *) (* we skip all non-albatross certificates *)
let cert_name cert = let cert_name cert =
match X509.Extension.unsupported cert Vmm_asn.oid with match X509.Extension.unsupported cert Vmm_asn.oid with
| None -> None | None -> Ok None
| Some _ -> | Some (_, data) ->
let data = X509.common_name_to_string cert in let name = X509.common_name_to_string cert in
(* if the common name is empty, skip [useful for vmmc_bistro at least] if name = "" then
TODO: document properly and investigate potential security issue with match Vmm_asn.cert_extension_of_cstruct data with
multi-tenant system (likely ca should ensure to never sign a delegation | Error (`Msg _) -> Error (`Msg "couldn't parse albatross extension")
with empty common name) *) | Ok (_, `Policy_cmd (`Policy_add _)) -> Error (`Msg "policy add may not have an empty name")
if data = "" then None else Some data | _ -> Ok (Some name)
else Ok (Some name)
let name chain = let name chain =
List.fold_left (fun acc cert -> List.fold_left (fun acc cert ->
match cert_name cert with match acc, cert_name cert with
| None -> acc | Error e, _ -> Error e
| Some data -> data :: acc) | _, Error e -> Error e
[] chain | Ok acc, Ok None -> Ok acc
| Ok acc, Ok Some data -> Ok (data :: acc))
(Ok []) chain
(* this separates the leaf and top-level certificate from the chain, (* this separates the leaf and top-level certificate from the chain,
and also reverses the intermediates (to be (leaf, CA -> subCA -> subCA') and also reverses the intermediates (to be (leaf, CA -> subCA -> subCA')
@ -53,18 +56,17 @@ let extract_policies version chain =
Vmm_commands.pp_version received Vmm_commands.pp_version received
Vmm_commands.pp_version version Vmm_commands.pp_version version
| Ok (prefix, acc), Ok (`Policy_cmd (`Policy_add p)) -> | Ok (prefix, acc), Ok (`Policy_cmd (`Policy_add p)) ->
let name = match cert_name cert with (cert_name cert >>| function
| None -> prefix | None -> prefix
| Some x -> x :: prefix | Some x -> x :: prefix) >>| fun name ->
in (name, (name, p) :: acc)
Ok (name, (name, p) :: acc)
| _, Ok wire -> | _, Ok wire ->
R.error_msgf "unexpected wire %a" Vmm_commands.pp wire) R.error_msgf "unexpected wire %a" Vmm_commands.pp wire)
(Ok ([], [])) chain (Ok ([], [])) chain
let handle _addr version chain = let handle _addr version chain =
separate_chain chain >>= fun (leaf, rest) -> separate_chain chain >>= fun (leaf, rest) ->
let name = name chain in name chain >>= fun name ->
Logs.debug (fun m -> m "leaf is %s, chain %a" Logs.debug (fun m -> m "leaf is %s, chain %a"
(X509.common_name_to_string leaf) (X509.common_name_to_string leaf)
Fmt.(list ~sep:(unit " -> ") string) Fmt.(list ~sep:(unit " -> ") string)