aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/starttls.ml6
1 files changed, 6 insertions, 0 deletions
diff --git a/lib/starttls.ml b/lib/starttls.ml
index 7391fd6..714defe 100644
--- a/lib/starttls.ml
+++ b/lib/starttls.ml
@@ -2,8 +2,12 @@ open Lwt.Syntax
open Xml
exception TLSError
+
+(** [STARTTLSFailure] is thrown if the server doesn't allow the STARTTLS negotiation to
+ proceed, either by sending back a [<failure/>] or by unspecified behavior. *)
exception STARTTLSFailure
+(** [stanza] is a correct [<starttls/>] stanza as a stream of signals. *)
let stanza =
Markup.of_list
[`Start_element
@@ -11,6 +15,7 @@ let stanza =
[(("http://www.w3.org/2000/xmlns/", "xmlns"), Xmlns.tls)]);
`End_element]
+(** [parse_reply response] parses [response] as a STARTTLS handshake reply. *)
let parse_reply response =
match response with
| {namespace=ns; local_name="proceed";
@@ -19,6 +24,7 @@ let parse_reply response =
attributes=[]; children=[]} when ns = Xmlns.tls -> `Failure
| _ -> `Error
+(** [upgrade portal] upgrades the Portal to STARTTLS. *)
let upgrade (portal : Portal.t) : unit Lwt.t =
portal.push (Some stanza);
let* response = Wire.get portal.stream