anil.recoil.org
A batteries included HTTP/1.1 client in OCaml
Suppress TLS tracing debug output, improve Zulip request logging
ocaml-requests: Add automatic suppression of tls.tracing source after
first TLS connection. The source is created lazily by ocaml-tls, so
early logging setup misses it. Now suppressed to Warning level after
first connection unless explicitly set to Debug.
ocaml-zulip: Log full URL with query params in debug output instead of
just the path, making it easier to debug API issues.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+20
-1
+20
-1
lib/one.ml
+20
-1
lib/one.ml
···
26
26
| TLS_1_2 (** TLS 1.2 minimum (default, widely compatible) *)
27
27
| TLS_1_3 (** TLS 1.3 minimum (most secure, may not work with older servers) *)
28
28
29
+
(* Track whether TLS tracing has been suppressed *)
30
+
let tls_tracing_suppressed = ref false
31
+
32
+
(* Suppress TLS tracing debug output (hexdumps) unless explicitly enabled *)
33
+
let suppress_tls_tracing () =
34
+
if not !tls_tracing_suppressed then begin
35
+
tls_tracing_suppressed := true;
36
+
match List.find_opt (fun s -> Logs.Src.name s = "tls.tracing") (Logs.Src.list ()) with
37
+
| Some tls_src ->
38
+
(* Only suppress if currently at Debug level *)
39
+
(match Logs.Src.level tls_src with
40
+
| Some Logs.Debug -> Logs.Src.set_level tls_src (Some Logs.Warning)
41
+
| _ -> ())
42
+
| None -> ()
43
+
end
44
+
29
45
(* Helper to wrap connection with TLS if needed *)
30
46
let wrap_tls flow ~host ~verify_tls ~tls_config ~min_tls_version =
31
47
Log.debug (fun m -> m "Wrapping connection with TLS for %s (verify=%b)" host verify_tls);
···
54
70
}))
55
71
in
56
72
57
-
(Tls_eio.client_of_flow ~host:domain tls_cfg flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
73
+
let tls_flow = Tls_eio.client_of_flow ~host:domain tls_cfg flow in
74
+
(* Suppress TLS tracing after first connection creates the tls.tracing source *)
75
+
suppress_tls_tracing ();
76
+
(tls_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
58
77
59
78
(* Parse URL and connect directly (no pooling) *)
60
79
let connect_to_url ~sw ~clock ~net ~url ~timeout ~verify_tls ~tls_config ~min_tls_version =