tls_lwt: register printer for exceptions

lib/crypto.ml

@@ -43,6 +43,7 @@ module Ciphers = struct
     function
     | AES_128_CCM | AES_256_CCM ->
        let cipher = (module CCM : Cipher_block.S.CCM with type key = CCM.key) in
+       (* TODO the 16 should either be input or extracted from ciphersuite name *)
        let cipher_secret = CCM.of_secret ~maclen:16 secret in
        State.(AEAD { cipher = CCM cipher ; cipher_secret ; nonce })
     | AES_128_GCM | AES_256_GCM ->
@@ -144,6 +145,12 @@ let cbc_unpad data =
 let tag_len (type a) = function
   | State.CCM cipher ->
     let module C = (val cipher : Cipher_block.S.CCM with type key = a) in
+    (* TODO this is wrong (but works since "16" is always passed in above,
+       which indeed is the AES128/256 block size). There should be a
+       C.tag_size (in CCM this needs to depend on the key though (due to
+       different possible mac sizes), in contrast to GCM where we always have
+       a static one) - maybe mirage-crypto CCM should take mac len as functor
+       argument? *)
     C.block_size
   | State.GCM cipher ->
     let module C = (val cipher : Cipher_block.S.GCM with type key = a) in

lwt/tls_lwt.ml

@@ -262,3 +262,11 @@ and connect authenticator addr =
 
 (* Boot the entropy loop at module init time. *)
 let () = Mirage_crypto_rng_lwt.initialize ()
+
+let () =
+  Printexc.register_printer (function
+      | Tls_alert typ ->
+        Some ("TLS alert from peer: " ^ Tls.Packet.alert_type_to_string typ)
+      | Tls_failure f ->
+        Some ("TLS failure: " ^ Tls.Engine.string_of_failure f)
+      | _ -> None)