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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
app/vmm_client.ml
View File

@ -4,16 +4,10 @@ open Lwt.Infix
let rec read_tls_write_cons t =
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
| Ok data ->
match Vmm_commands.log_pp_reply data with
| 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
| Ok wire ->
Logs.app (fun m -> m "%a" Vmm_asn.pp_wire wire) ;
read_tls_write_cons t
let client cas host port cert priv_key =
Nocrypto_entropy_lwt.initialize () >>= fun () ->

5
app/vmm_tls_endpoint.ml
View File

@ -165,3 +165,8 @@ let port =
let doc = "TCP listen port" in
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

2
pkg/pkg.ml
View File

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