cohttp_curl: First HTTP header is prepended to output

[ScoreUnder]

Example:

let testfun () =
  let url = "https://httpbin.org/status/200" in
  let headers = [ ("Test-header", "this should not appear in output"); ("Content-Type", "application/json") ] in
  let body = "[\"post body\"]" in
  let request =
    Cohttp_curl_lwt.Request.create
      ~headers:(Http.Header.of_list headers)
      `POST ~uri:url
      ~input:(Cohttp_curl_lwt.Source.string body)
      ~output:Cohttp_curl_lwt.Sink.string
  in
  let context = Cohttp_curl_lwt.Context.create () in
  let cohttp_response = Cohttp_curl_lwt.submit context request in
  let response_body = Cohttp_curl_lwt.Response.body cohttp_response in
  let open Lwt.Syntax in
  let+ response_body = response_body in
  print_endline response_body

let () =
  Lwt_main.run (testfun ())

The code here should just return the empty body that the URL usually gives, but instead it gives the first header. Similarly, https://httpbin.org/post is supposed to give you valid JSON, but here the header is prepended so it doesn't.

A glance at the code in cohttp_curl.ml shows that a Buffer called buf is created and shared between both the header formatting step and the output reading step:

ocaml-cohttp/cohttp-curl/src/cohttp_curl.ml

Lines 56 to 126 in b7182a1

	let buf = Buffer.create 128 in
	Curl.setopt h (CURLOPT_URL uri);
	Curl.setopt h (CURLOPT_CUSTOMREQUEST (Http.Method.to_string method_));
	let () =
	match headers with
	| None -> ()
	| Some headers ->
	let headers =
	Http.Header.fold
	(fun key value acc ->
	Buffer.clear buf;
	Buffer.add_string buf key;
	Buffer.add_string buf ": ";
	Buffer.add_string buf value;
	Buffer.contents buf :: acc)
	headers []
	|> List.rev
	in
	Curl.setopt h (CURLOPT_HTTPHEADER headers)
	in
	Curl.setopt h
	(CURLOPT_HEADERFUNCTION
	(let status_code_ready = ref false in
	let response_http_version = ref None in
	fun header ->
	(match !status_code_ready with
	| false ->
	(match String.split_on_char ' ' header with
	| v :: _ ->
	response_http_version := Some (Http.Version.of_string v)
	| _ -> (* TODO *) invalid_arg "invalid request");
	status_code_ready := true
	| true -> (
	match header with
	| "\r\n" ->
	let response =
	let headers =
	Http.Header.of_list_rev !response_header_acc
	in
	response_header_acc := [];
	let status =
	match Curl.getinfo h CURLINFO_HTTP_CODE with
	| CURLINFO_Long l -> Http.Status.of_int l
	| _ -> assert false
	in
	let version =
	match !response_http_version with
	| None -> assert false
	| Some v -> v
	in
	Http.Response.make ~version ~status ~headers ()
	in
	on_response response
	| _ ->
	let k, v =
	match Stringext.cut header ~on:":" with
	| None -> invalid_arg "proper abort needed"
	| Some (k, v) -> (String.trim k, String.trim v)
	in
	response_header_acc := (k, v) :: !response_header_acc));
	String.length header));
	Curl.setopt h (CURLOPT_READFUNCTION (Source.to_curl_callback input));
	Curl.setopt h
	(CURLOPT_WRITEFUNCTION
	(match output with
	| Discard -> fun s -> String.length s
	| String ->
	response_body := Some buf;
	fun s ->
	Buffer.add_string buf s;
	String.length s));

However the buffer is not cleared between these two steps, meaning whichever header it processed last is still in the buffer before it starts getting data from curl.

[rgrinberg]

Do you want to send a PR? Using two different buffers should be enough.