revise naming freedom: multiple labels are allowed in certificate common names

influx may drop topmost label (if --drop-label provided)
This commit is contained in:
Hannes Mehnert 2019-11-09 02:44:31 +01:00
parent ec9f00b39a
commit 057dbbf147
4 changed files with 46 additions and 20 deletions

View file

@ -174,7 +174,7 @@ let safe_close s =
Logs.err (fun m -> m "exception %s while closing" (Printexc.to_string e)) ;
Lwt.return_unit)
let rec read_sock_write_tcp c ?fd addr =
let rec read_sock_write_tcp drop c ?fd addr =
match fd with
| None ->
begin
@ -184,10 +184,10 @@ let rec read_sock_write_tcp c ?fd addr =
Logs.warn (fun m -> m "error connecting to influxd %a, retrying in 5s"
Vmm_lwt.pp_sockaddr addr);
Lwt_unix.sleep 5.0 >>= fun () ->
read_sock_write_tcp c addr
read_sock_write_tcp drop c addr
| Some fd ->
Lwt_unix.setsockopt fd Lwt_unix.SO_KEEPALIVE true ;
read_sock_write_tcp c ~fd addr
read_sock_write_tcp drop c ~fd addr
end
| Some fd ->
Logs.debug (fun m -> m "reading from unix socket") ;
@ -206,7 +206,14 @@ let rec read_sock_write_tcp c ?fd addr =
safe_close c >|= fun () ->
false
end else
let name = Name.to_string hdr.Vmm_commands.name in
let name =
let orig = hdr.Vmm_commands.name
and f = if drop then Name.drop_front else (fun a -> a)
in
let n = f orig in
let safe = if Name.is_root n then orig else n in
Name.to_string safe
in
let ru = P.encode_ru name ru in
let mem = match mem with None -> [] | Some m -> [ P.encode_kinfo_mem name m ] in
let vmm = match vmm with None -> [] | Some vmm -> [ P.encode_vmm name vmm ] in
@ -216,7 +223,7 @@ let rec read_sock_write_tcp c ?fd addr =
Vmm_lwt.write_raw fd (Bytes.unsafe_of_string out) >>= function
| Ok () ->
Logs.debug (fun m -> m "wrote successfully") ;
read_sock_write_tcp c ~fd addr
read_sock_write_tcp drop c ~fd addr
| Error e ->
Logs.err (fun m -> m "error %s while writing to tcp (%s)"
(str_of_e e) name) ;
@ -226,7 +233,7 @@ let rec read_sock_write_tcp c ?fd addr =
| Ok wire ->
Logs.warn (fun m -> m "ignoring %a" Vmm_commands.pp_wire wire) ;
Lwt.return (Some fd) >>= fun fd ->
read_sock_write_tcp c ?fd addr
read_sock_write_tcp drop c ?fd addr
let query_sock vm c =
let header = Vmm_commands.{ version = my_version ; sequence = !command ; name = vm } in
@ -246,7 +253,7 @@ let rec maybe_connect () =
Logs.debug (fun m -> m "connected");
Lwt.return c
let client influx vm =
let client influx vm drop =
match influx with
| None -> Lwt.return (Error (`Msg "influx host not provided"))
| Some (ip, port) ->
@ -276,25 +283,29 @@ let client influx vm =
in
Lwt.return err
| Ok () ->
read_sock_write_tcp c addr >>= fun restart ->
read_sock_write_tcp drop c addr >>= fun restart ->
if restart then loop () else Lwt.return (Ok ())
in
loop ()
let run_client _ influx vm =
let run_client _ influx vm drop =
Sys.(set_signal sigpipe Signal_ignore) ;
Lwt_main.run (client influx vm)
Lwt_main.run (client influx vm drop)
open Cmdliner
open Albatross_cli
let drop_label =
let doc = "Drop leftmost label" in
Arg.(value & flag & info [ "drop-label" ] ~doc)
let cmd =
let doc = "Albatross Influx connector" in
let man = [
`S "DESCRIPTION" ;
`P "$(tname) connects to a albatross stats socket, pulls statistics and pushes them via TCP to influxdb" ]
in
Term.(term_result (const run_client $ setup_log $ influx $ opt_vm_name)),
Term.(term_result (const run_client $ setup_log $ influx $ opt_vm_name $ drop_label)),
Term.info "albatross_influx" ~version:"%%VERSION_NUM%%" ~doc ~man
let () =

View file

@ -76,6 +76,10 @@ module Name = struct
| [] -> []
| _::tl -> List.rev tl
let drop_front = function
| [] -> []
| _::tl -> tl
let append_exn lbl x =
if valid_label lbl then
x @ [ lbl ]
@ -94,6 +98,8 @@ module Name = struct
else
Error (`Msg "label not valid")
let concat a b = a @ b
let domain id = match List.rev id with
| _::prefix -> List.rev prefix
| [] -> []

View file

@ -27,9 +27,11 @@ module Name : sig
val of_list : string list -> (t, [> `Msg of string ]) result
val to_list : t -> string list
val drop : t -> t
val drop_front : t -> t
val append : string -> t -> (t, [> `Msg of string ]) result
val prepend : string -> t -> (t, [> `Msg of string ]) result
val append_exn : string -> t -> t
val concat : t -> t -> t
val root : t
val valid_label : string -> bool

View file

@ -33,12 +33,8 @@ let name chain =
| Error e, _ -> Error e
| _, Error e -> Error e
| Ok acc, Ok None -> Ok acc
| Ok acc, Ok (Some data) -> Vmm_core.Name.prepend data acc)
(Ok Vmm_core.Name.root) chain >>= fun lbl ->
if List.length (Vmm_core.Name.to_list lbl) < 10 then
Ok lbl
else
Error (`Msg "too deep")
| Ok acc, Ok (Some data) -> Vmm_core.Name.append data acc)
(Ok Vmm_core.Name.root) chain
(* this separates the leaf and top-level certificate from the chain,
and also reverses the intermediates (to be (leaf, CA -> subCA -> subCA')
@ -78,10 +74,21 @@ let extract_policies version chain =
(Ok (Vmm_core.Name.root, [])) chain
let handle version chain =
(if List.length chain < 10 then
Ok ()
else
Error (`Msg "certificate chain too long")) >>= fun () ->
separate_chain chain >>= fun (leaf, rest) ->
name chain >>= fun name ->
Logs.debug (fun m -> m "leaf is %a, chain %a"
Certificate.pp leaf
(* use subject common names of intermediate certs as prefix *)
name rest >>= fun name' ->
(* and subject common name of leaf certificate -- allowing dots in CN -- as postfix *)
(cert_name leaf >>= function
| None -> Ok name'
| Some x ->
Vmm_core.Name.of_string x >>| fun post ->
Vmm_core.Name.concat name' post) >>= fun name ->
Logs.debug (fun m -> m "name is %a leaf is %a, chain %a"
Vmm_core.Name.pp name Certificate.pp leaf
Fmt.(list ~sep:(unit " -> ") Certificate.pp) rest);
extract_policies version rest >>= fun (_, policies) ->
(* TODO: logging let login_hdr, login_ev = Log.hdr name, `Login addr in *)