mirror of
https://github.com/c-cube/ezcurl.git
synced 2025-12-15 07:16:15 -05:00
Compare commits
16 commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a0a5b989b7 | ||
|
|
27b3ca76c8 | ||
|
|
4b7d9ec769 | ||
|
|
ebf1e1fc12 | ||
|
|
742e51df97 | ||
|
|
0faaf35969 | ||
|
|
012016f9b4 | ||
|
|
49b265ce56 | ||
|
|
fbd71baa19 | ||
|
|
d50a53ebda | ||
|
|
e97003644a | ||
|
|
48d18bd912 | ||
|
|
71a37788ac | ||
|
|
a8ad44d39e | ||
|
|
5b4b71ee15 | ||
|
|
7c684f1869 |
15 changed files with 442 additions and 136 deletions
4
.github/workflows/gh-pages.yml
vendored
4
.github/workflows/gh-pages.yml
vendored
|
|
@ -18,9 +18,9 @@ jobs:
|
|||
path: ~/.opam
|
||||
key: opam-ubuntu-latest-4.12.0
|
||||
|
||||
- uses: ocaml/setup-ocaml@v2
|
||||
- uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: '5.0.x'
|
||||
ocaml-compiler: '5.03'
|
||||
|
||||
- name: Pin
|
||||
run: opam pin -n .
|
||||
|
|
|
|||
13
.github/workflows/main.yml
vendored
13
.github/workflows/main.yml
vendored
|
|
@ -2,10 +2,10 @@ name: build
|
|||
on:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
- main
|
||||
pull_request:
|
||||
branches:
|
||||
- master
|
||||
- main
|
||||
jobs:
|
||||
run:
|
||||
name: Build
|
||||
|
|
@ -16,16 +16,17 @@ jobs:
|
|||
# - macos-latest # build issues with `ar` (!!!)
|
||||
#- windows-latest # certificate problem
|
||||
ocaml-compiler:
|
||||
- 4.03.x
|
||||
- 4.12.x
|
||||
- '4.08'
|
||||
- '4.14'
|
||||
- '5.3'
|
||||
runs-on: ${{ matrix.os }}
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- uses: ocaml/setup-ocaml@v2
|
||||
- uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
||||
- run: opam pin -n .
|
||||
- run: opam depext -yt ezcurl ezcurl-lwt
|
||||
- run: opam install -t . --deps-only
|
||||
- run: opam exec -- dune build
|
||||
- run: opam exec -- dune build @install
|
||||
- run: opam exec -- dune runtest
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
version = 0.24.1
|
||||
version = 0.26.2
|
||||
profile=conventional
|
||||
margin=80
|
||||
if-then-else=k-r
|
||||
|
|
|
|||
12
Makefile
12
Makefile
|
|
@ -7,6 +7,9 @@ build:
|
|||
test:
|
||||
@dune runtest --no-buffer --force
|
||||
|
||||
test-autopromote:
|
||||
@dune runtest --no-buffer --force --auto-promote
|
||||
|
||||
clean:
|
||||
@dune clean
|
||||
|
||||
|
|
@ -17,4 +20,11 @@ WATCH?= @install @runtest
|
|||
watch:
|
||||
@dune build $(WATCH )-w
|
||||
|
||||
.PHONY: all build test watch
|
||||
VERSION=$(shell awk '/^version:/ {print $$2}' ezcurl.opam)
|
||||
|
||||
update_next_tag:
|
||||
@echo "update version to $(VERSION)..."
|
||||
sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
|
||||
sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
|
||||
|
||||
.PHONY: all build test watch update_next_tag
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
# EZCurl [](https://github.com/c-cube/ezcurl/actions/workflows/main.yml)
|
||||
|
||||
A simple wrapper around OCurl, for easy tasks around http.
|
||||
A simple wrapper around [OCurl](https://github.com/ygrek/ocurl/), for easy tasks around http.
|
||||
|
||||
**project goals**
|
||||
|
||||
|
|
@ -33,7 +33,7 @@ val url : string = "https://curl.haxx.se/"
|
|||
# let res = Ezcurl.get ~url ();;
|
||||
...
|
||||
# let content = match res with Ok c -> c | Error (_,s) -> failwith s;;
|
||||
val content : Ezcurl_core.response =
|
||||
val content : string Ezcurl_core.response =
|
||||
...
|
||||
|
||||
# content.Ezcurl.code;;
|
||||
|
|
|
|||
4
dune
4
dune
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
(alias
|
||||
(name runtest)
|
||||
(rule
|
||||
(alias runtest)
|
||||
(package ezcurl-lwt)
|
||||
(deps (:file README.md))
|
||||
(action
|
||||
|
|
|
|||
40
dune-project
40
dune-project
|
|
@ -1,3 +1,41 @@
|
|||
(lang dune 1.0)
|
||||
(lang dune 3.0)
|
||||
|
||||
(name ezcurl)
|
||||
|
||||
(version 0.2.4)
|
||||
|
||||
(generate_opam_files true)
|
||||
|
||||
(license MIT)
|
||||
|
||||
(maintainers "simon.cruanes.2007@m4x.org")
|
||||
|
||||
(authors "Simon Cruanes")
|
||||
(source (github c-cube/ezcurl))
|
||||
(documentation https://c-cube.github.io/ezcurl/)
|
||||
|
||||
(package
|
||||
(name ezcurl)
|
||||
(synopsis "Friendly wrapper around OCurl")
|
||||
(tags
|
||||
("curl" "web" "http" "client"))
|
||||
(depends
|
||||
(ocurl
|
||||
(>= 0.8))
|
||||
(odoc :with-doc)
|
||||
(ocaml
|
||||
(>= 4.03))))
|
||||
|
||||
(package
|
||||
(name ezcurl-lwt)
|
||||
(synopsis "Friendly wrapper around OCurl, Lwt version")
|
||||
(tags
|
||||
("curl" "web" "http" "client" "lwt"))
|
||||
(depends
|
||||
(ezcurl
|
||||
(= :version))
|
||||
lwt
|
||||
(mdx :with-test)
|
||||
(odoc :with-doc)
|
||||
(ocaml
|
||||
(>= 4.03))))
|
||||
|
|
|
|||
|
|
@ -1,26 +1,34 @@
|
|||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
name: "ezcurl-lwt"
|
||||
version: "0.2.4"
|
||||
authors: ["Simon Cruanes"]
|
||||
maintainer: "simon.cruanes.2007@m4x.org"
|
||||
license: "MIT"
|
||||
synopsis: "Friendly wrapper around OCurl, Lwt version"
|
||||
build: [
|
||||
["dune" "build" "@install" "-p" name "-j" jobs]
|
||||
["dune" "build" "@doc" "-p" name] {with-doc}
|
||||
#["dune" "runtest" "-p" name] {with-test}
|
||||
]
|
||||
depends: [
|
||||
"ocurl" {>= "0.8.0"}
|
||||
"ezcurl" { = version }
|
||||
"lwt"
|
||||
"dune" { >= "1.0" }
|
||||
"odoc" {with-doc}
|
||||
"mdx" {with-test}
|
||||
"ocaml" { >= "4.03.0" }
|
||||
]
|
||||
tags: [ "curl" "web" "http" "client" "lwt" ]
|
||||
homepage: "https://github.com/c-cube/ezcurl/"
|
||||
doc: "https://c-cube.github.io/ezcurl/doc/1.2"
|
||||
maintainer: ["simon.cruanes.2007@m4x.org"]
|
||||
authors: ["Simon Cruanes"]
|
||||
license: "MIT"
|
||||
tags: ["curl" "web" "http" "client" "lwt"]
|
||||
homepage: "https://github.com/c-cube/ezcurl"
|
||||
doc: "https://c-cube.github.io/ezcurl/"
|
||||
bug-reports: "https://github.com/c-cube/ezcurl/issues"
|
||||
depends: [
|
||||
"dune" {>= "3.0"}
|
||||
"ezcurl" {= version}
|
||||
"lwt"
|
||||
"mdx" {with-test}
|
||||
"odoc" {with-doc}
|
||||
"ocaml" {>= "4.03"}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "git+https://github.com/c-cube/ezcurl.git"
|
||||
|
|
|
|||
45
ezcurl.opam
45
ezcurl.opam
|
|
@ -1,23 +1,32 @@
|
|||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
name: "ezcurl"
|
||||
version: "0.2.4"
|
||||
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: [
|
||||
"ocurl" {>= "0.8.0"}
|
||||
"dune" { >= "1.0" }
|
||||
"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"
|
||||
maintainer: ["simon.cruanes.2007@m4x.org"]
|
||||
authors: ["Simon Cruanes"]
|
||||
license: "MIT"
|
||||
tags: ["curl" "web" "http" "client"]
|
||||
homepage: "https://github.com/c-cube/ezcurl"
|
||||
doc: "https://c-cube.github.io/ezcurl/"
|
||||
bug-reports: "https://github.com/c-cube/ezcurl/issues"
|
||||
depends: [
|
||||
"dune" {>= "3.0"}
|
||||
"ocurl" {>= "0.8"}
|
||||
"odoc" {with-doc}
|
||||
"ocaml" {>= "4.03"}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "git+https://github.com/c-cube/ezcurl.git"
|
||||
|
|
|
|||
|
|
@ -68,28 +68,60 @@ module Config = struct
|
|||
let to_string s = Format.asprintf "%a" pp s
|
||||
end
|
||||
|
||||
type t = Curl.t
|
||||
type t = { curl: Curl.t } [@@unboxed]
|
||||
type client = t
|
||||
|
||||
let _top_mutex = Mutex.create ()
|
||||
|
||||
let _with_mutex f =
|
||||
Mutex.lock _top_mutex;
|
||||
match f () with
|
||||
| res ->
|
||||
Mutex.unlock _top_mutex;
|
||||
res
|
||||
| exception e ->
|
||||
Mutex.unlock _top_mutex;
|
||||
raise e
|
||||
|
||||
let _init =
|
||||
let initialized = ref false in
|
||||
let mutex = Mutex.create () in
|
||||
fun () ->
|
||||
Mutex.lock mutex;
|
||||
_with_mutex @@ fun () ->
|
||||
if not !initialized then (
|
||||
initialized := true;
|
||||
Curl.global_init Curl.CURLINIT_GLOBALALL;
|
||||
at_exit Curl.global_cleanup
|
||||
);
|
||||
Mutex.unlock mutex
|
||||
)
|
||||
|
||||
let make ?(set_opts = fun _ -> ()) () : t =
|
||||
let make ?(set_opts = fun _ -> ()) ?cookiejar_file
|
||||
?(enable_session_cookies = false) () : t =
|
||||
_init ();
|
||||
let c = Curl.init () in
|
||||
Gc.finalise Curl.cleanup c;
|
||||
set_opts c;
|
||||
c
|
||||
let curl = Curl.init () in
|
||||
Gc.finalise Curl.cleanup curl;
|
||||
opt_iter cookiejar_file ~f:(fun file ->
|
||||
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 _cfg_no_signal = ref false (* default: 0 *)
|
||||
let _get_no_signal () : bool = _with_mutex @@ fun () -> !_cfg_no_signal
|
||||
let set_no_signal v = _with_mutex @@ fun () -> _cfg_no_signal := v
|
||||
|
||||
module Cookies = struct
|
||||
let reload_cookiejar (self : t) : unit =
|
||||
Curl.set_cookielist self.curl "RELOAD"
|
||||
|
||||
let flush_cookiejar (self : t) : unit = Curl.set_cookielist self.curl "FLUSH"
|
||||
let get_cookies self = Curl.get_cookielist self.curl
|
||||
|
||||
let set_cookies self (l : string list) =
|
||||
List.iter (Curl.set_cookielist self.curl) l
|
||||
|
||||
let transfer c1 c2 = set_cookies c2 @@ get_cookies c1
|
||||
end
|
||||
|
||||
(* set options *)
|
||||
let _apply_config (self : t) (config : Config.t) : unit =
|
||||
|
|
@ -104,18 +136,20 @@ let _apply_config (self : t) (config : Config.t) : unit =
|
|||
} =
|
||||
config
|
||||
in
|
||||
Curl.set_verbose self verbose;
|
||||
Curl.set_maxredirs self max_redirects;
|
||||
Curl.set_followlocation self follow_location;
|
||||
opt_iter user_agent ~f:(fun user_agent -> Curl.set_useragent self user_agent);
|
||||
opt_iter authmethod ~f:(Curl.set_httpauth self);
|
||||
opt_iter username ~f:(Curl.set_username self);
|
||||
opt_iter password ~f:(Curl.set_password self);
|
||||
Curl.set_verbose self.curl verbose;
|
||||
Curl.set_maxredirs self.curl max_redirects;
|
||||
Curl.set_followlocation self.curl follow_location;
|
||||
opt_iter user_agent ~f:(fun user_agent ->
|
||||
Curl.set_useragent self.curl user_agent);
|
||||
opt_iter authmethod ~f:(Curl.set_httpauth self.curl);
|
||||
opt_iter username ~f:(Curl.set_username self.curl);
|
||||
opt_iter password ~f:(Curl.set_password self.curl);
|
||||
Curl.set_nosignal self.curl (_get_no_signal ());
|
||||
()
|
||||
|
||||
let _set_headers (self : t) (headers : _ list) : unit =
|
||||
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 =
|
||||
|
|
@ -140,22 +174,23 @@ let pp_response_info out r =
|
|||
|
||||
let string_of_response_info s = Format.asprintf "%a" pp_response_info s
|
||||
|
||||
type response = {
|
||||
type 'body response = {
|
||||
code: int;
|
||||
headers: (string * string) list;
|
||||
body: string;
|
||||
body: 'body;
|
||||
info: response_info;
|
||||
}
|
||||
|
||||
let pp_response out r =
|
||||
let pp_response_with ppbody out r =
|
||||
let pp_header out (s1, s2) = Format.fprintf out "@[<2>%s:@ %s@]" s1 s2 in
|
||||
let pp_headers out l =
|
||||
Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_header) l
|
||||
in
|
||||
let { code; body; headers; info } = r in
|
||||
Format.fprintf out "{@[code=%d;@ headers=@[%a@];@ info=%a;@ body=@[%a@]@]}"
|
||||
code pp_headers headers pp_response_info info Format.pp_print_text body
|
||||
code pp_headers headers pp_response_info info ppbody body
|
||||
|
||||
let pp_response = pp_response_with Format.pp_print_text
|
||||
let string_of_response s = Format.asprintf "%a" pp_response s
|
||||
|
||||
type meth =
|
||||
|
|
@ -205,7 +240,7 @@ module type S = sig
|
|||
url:string ->
|
||||
meth:meth ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** General purpose HTTP call via cURL.
|
||||
@param url the URL to query
|
||||
@param meth which method to use (see {!meth})
|
||||
|
|
@ -226,6 +261,28 @@ module type S = sig
|
|||
@param headers headers of the query
|
||||
*)
|
||||
|
||||
(** Push-stream of bytes
|
||||
@since NEXT_RELEASE *)
|
||||
class type input_stream = object
|
||||
method on_close : unit -> unit
|
||||
method on_input : bytes -> int -> int -> unit
|
||||
end
|
||||
|
||||
val http_stream :
|
||||
?tries:int ->
|
||||
?client:t ->
|
||||
?config:Config.t ->
|
||||
?range:string ->
|
||||
?content:[ `String of string | `Write of bytes -> int -> int ] ->
|
||||
?headers:(string * string) list ->
|
||||
url:string ->
|
||||
meth:meth ->
|
||||
write_into:#input_stream ->
|
||||
unit ->
|
||||
(unit response, Curl.curlCode * string) result io
|
||||
(** HTTP call via cURL, with a streaming response body.
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
val get :
|
||||
?tries:int ->
|
||||
?client:t ->
|
||||
|
|
@ -234,7 +291,7 @@ module type S = sig
|
|||
?headers:(string * string) list ->
|
||||
url:string ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:GET]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
|
|
@ -247,7 +304,7 @@ module type S = sig
|
|||
url:string ->
|
||||
content:[ `String of string | `Write of bytes -> int -> int ] ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:PUT]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
|
|
@ -261,7 +318,7 @@ module type S = sig
|
|||
params:Curl.curlHTTPPost list ->
|
||||
url:string ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:(POST params)]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
|
|
@ -269,7 +326,7 @@ end
|
|||
|
||||
exception Parse_error of Curl.curlCode * string
|
||||
|
||||
let mk_res (self : t) headers body : (response, _) result =
|
||||
let mk_res (self : t) headers body : (_ response, _) result =
|
||||
let split_colon s =
|
||||
match String.index s ':' with
|
||||
| exception Not_found ->
|
||||
|
|
@ -280,7 +337,7 @@ let mk_res (self : t) headers body : (response, _) result =
|
|||
String.trim (String.sub s (i + 1) (String.length s - i - 1)) )
|
||||
in
|
||||
try
|
||||
let code = Curl.get_httpcode self in
|
||||
let code = Curl.get_httpcode self.curl in
|
||||
let headers =
|
||||
match headers with
|
||||
| [] -> []
|
||||
|
|
@ -289,8 +346,8 @@ let mk_res (self : t) headers body : (response, _) result =
|
|||
in
|
||||
let info =
|
||||
{
|
||||
ri_redirect_count = Curl.get_redirectcount self;
|
||||
ri_response_time = Curl.get_totaltime self;
|
||||
ri_redirect_count = Curl.get_redirectcount self.curl;
|
||||
ri_response_time = Curl.get_totaltime self.curl;
|
||||
}
|
||||
in
|
||||
Ok { headers; code; body; info }
|
||||
|
|
@ -321,8 +378,20 @@ module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
|
|||
| `String s -> Some (String.length s)
|
||||
| `Write _ -> None
|
||||
|
||||
let http ?(tries = 1) ?client ?(config = Config.default) ?range ?content
|
||||
?(headers = []) ~url ~meth () : _ result io =
|
||||
class type input_stream = object
|
||||
method on_close : unit -> unit
|
||||
method on_input : bytes -> int -> int -> unit
|
||||
end
|
||||
|
||||
type http_state_ = {
|
||||
client: client;
|
||||
do_cleanup: bool;
|
||||
mutable resp_headers: string list;
|
||||
mutable resp_headers_done: bool;
|
||||
}
|
||||
|
||||
let http_setup_ ?client ?(config = Config.default) ?range ?content
|
||||
?(headers = []) ~url ~meth () : http_state_ =
|
||||
let headers = ref headers in
|
||||
let do_cleanup, self =
|
||||
match client with
|
||||
|
|
@ -330,69 +399,115 @@ module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
|
|||
| Some c -> false, c
|
||||
in
|
||||
_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 *)
|
||||
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 *)
|
||||
match content_size_ content, meth with
|
||||
| None, _ ->
|
||||
headers :=
|
||||
("expect", "") :: ("transfer-encoding", "chunked") :: !headers
|
||||
| Some size, POST _ -> Curl.set_postfieldsize self size
|
||||
| Some size, _ -> Curl.set_infilesize self size);
|
||||
| Some size, POST _ -> Curl.set_postfieldsize self.curl size
|
||||
| Some size, _ -> Curl.set_infilesize self.curl size);
|
||||
|
||||
(* local state *)
|
||||
let tries = max tries 1 in
|
||||
(* at least one attempt *)
|
||||
let body = Buffer.create 64 in
|
||||
let resp_headers = ref [] in
|
||||
let resp_headers_done = ref false in
|
||||
let st =
|
||||
{
|
||||
do_cleanup;
|
||||
client = self;
|
||||
resp_headers = [];
|
||||
resp_headers_done = false;
|
||||
}
|
||||
in
|
||||
|
||||
(* once we get "\r\n" header line *)
|
||||
Curl.set_url self url;
|
||||
Curl.set_url self.curl url;
|
||||
(match meth with
|
||||
| POST [] when content <> None -> Curl.set_post self true
|
||||
| POST l -> Curl.set_httppost self l
|
||||
| GET -> Curl.set_httpget self true
|
||||
| POST [] when content <> None -> Curl.set_post self.curl true
|
||||
| POST l -> Curl.set_httppost self.curl l
|
||||
| GET -> Curl.set_httpget self.curl true
|
||||
| PUT ->
|
||||
Curl.set_customrequest self "PUT";
|
||||
Curl.set_upload self true
|
||||
| DELETE -> Curl.set_customrequest self "DELETE"
|
||||
| HEAD -> Curl.set_customrequest self "HEAD"
|
||||
| CONNECT -> Curl.set_customrequest self "CONNECT"
|
||||
| OPTIONS -> Curl.set_customrequest self "OPTIONS"
|
||||
| TRACE -> Curl.set_customrequest self "TRACE"
|
||||
| PATCH -> Curl.set_customrequest self "PATCH");
|
||||
Curl.set_customrequest self.curl "PUT";
|
||||
Curl.set_upload self.curl true
|
||||
| DELETE -> Curl.set_customrequest self.curl "DELETE"
|
||||
| HEAD -> Curl.set_customrequest self.curl "HEAD"
|
||||
| CONNECT -> Curl.set_customrequest self.curl "CONNECT"
|
||||
| OPTIONS -> Curl.set_customrequest self.curl "OPTIONS"
|
||||
| TRACE -> Curl.set_customrequest self.curl "TRACE"
|
||||
| PATCH -> Curl.set_customrequest self.curl "PATCH");
|
||||
|
||||
_set_headers self !headers;
|
||||
Curl.set_headerfunction self (fun s0 ->
|
||||
Curl.set_headerfunction self.curl (fun s0 ->
|
||||
let s = String.trim s0 in
|
||||
(* Printf.printf "got header %S\n%!" s0; *)
|
||||
if s0 = "\r\n" then
|
||||
resp_headers_done := true
|
||||
st.resp_headers_done <- true
|
||||
else (
|
||||
(* redirection: drop previous headers *)
|
||||
if !resp_headers_done then (
|
||||
resp_headers_done := false;
|
||||
resp_headers := []
|
||||
if st.resp_headers_done then (
|
||||
st.resp_headers_done <- false;
|
||||
st.resp_headers <- []
|
||||
);
|
||||
|
||||
resp_headers := s :: !resp_headers
|
||||
st.resp_headers <- s :: st.resp_headers
|
||||
);
|
||||
String.length s0);
|
||||
Curl.set_writefunction self (fun s ->
|
||||
|
||||
st
|
||||
|
||||
let http ?(tries = 1) ?client ?config ?range ?content ?headers ~url ~meth () :
|
||||
(string response, _) result io =
|
||||
(* at least one attempt *)
|
||||
let tries = max tries 1 in
|
||||
let st =
|
||||
http_setup_ ?client ?config ?range ?content ?headers ~url ~meth ()
|
||||
in
|
||||
|
||||
let body = Buffer.create 64 in
|
||||
Curl.set_writefunction st.client.curl (fun s ->
|
||||
Buffer.add_string body s;
|
||||
String.length s);
|
||||
|
||||
let rec loop i =
|
||||
IO.perform self >>= function
|
||||
IO.perform st.client.curl >>= function
|
||||
| Curl.CURLE_OK ->
|
||||
let r = mk_res self (List.rev !resp_headers) (Buffer.contents body) in
|
||||
if do_cleanup then Curl.cleanup self;
|
||||
let r =
|
||||
mk_res st.client (List.rev st.resp_headers) (Buffer.contents body)
|
||||
in
|
||||
if st.do_cleanup then Curl.cleanup st.client.curl;
|
||||
return r
|
||||
| Curl.CURLE_AGAIN when i > 1 -> loop (i - 1) (* try again *)
|
||||
| c ->
|
||||
if do_cleanup then Curl.cleanup self;
|
||||
if st.do_cleanup then Curl.cleanup st.client.curl;
|
||||
return (Error (c, Curl.strerror c))
|
||||
in
|
||||
loop tries
|
||||
|
||||
let http_stream ?(tries = 1) ?client ?config ?range ?content ?headers ~url
|
||||
~meth ~(write_into : #input_stream) () : (unit response, _) result io =
|
||||
let tries = max tries 1 in
|
||||
let st =
|
||||
http_setup_ ?client ?config ?range ?content ?headers ~url ~meth ()
|
||||
in
|
||||
|
||||
Curl.set_writefunction st.client.curl (fun s ->
|
||||
let n = String.length s in
|
||||
write_into#on_input (Bytes.unsafe_of_string s) 0 n;
|
||||
n);
|
||||
|
||||
let rec loop i =
|
||||
IO.perform st.client.curl >>= function
|
||||
| Curl.CURLE_OK ->
|
||||
let r = mk_res st.client (List.rev st.resp_headers) () in
|
||||
write_into#on_close ();
|
||||
if st.do_cleanup then Curl.cleanup st.client.curl;
|
||||
return r
|
||||
| Curl.CURLE_AGAIN when i > 1 -> loop (i - 1) (* try again *)
|
||||
| c ->
|
||||
write_into#on_close ();
|
||||
if st.do_cleanup then Curl.cleanup st.client.curl;
|
||||
return (Error (c, Curl.strerror c))
|
||||
in
|
||||
loop tries
|
||||
|
|
@ -15,19 +15,57 @@ module Config : sig
|
|||
val to_string : t -> string
|
||||
end
|
||||
|
||||
type t = Curl.t
|
||||
(** A client, i.e. a cURL instance. *)
|
||||
type t = private { curl: Curl.t } [@@unboxed]
|
||||
(** 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.
|
||||
@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
|
||||
(** 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. *)
|
||||
|
||||
val set_no_signal : bool -> unit
|
||||
(** Set no_signal default value for each new client instance. Default is [true].
|
||||
See [CURLOPT_NOSIGNAL].
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
(** Cookie handling.
|
||||
|
||||
@since NEXT_RELEASE *)
|
||||
module Cookies : sig
|
||||
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 *)
|
||||
|
||||
val get_cookies : t -> string list
|
||||
(** Get cookie list (in netscape format) *)
|
||||
|
||||
val set_cookies : t -> string list -> unit
|
||||
(** Set cookie list (in netscape format) *)
|
||||
|
||||
val transfer : t -> t -> unit
|
||||
(** [transfer c1 c2] copies cookies in [c1] into [c2] *)
|
||||
end
|
||||
|
||||
(* TODO: duphandle is deprecated, how do we iterate on options?
|
||||
val copy : t -> t
|
||||
*)
|
||||
|
|
@ -45,17 +83,20 @@ type response_info = {
|
|||
val pp_response_info : Format.formatter -> response_info -> unit
|
||||
val string_of_response_info : response_info -> string
|
||||
|
||||
type response = {
|
||||
type 'body response = {
|
||||
code: int;
|
||||
(** Response code. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Status *)
|
||||
headers: (string * string) list; (** Response headers *)
|
||||
body: string; (** Response body, or [""] *)
|
||||
body: 'body; (** Response body, or [""] *)
|
||||
info: response_info; (** Information about the response *)
|
||||
}
|
||||
(** Response for a given request. *)
|
||||
|
||||
val pp_response : Format.formatter -> response -> unit
|
||||
val string_of_response : response -> string
|
||||
val pp_response_with :
|
||||
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a response -> unit
|
||||
|
||||
val pp_response : Format.formatter -> string response -> unit
|
||||
val string_of_response : string response -> string
|
||||
|
||||
(** The {{: https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods} HTTP method}
|
||||
to use *)
|
||||
|
|
@ -98,7 +139,7 @@ module type S = sig
|
|||
url:string ->
|
||||
meth:meth ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** General purpose HTTP call via cURL.
|
||||
@param url the URL to query
|
||||
@param meth which method to use (see {!meth})
|
||||
|
|
@ -119,6 +160,31 @@ module type S = sig
|
|||
@param headers headers of the query
|
||||
*)
|
||||
|
||||
(** Push-based stream of bytes
|
||||
@since NEXT_RELEASE *)
|
||||
class type input_stream = object
|
||||
method on_close : unit -> unit
|
||||
method on_input : bytes -> int -> int -> unit
|
||||
end
|
||||
|
||||
val http_stream :
|
||||
?tries:int ->
|
||||
?client:t ->
|
||||
?config:Config.t ->
|
||||
?range:string ->
|
||||
?content:[ `String of string | `Write of bytes -> int -> int ] ->
|
||||
?headers:(string * string) list ->
|
||||
url:string ->
|
||||
meth:meth ->
|
||||
write_into:#input_stream ->
|
||||
unit ->
|
||||
(unit response, Curl.curlCode * string) result io
|
||||
(** HTTP call via cURL, with a streaming response body.
|
||||
The body is given to [write_into] by chunks,
|
||||
then [write_into#on_close ()] is called
|
||||
and the response is returned.
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
val get :
|
||||
?tries:int ->
|
||||
?client:t ->
|
||||
|
|
@ -127,7 +193,7 @@ module type S = sig
|
|||
?headers:(string * string) list ->
|
||||
url:string ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:GET]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
|
|
@ -140,7 +206,7 @@ module type S = sig
|
|||
url:string ->
|
||||
content:[ `String of string | `Write of bytes -> int -> int ] ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:PUT]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
|
|
@ -154,7 +220,7 @@ module type S = sig
|
|||
params:Curl.curlHTTPPost list ->
|
||||
url:string ->
|
||||
unit ->
|
||||
(response, Curl.curlCode * string) result io
|
||||
(string response, Curl.curlCode * string) result io
|
||||
(** Shortcut for [http ~meth:(POST params)]
|
||||
See {!http} for more info.
|
||||
*)
|
||||
39
test/basic_test.expected
Normal file
39
test/basic_test.expected
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
get: OK
|
||||
body=```
|
||||
version = 0.26.2
|
||||
profile=conventional
|
||||
margin=80
|
||||
if-then-else=k-r
|
||||
parens-ite=true
|
||||
parens-tuple=multi-line-only
|
||||
sequence-style=terminator
|
||||
type-decl=sparse
|
||||
break-cases=toplevel
|
||||
cases-exp-indent=2
|
||||
field-space=tight-decl
|
||||
leading-nested-match-parens=true
|
||||
module-item-spacing=compact
|
||||
quiet=true
|
||||
ocaml-version=4.08.0
|
||||
|
||||
```
|
||||
streaming get: OK
|
||||
body=```
|
||||
version = 0.26.2
|
||||
profile=conventional
|
||||
margin=80
|
||||
if-then-else=k-r
|
||||
parens-ite=true
|
||||
parens-tuple=multi-line-only
|
||||
sequence-style=terminator
|
||||
type-decl=sparse
|
||||
break-cases=toplevel
|
||||
cases-exp-indent=2
|
||||
field-space=tight-decl
|
||||
leading-nested-match-parens=true
|
||||
module-item-spacing=compact
|
||||
quiet=true
|
||||
ocaml-version=4.08.0
|
||||
|
||||
```
|
||||
same buf? true
|
||||
|
|
@ -1,10 +1,30 @@
|
|||
let body = ref ""
|
||||
|
||||
let url =
|
||||
"https://raw.githubusercontent.com/c-cube/ezcurl/refs/heads/main/.ocamlformat"
|
||||
|
||||
let () =
|
||||
match Ezcurl.get ~url () with
|
||||
| Error (code, msg) ->
|
||||
Format.eprintf "curl error: code `%s` (%s)@." (Curl.strerror code) msg
|
||||
| Ok res ->
|
||||
body := res.body;
|
||||
Format.printf "get: OK@.body=```@.%s@.```@." !body
|
||||
|
||||
let () =
|
||||
let buf = Buffer.create 32 in
|
||||
match
|
||||
Ezcurl.get
|
||||
~url:
|
||||
"https://archive.softwareheritage.org/api/1/content/sha1_git:7bdf38d4468c114206c9b6ebd9cf1176e085d346/"
|
||||
Ezcurl.http_stream ~meth:GET ~url
|
||||
~write_into:
|
||||
(object
|
||||
method on_input bs i len = Buffer.add_subbytes buf bs i len
|
||||
method on_close () = ()
|
||||
end)
|
||||
()
|
||||
with
|
||||
| Error (code, msg) ->
|
||||
Format.eprintf "curl error: code `%s` (%s)@." (Curl.strerror code) msg
|
||||
| Ok _response -> Format.printf "OK@."
|
||||
| Ok _res ->
|
||||
let new_body = Buffer.contents buf in
|
||||
Format.printf "streaming get: OK@.body=```@.%s@.```@." new_body;
|
||||
Format.printf "same buf? %b@." (new_body = !body)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue