toplevel for tls endpoint, client fixes

This commit is contained in:
Hannes Mehnert 2018-10-23 00:40:39 +02:00
parent 0441b8ab25
commit 183d1c9e58
3 changed files with 9 additions and 10 deletions

View file

@ -4,15 +4,9 @@ open Lwt.Infix
let rec read_tls_write_cons t = let rec read_tls_write_cons t =
Vmm_tls.read_tls t >>= function Vmm_tls.read_tls t >>= function
| Error (`Msg msg) ->
Logs.err (fun m -> m "error while reading %s" msg) ;
read_tls_write_cons t
| Error _ -> Logs.err (fun m -> m "exception while reading") ; Lwt.return_unit | Error _ -> Logs.err (fun m -> m "exception while reading") ; Lwt.return_unit
| Ok data -> | Ok wire ->
match Vmm_commands.log_pp_reply data with Logs.app (fun m -> m "%a" Vmm_asn.pp_wire wire) ;
| Ok () -> read_tls_write_cons t
| Error (`Msg msg) ->
Logs.warn (fun m -> m "error %s while logging message" msg) ;
read_tls_write_cons t read_tls_write_cons t
let client cas host port cert priv_key = let client cas host port cert priv_key =

View file

@ -165,3 +165,8 @@ let port =
let doc = "TCP listen port" in let doc = "TCP listen port" in
Arg.(value & opt int 1025 & info [ "port" ] ~doc) Arg.(value & opt int 1025 & info [ "port" ] ~doc)
let cmd =
Term.(ret (const jump $ setup_log $ cacert $ cert $ key $ port)),
Term.info "vmm_tls_endpoint" ~version:"%%VERSION_NUM%%"
let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1

View file

@ -10,7 +10,7 @@ let () =
Pkg.bin "app/vmmd" ; Pkg.bin "app/vmmd" ;
Pkg.bin "app/vmm_console" ; Pkg.bin "app/vmm_console" ;
Pkg.bin "app/vmm_log" ; Pkg.bin "app/vmm_log" ;
(* Pkg.bin "app/vmm_client" ; *) Pkg.bin "app/vmm_client" ;
Pkg.bin "app/vmm_tls_endpoint" ; Pkg.bin "app/vmm_tls_endpoint" ;
Pkg.bin "app/vmmc" ; Pkg.bin "app/vmmc" ;
Pkg.bin "provision/vmm_req_command" ; Pkg.bin "provision/vmm_req_command" ;