simon/ezcurl
1
0
Fork 0
mirror of https://github.com/c-cube/ezcurl.git synced 2025-12-06 03:05:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat ezcurl: wrap Curl.t in record; add cookie support

Browse source
This commit is contained in:
Simon Cruanes 2024-10-01 10:59:55 -04:00
parent 5b4b71ee15
commit a8ad44d39e
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 71 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
src/core/Ezcurl_core.ml
View file

@ -68,7 +68,7 @@ module Config = struct
let to_string s = Format.asprintf "%a" pp s let to_string s = Format.asprintf "%a" pp s
end end
type t = Curl.t type t = { curl: Curl.t } [@@unboxed]
let _init = let _init =
let initialized = ref false in let initialized = ref false in
@ -82,14 +82,21 @@ let _init =
); );
Mutex.unlock mutex Mutex.unlock mutex
let make ?(set_opts = fun _ -> ()) () : t = let make ?(set_opts = fun _ -> ()) ?cookiejar_file
?(enable_session_cookies = false) () : t =
_init (); _init ();
let c = Curl.init () in let curl = Curl.init () in
Gc.finalise Curl.cleanup c; Gc.finalise Curl.cleanup curl;
set_opts c; opt_iter cookiejar_file ~f:(fun file ->
c Curl.set_cookiejar curl file;
Curl.set_cookiefile curl file);
if enable_session_cookies then Curl.set_cookiefile curl "";
set_opts curl;
{ curl }
let delete = Curl.cleanup let delete (self : t) = Curl.cleanup self.curl
let reload_cookiejar (self : t) : unit = Curl.set_cookielist self.curl "RELOAD"
let flush_cookiejar (self : t) : unit = Curl.set_cookielist self.curl "FLUSH"
(* set options *) (* set options *)
let _apply_config (self : t) (config : Config.t) : unit = let _apply_config (self : t) (config : Config.t) : unit =
@ -104,18 +111,19 @@ let _apply_config (self : t) (config : Config.t) : unit =
} = } =
config config
in in
Curl.set_verbose self verbose; Curl.set_verbose self.curl verbose;
Curl.set_maxredirs self max_redirects; Curl.set_maxredirs self.curl max_redirects;
Curl.set_followlocation self follow_location; Curl.set_followlocation self.curl follow_location;
opt_iter user_agent ~f:(fun user_agent -> Curl.set_useragent self user_agent); opt_iter user_agent ~f:(fun user_agent ->
opt_iter authmethod ~f:(Curl.set_httpauth self); Curl.set_useragent self.curl user_agent);
opt_iter username ~f:(Curl.set_username self); opt_iter authmethod ~f:(Curl.set_httpauth self.curl);
opt_iter password ~f:(Curl.set_password self); opt_iter username ~f:(Curl.set_username self.curl);
opt_iter password ~f:(Curl.set_password self.curl);
() ()
let _set_headers (self : t) (headers : _ list) : unit = let _set_headers (self : t) (headers : _ list) : unit =
let headers = List.map (fun (k, v) -> k ^ ": " ^ v) headers in let headers = List.map (fun (k, v) -> k ^ ": " ^ v) headers in
Curl.set_httpheader self headers; Curl.set_httpheader self.curl headers;
() ()
let with_client ?set_opts f = let with_client ?set_opts f =
@ -280,7 +288,7 @@ let mk_res (self : t) headers body : (response, _) result =
String.trim (String.sub s (i + 1) (String.length s - i - 1)) ) String.trim (String.sub s (i + 1) (String.length s - i - 1)) )
in in
try try
let code = Curl.get_httpcode self in let code = Curl.get_httpcode self.curl in
let headers = let headers =
match headers with match headers with
| [] -> [] | [] -> []
@ -289,8 +297,8 @@ let mk_res (self : t) headers body : (response, _) result =
in in
let info = let info =
{ {
ri_redirect_count = Curl.get_redirectcount self; ri_redirect_count = Curl.get_redirectcount self.curl;
ri_response_time = Curl.get_totaltime self; ri_response_time = Curl.get_totaltime self.curl;
} }
in in
Ok { headers; code; body; info } Ok { headers; code; body; info }
@ -330,18 +338,18 @@ module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
| Some c -> false, c | Some c -> false, c
in in
_apply_config self config; _apply_config self config;
opt_iter range ~f:(fun s -> Curl.set_range self s); opt_iter range ~f:(fun s -> Curl.set_range self.curl s);
(* TODO: ability to make content a stream with a `read` function *) (* TODO: ability to make content a stream with a `read` function *)
opt_iter content ~f:(fun content -> opt_iter content ~f:(fun content ->
Curl.set_readfunction self (content_read_fun_ content); Curl.set_readfunction self.curl (content_read_fun_ content);
(* also set size if known *) (* also set size if known *)
match content_size_ content, meth with match content_size_ content, meth with
| None, _ -> | None, _ ->
headers := headers :=
("expect", "") :: ("transfer-encoding", "chunked") :: !headers ("expect", "") :: ("transfer-encoding", "chunked") :: !headers
| Some size, POST _ -> Curl.set_postfieldsize self size | Some size, POST _ -> Curl.set_postfieldsize self.curl size
| Some size, _ -> Curl.set_infilesize self size); | Some size, _ -> Curl.set_infilesize self.curl size);
(* local state *) (* local state *)
let tries = max tries 1 in let tries = max tries 1 in
@ -350,23 +358,23 @@ module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
let resp_headers = ref [] in let resp_headers = ref [] in
let resp_headers_done = ref false in let resp_headers_done = ref false in
(* once we get "\r\n" header line *) (* once we get "\r\n" header line *)
Curl.set_url self url; Curl.set_url self.curl url;
(match meth with (match meth with
| POST [] when content <> None -> Curl.set_post self true | POST [] when content <> None -> Curl.set_post self.curl true
| POST l -> Curl.set_httppost self l | POST l -> Curl.set_httppost self.curl l
| GET -> Curl.set_httpget self true | GET -> Curl.set_httpget self.curl true
| PUT -> | PUT ->
Curl.set_customrequest self "PUT"; Curl.set_customrequest self.curl "PUT";
Curl.set_upload self true Curl.set_upload self.curl true
| DELETE -> Curl.set_customrequest self "DELETE" | DELETE -> Curl.set_customrequest self.curl "DELETE"
| HEAD -> Curl.set_customrequest self "HEAD" | HEAD -> Curl.set_customrequest self.curl "HEAD"
| CONNECT -> Curl.set_customrequest self "CONNECT" | CONNECT -> Curl.set_customrequest self.curl "CONNECT"
| OPTIONS -> Curl.set_customrequest self "OPTIONS" | OPTIONS -> Curl.set_customrequest self.curl "OPTIONS"
| TRACE -> Curl.set_customrequest self "TRACE" | TRACE -> Curl.set_customrequest self.curl "TRACE"
| PATCH -> Curl.set_customrequest self "PATCH"); | PATCH -> Curl.set_customrequest self.curl "PATCH");
_set_headers self !headers; _set_headers self !headers;
Curl.set_headerfunction self (fun s0 -> Curl.set_headerfunction self.curl (fun s0 ->
let s = String.trim s0 in let s = String.trim s0 in
(* Printf.printf "got header %S\n%!" s0; *) (* Printf.printf "got header %S\n%!" s0; *)
if s0 = "\r\n" then if s0 = "\r\n" then
@ -381,18 +389,18 @@ module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
resp_headers := s :: !resp_headers resp_headers := s :: !resp_headers
); );
String.length s0); String.length s0);
Curl.set_writefunction self (fun s -> Curl.set_writefunction self.curl (fun s ->
Buffer.add_string body s; Buffer.add_string body s;
String.length s); String.length s);
let rec loop i = let rec loop i =
IO.perform self >>= function IO.perform self.curl >>= function
| Curl.CURLE_OK -> | Curl.CURLE_OK ->
let r = mk_res self (List.rev !resp_headers) (Buffer.contents body) in let r = mk_res self (List.rev !resp_headers) (Buffer.contents body) in
if do_cleanup then Curl.cleanup self; if do_cleanup then Curl.cleanup self.curl;
return r return r
| Curl.CURLE_AGAIN when i > 1 -> loop (i - 1) (* try again *) | Curl.CURLE_AGAIN when i > 1 -> loop (i - 1) (* try again *)
| c -> | c ->
if do_cleanup then Curl.cleanup self; if do_cleanup then Curl.cleanup self.curl;
return (Error (c, Curl.strerror c)) return (Error (c, Curl.strerror c))
in in
loop tries loop tries

29
src/core/Ezcurl_core.mli
View file

@ -15,19 +15,38 @@ module Config : sig
val to_string : t -> string val to_string : t -> string
end end
type t = Curl.t type t = private { curl: Curl.t } [@@unboxed]
(** A client, i.e. a cURL instance. *) (** A client, i.e. a cURL instance.
The wrapping record has been present since NEXT_RELEASE *)
val make : ?set_opts:(t -> unit) -> unit -> t val make :
?set_opts:(Curl.t -> unit) ->
?cookiejar_file:string ->
?enable_session_cookies:bool ->
unit ->
t
(** Create a new client. (** Create a new client.
@param set_opts called before returning the client, to set options *) @param set_opts called before returning the client, to set options
@param cookiejar_file if provided, tell curl to use the given file path to store/load cookies (since NEXT_RELEASE)
@param enable_session_cookies if provided, enable cookie handling in curl so it store/load cookies (since NEXT_RELEASE)
*)
val delete : t -> unit val delete : t -> unit
(** Delete the client. It cannot be used anymore. *) (** Delete the client. It cannot be used anymore. *)
val with_client : ?set_opts:(t -> unit) -> (t -> 'a) -> 'a val with_client : ?set_opts:(Curl.t -> unit) -> (t -> 'a) -> 'a
(** Make a temporary client, call the function with it, then cleanup. *) (** Make a temporary client, call the function with it, then cleanup. *)
val flush_cookiejar : t -> unit
(** If [cookiejar_file] was provided in {!make}, this flushes the current set of cookies
to the provided file.
@since NEXT_RELEASE *)
val reload_cookiejar : t -> unit
(** If [cookiejar_file] was provided in {!make}, this reloads cookies from
the provided file.
@since NEXT_RELEASE *)
(* TODO: duphandle is deprecated, how do we iterate on options? (* TODO: duphandle is deprecated, how do we iterate on options?
val copy : t -> t val copy : t -> t
*) *)