feat response: add pp_with; have pp hide set-cookie headers

we don't want to accidentally log cookies, they might contain
credentials or secret tokens.
This commit is contained in:
Simon Cruanes 2024-09-27 15:25:33 -04:00
parent e341f48ece
commit 7028fec2a0
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 43 additions and 7 deletions

View file

@ -68,15 +68,32 @@ exception Bad_req = Bad_req
let fail_raise ~code fmt =
Printf.ksprintf (fun msg -> raise (Bad_req (code, msg))) fmt
let pp out self : unit =
let pp_body out = function
| `String s -> Format.fprintf out "%S" s
| `Stream _ -> Format.pp_print_string out "<stream>"
| `Writer _ -> Format.pp_print_string out "<writer>"
| `Void -> ()
let default_pp_body_ out = function
| `String s -> Format.fprintf out "%S" s
| `Stream _ -> Format.pp_print_string out "<stream>"
| `Writer _ -> Format.pp_print_string out "<writer>"
| `Void -> ()
let pp_with ?(mask_header = fun _ -> false)
?(headers_to_mask = [ "set-cookie" ]) ?(pp_body = default_pp_body_) () out
self : unit =
let headers_to_mask = List.rev_map String.lowercase_ascii headers_to_mask in
(* hide some headers *)
let headers =
List.map
(fun (k, v) ->
let hidden = List.mem k headers_to_mask || mask_header k in
if hidden then
k, "<hidden>"
else
k, v)
self.headers
in
Format.fprintf out "{@[code=%d;@ headers=[@[%a@]];@ body=%a@]}" self.code
Headers.pp self.headers pp_body self.body
Headers.pp headers pp_body self.body
let[@inline] pp out self : unit = pp_with () out self
let output_ ~bytes (oc : IO.Output.t) (self : t) : unit =
(* double indirection:

View file

@ -109,6 +109,25 @@ val fail_raise : code:int -> ('a, unit, string, 'b) format4 -> 'a
@raise Bad_req always
*)
val pp_with :
?mask_header:(string -> bool) ->
?headers_to_mask:string list ->
?pp_body:(Format.formatter -> body -> unit) ->
unit ->
Format.formatter ->
t ->
unit
(** Pretty print the response. The exact format of this printing
is not specified.
@param mask_header function which is given each header name. If it
returns [true], the header's value is masked. The presence of
the header is still printed. Default [fun _ -> false].
@param headers_to_mask a list of headers masked by default.
Default is ["set-cookie"].
@param pp_body body printer
(default fully prints String bodies, but omits stream bodies)
@since NEXT_RELEASE *)
val pp : Format.formatter -> t -> unit
(** Pretty print the response. The exact format is not specified. *)