whitelist commands accepted via tls certificate

This commit is contained in:
Hannes Mehnert 2018-10-25 16:27:56 +02:00
parent 992e1b0a2b
commit 85a507db54
1 changed files with 10 additions and 3 deletions

View File

@ -27,6 +27,13 @@ let handle _addr version chain =
(List.map X509.common_name_to_string chain)) ;
(* TODO: inspect top-level-cert of chain. *)
(* TODO: logging let login_hdr, login_ev = Log.hdr name, `Login addr in *)
(* TODO: update policies! *)
Vmm_asn.wire_command_of_cert version leaf >>| fun wire ->
(name, wire)
(* TODO: update policies (parse chain for policy, and apply them)! *)
Vmm_asn.wire_command_of_cert version leaf >>= fun wire ->
(* we only allow some commands via certificate *)
match wire with
| `Console_cmd (`Console_subscribe _)
| `Stats_cmd `Stats_subscribe
| `Log_cmd (`Log_subscribe _)
| `Vm_cmd _
| `Policy_cmd _ -> Ok (name, wire) (* TODO policy_cmd is special (via delegation chain) *)
| _ -> Error (`Msg "unexpected command")