diff --git a/app/vmm_client.ml b/app/vmm_client.ml index 4599ad6..51e6681 100644 --- a/app/vmm_client.ml +++ b/app/vmm_client.ml @@ -2,8 +2,6 @@ open Lwt.Infix -open Vmm_core - let rec read_tls_write_cons t = Vmm_tls.read_tls t >>= function | Error (`Msg msg) -> @@ -28,9 +26,6 @@ let client cas host port cert priv_key = Lwt_unix.connect fd (Lwt_unix.ADDR_INET (host_inet_addr, port)) >>= fun _ -> X509_lwt.private_of_pems ~cert ~priv_key >>= fun cert -> - (match fst cert with - | [] -> Lwt.fail_with "certificate is empty" - | hd::_ -> Lwt.return hd) >>= fun leaf -> let certificates = `Single cert in let client = Tls.Config.client ~reneg:true ~certificates ~authenticator () in Tls_lwt.Unix.client_of_fd client (* ~host *) fd >>= fun t -> @@ -40,7 +35,7 @@ let client cas host port cert priv_key = (Printexc.to_string exn)) ; Lwt.return_unit) -let run_client _ cas cert key (host, port) db = +let run_client _ cas cert key (host, port) = Printexc.register_printer (function | Tls_lwt.Tls_alert x -> Some ("TLS alert: " ^ Tls.Packet.alert_type_to_string x) | Tls_lwt.Tls_failure f -> Some ("TLS failure: " ^ Tls.Engine.string_of_failure f) @@ -92,17 +87,13 @@ let destination = Arg.(required & pos 3 (some host_port) None & info [] ~docv:"destination" ~doc:"the destination hostname:port to connect to") -let db = - let doc = "Certificate database" in - Arg.(value & opt (some file) None & info [ "db" ] ~doc) - let cmd = let doc = "VMM TLS client" in let man = [ `S "DESCRIPTION" ; `P "$(tname) connects to a server and initiates a TLS handshake" ] in - Term.(pure run_client $ setup_log $ cas $ client_cert $ client_key $ destination $ db), + Term.(pure run_client $ setup_log $ cas $ client_cert $ client_key $ destination), Term.info "vmm_client" ~version:"%%VERSION_NUM%%" ~doc ~man let () = diff --git a/app/vmm_log.ml b/app/vmm_log.ml index 649a548..5d2969d 100644 --- a/app/vmm_log.ml +++ b/app/vmm_log.ml @@ -12,8 +12,6 @@ open Lwt.Infix -open Astring - let my_version = `WV2 let broadcast prefix data t = diff --git a/src/vmm_commands.ml b/src/vmm_commands.ml index 31ab71d..f8bedc3 100644 --- a/src/vmm_commands.ml +++ b/src/vmm_commands.ml @@ -53,8 +53,8 @@ let handle = function let cmd = Vmm_wire.Log.subscribe c ver name in `Log, `Read, cmd | `Crl -> assert false - | `Create_block (name, size) -> assert false - | `Destroy_block name -> assert false + | `Create_block (_name, _size) -> assert false + | `Destroy_block _name -> assert false let handle_reply (hdr, data) = if not (Vmm_wire.version_eq hdr.Vmm_wire.version ver) then diff --git a/src/vmm_wire.ml b/src/vmm_wire.ml index 9153fbc..d06ff00 100644 --- a/src/vmm_wire.ml +++ b/src/vmm_wire.ml @@ -538,7 +538,7 @@ module Log = struct let log id version hdr event = let body = Cstruct.append (encode_ptime hdr.Log.ts) (encode_event event) in - encode ~name:hdr.name ~body version id (op_to_int Log) + encode ~name:hdr.Log.name ~body version id (op_to_int Log) end module Vm = struct diff --git a/src/vmm_x509.ml b/src/vmm_x509.ml index ea65bb1..fbef56d 100644 --- a/src/vmm_x509.ml +++ b/src/vmm_x509.ml @@ -1,4 +1,3 @@ -open Astring open Rresult.R.Infix open Vmm_core @@ -18,7 +17,7 @@ let asn_version = `AV1 check_policies vm_config (List.map snd policies) >>= fun () -> *) -let handle addr chain = +let handle _addr chain = separate_chain chain >>= fun (leaf, chain) -> let prefix = List.map name chain in let name = prefix @ [ name leaf ] in