From 84f3a147a7faa45b4b485c03fbe30af8ce45c557 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 13 Sep 2019 18:22:56 -0500 Subject: [PATCH] initial commit --- .gitignore | 9 +++ Makefile | 19 ++++++ dune-project | 1 + ezcurl.opam | 25 ++++++++ src/Ezcurl.ml | 156 +++++++++++++++++++++++++++++++++++++++++++++++++ src/Ezcurl.mli | 65 +++++++++++++++++++++ src/dune | 4 ++ 7 files changed, 279 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 dune-project create mode 100644 ezcurl.opam create mode 100644 src/Ezcurl.ml create mode 100644 src/Ezcurl.mli create mode 100644 src/dune diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..79d7328 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +.*.swp +_build +*.native +*.docdir +*.html +man/ +*.install +.merlin +.gh-pages diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..8800efe --- /dev/null +++ b/Makefile @@ -0,0 +1,19 @@ + +all: build test + +build: + @dune build @install + +test: + @dune runtest --no-buffer --force + +clean: + @dune clean + +doc: + @dune build @doc + +watch: + @dune build @install -w + +.PHONY: test watch diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..de4fc20 --- /dev/null +++ b/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/ezcurl.opam b/ezcurl.opam new file mode 100644 index 0000000..91062bf --- /dev/null +++ b/ezcurl.opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +name: "ezcurl" +version: "0.1" +authors: ["Simon Cruanes"] +maintainer: "simon.cruanes.2007@m4x.org" +license: "MIT" +synopsis: "Friendly wrapper around OCurl" +build: [ + ["dune" "build" "@install" "-p" name "-j" jobs] + ["dune" "build" "@doc" "-p" name] {with-doc} + ["dune" "runtest" "-p" name] {with-test} +] +depends: [ + "base-bytes" + "result" + "ocurl" + "dune" {build} + "odoc" {with-doc} + "ocaml" { >= "4.03.0" } +] +tags: [ "curl" "web" "http" "client" ] +homepage: "https://github.com/c-cube/ezcurl/" +doc: "https://c-cube.github.io/ezcurl/doc/1.2" +bug-reports: "https://github.com/c-cube/ezcurl/issues" +dev-repo: "git+https://github.com/c-cube/ezcurl.git" diff --git a/src/Ezcurl.ml b/src/Ezcurl.ml new file mode 100644 index 0000000..1c2ac75 --- /dev/null +++ b/src/Ezcurl.ml @@ -0,0 +1,156 @@ +type t = Curl.t + +let _init = lazy ( + Curl.global_init Curl.CURLINIT_GLOBALALL; + at_exit Curl.global_cleanup; +) + +let make ?(set_opts=fun _ -> ()) () : t = + Lazy.force _init; + let c = Curl.init () in + Gc.finalise Curl.cleanup c; + set_opts c; + c + +let delete = Curl.cleanup + +let with_client ?set_opts f = + let c = make ?set_opts () in + try + let x = f c in + delete c; + x + with e -> + delete c; + raise e + +type response_info = { + ri_response_time: float; + ri_redirect_count: int; +} + +type response = { + code: int; + headers: (string * string) list; + body: string; + info: response_info; +} + +exception Parse_error of Curl.curlCode * string + +let mk_res (self:t) headers body : (response,_) result = + let split_colon s = + match String.index s ':' with + | exception Not_found -> + raise (Parse_error (Curl.CURLE_CONV_FAILED, "header line without a ':': " ^ s)) + | i -> + String.sub s 0 i, + String.trim (String.sub s (i+1) (String.length s-i-1)) + in + try + let code = Curl.get_httpcode self in + let headers = + match headers with + | [] -> [] + | _ :: tl -> List.map split_colon tl (* first one is "http1.1 NNN " *) + in + let info = { + ri_redirect_count=Curl.get_redirectcount self; + ri_response_time=Curl.get_totaltime self; + } in + Ok {headers; code; body; info} + with Parse_error (e, msg) -> + Error (e, Curl.strerror e ^ ": " ^ msg) + +type meth = + | GET + | POST of Curl.curlHTTPPost list + | PUT + +let string_of_meth = function + | GET -> "GET" + | POST _ -> "POST" + | PUT -> "PUT" + +let opt_map ~f = function None -> None | Some x -> Some (f x) +let opt_iter ~f = function None -> () | Some x -> f x + +let http ?(verbose=false) ?(tries=1) + ?client ?authmethod ?(max_redirects=50) ?(follow_location=false) + ?username ?password ?(headers=[]) + ~url ~meth () : _ result = + let do_cleanup, self = match client with + | None -> true, make() + | Some c -> + Curl.reset c; + false, c + in + (* local state *) + let tries = max tries 1 in (* at least one attempt *) + let body = ref "" in + let resp_headers = ref [] in + let resp_headers_done = ref false in (* once we get "\r\n" header line *) + (* start setting options *) + Curl.set_url self url; + Curl.set_verbose self verbose; + Curl.set_maxredirs self max_redirects; + Curl.set_followlocation self follow_location; + Curl.set_header self false; + begin match meth with + | POST l -> Curl.set_httppost self l; + | GET -> Curl.set_httpget self true; + | PUT -> Curl.set_put self true; + end; + opt_iter authmethod ~f:(Curl.set_httpauth self); + opt_iter username ~f:(Curl.set_username self); + opt_iter password ~f:(Curl.set_password self); + let headers = + List.map (fun (k,v) -> k ^ ": " ^ v ^ "\r\n") headers + in + Curl.set_httpheader self headers; + Curl.set_headerfunction self + (fun s0 -> + let s = String.trim s0 in + (* Printf.printf "got header %S\n%!" s0; *) + if s0 = "\r\n" then ( + resp_headers_done := true; + ) else ( + (* redirection: drop previous headers *) + if !resp_headers_done then ( + resp_headers_done := false; + resp_headers := []; + ); + + resp_headers := s :: !resp_headers; + ); + String.length s0); + Curl.set_writefunction self + (fun s -> + body := (if !body = "" then s else !body ^ s); + String.length s); + let rec loop i = + match Curl.perform self with + | () -> + let r = mk_res self (List.rev !resp_headers) !body in + if do_cleanup then Curl.cleanup self; + r + | exception Curl.CurlException (Curl.CURLE_AGAIN, _, _) when i > 1 -> + (* another try *) + loop (i-1) + | exception Curl.CurlException (c, _, _) -> + if do_cleanup then Curl.cleanup self; + Error (c, Curl.strerror c) + in + loop tries + +let get ?verbose ?tries ?client ?authmethod ?max_redirects + ?follow_location + ?username ?password ?headers ~url () : _ result = + http ?verbose ?tries ?client ?authmethod ?max_redirects + ?follow_location + ?username ?password ?headers ~url ~meth:GET () + +(* TODO +let post ?verbose ?tries ?client ?auth ?username ?password ~url () : _ result = + call ?verbose ?tries ?client ?auth ?username ?password ~url ~meth:GET () + *) diff --git a/src/Ezcurl.mli b/src/Ezcurl.mli new file mode 100644 index 0000000..4705be3 --- /dev/null +++ b/src/Ezcurl.mli @@ -0,0 +1,65 @@ +type t + +val make : + ?set_opts:(Curl.t -> unit) -> + unit -> t + +val delete : t -> unit + +val with_client : + ?set_opts:(Curl.t -> unit) -> + (t -> 'a) -> 'a +(** Make a temporary client, call the function with it, then cleanup *) + +(* TODO: duphandle is deprecated, how do we iterate on options? +val copy : t -> t + *) + +type response_info = { + ri_response_time: float; + ri_redirect_count: int; +} + +type response = { + code: int; + headers: (string * string) list; + body: string; + info: response_info; +} + +type meth = + | GET + | POST of Curl.curlHTTPPost list + | PUT + +val string_of_meth : meth -> string + +val http : + ?verbose:bool -> + ?tries:int -> + ?client:t -> + ?authmethod:Curl.curlAuth list -> + ?max_redirects:int -> + ?follow_location:bool -> + ?username:string -> + ?password:string -> + ?headers:(string*string) list -> + url:string -> + meth:meth -> + unit -> + (response, Curl.curlCode * string) result + +val get : + ?verbose:bool -> + ?tries:int -> + ?client:t -> + ?authmethod:Curl.curlAuth list -> + ?max_redirects:int -> + ?follow_location:bool -> + ?username:string -> + ?password:string -> + ?headers:(string*string) list -> + url:string -> + unit -> + (response, Curl.curlCode * string) result + diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..56382a9 --- /dev/null +++ b/src/dune @@ -0,0 +1,4 @@ +(library + (name ezcurl) + (flags :standard -warn-error -32) + (libraries curl))