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

View file

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

View file

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

View file

@ -33,12 +33,8 @@ let name chain =
| Error e, _ -> Error e | Error e, _ -> Error e
| _, Error e -> Error e | _, Error e -> Error e
| Ok acc, Ok None -> Ok acc | Ok acc, Ok None -> Ok acc
| Ok acc, Ok (Some data) -> Vmm_core.Name.prepend data acc) | Ok acc, Ok (Some data) -> Vmm_core.Name.append data acc)
(Ok Vmm_core.Name.root) chain >>= fun lbl -> (Ok Vmm_core.Name.root) chain
if List.length (Vmm_core.Name.to_list lbl) < 10 then
Ok lbl
else
Error (`Msg "too deep")
(* 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')
@ -78,10 +74,21 @@ let extract_policies version chain =
(Ok (Vmm_core.Name.root, [])) chain (Ok (Vmm_core.Name.root, [])) chain
let handle version 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) -> separate_chain chain >>= fun (leaf, rest) ->
name chain >>= fun name -> (* use subject common names of intermediate certs as prefix *)
Logs.debug (fun m -> m "leaf is %a, chain %a" name rest >>= fun name' ->
Certificate.pp leaf (* 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); Fmt.(list ~sep:(unit " -> ") Certificate.pp) rest);
extract_policies version rest >>= fun (_, policies) -> extract_policies version rest >>= fun (_, policies) ->
(* TODO: logging let login_hdr, login_ev = Log.hdr name, `Login addr in *) (* TODO: logging let login_hdr, login_ev = Log.hdr name, `Login addr in *)