runs-on: ubuntu-latest
steps:
- name: Checkout tree
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
submodules: true
- uses: cachix/install-nix-action@v30
steps:
- name: Checkout tree
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
steps:
- name: Checkout tree
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
steps:
- name: Checkout tree
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
steps:
- name: Checkout tree
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
+## v6.2.0 (2025-12-02)
+
+- cohttp-eio: Add support for forward proxies to the client (@shonfeder, #1126)
+- cohttp-lwt: Expose the IO module, allowing IO errors to be handled (@mefyl, #1118)
+
## v6.1.1 (2025-05-28)
- cohttp-mirage: make client usable again -- this fixes a regression introduced
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation for the Async concurrency library"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Benchmarks binaries for Cohttp"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Cohttp client using Curl & Async as the backend"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Cohttp client using Curl & Lwt as the backend"
"cohttp-curl" {= version}
"stringext"
"lwt" {>= "5.3.0"}
+ "cmdliner" {with-dev-setup & >= "2.0.0"}
"uri" {with-test & >= "4.2.0"}
"alcotest" {with-test & >= "1.7.0"}
"cohttp-lwt-unix" {with-test & = version}
open Cmdliner
let uri =
- let loc : Uri.t Arg.conv =
- let parse s =
- try `Ok (Uri.of_string s) with Failure _ -> `Error "unable to parse URI"
+ let loc =
+ let parser s =
+ match Uri.of_string s with
+ | uri -> Ok uri
+ | exception Failure _ -> Error "unable to parse URI"
in
- (parse, fun ppf p -> Format.fprintf ppf "%s" (Uri.to_string p))
+ let pp ppf u = Format.fprintf ppf "%s" (Uri.to_string u) in
+ Cmdliner.Arg.Conv.make ~parser ~pp ~docv:"URI" ()
in
Arg.(
required
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Shared code between the individual cohttp-curl clients"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation with eio backend"
"eio" {>= "0.12"}
"eio_main" {with-test}
"mdx" {with-test}
+ "ipaddr" {>= "5.6.0"}
"logs"
"uri"
"tls-eio" {with-test & >= "1.0.0"}
--- /dev/null
+# Cohttp-eio Examples
+
+This directory contains examples illustrating different modes of use of the
+cohttp-eio package.
+
+## [`client_proxy.ml`](./client_proxy.ml)
+
+This executable shows an example of how to set up proxying for client requests.
+
+## Prerequisites
+
+The following usage examples assumes
+
+- you are working in root directory of this project,
+- you have installed [mitmproxy](https://github.com/mitmproxy/mitmproxy),
+- and that you have launched `mitmdump` on port `8888` in a separate terminal, with
+
+ ``` sh
+ mitmdum -p 8888
+ ```
+
+NOTE: We use mitmproxy because it allows us to test the https connection to the
+proxy locally. However, it also requires using its own cacert for these use
+cases. This example executable can also be exercised with
+[tinyproxy](https://github.com/tinyproxy/tinyproxy), excluding https connections
+to the proxy.
+
+### Direct proxy for http requests
+
+``` sh
+dune exec cohttp-eio/examples/client_proxy.exe -- \
+ --all-proxy=http://127.0.0.1:8888 \
+ http://httpbin.io/hostname
+```
+
+
+### Tunnelling proxy for https requests to the remote host
+
+``` sh
+dune exec cohttp-eio/examples/client_proxy.exe -- \
+ --cacert=$HOME/.mitmproxy/mitmproxy-ca-cert.pem \
+ --all-proxy=http://127.0.0.1:8888 \
+ https://httpbin.io/hostname
+```
+
+### Using an https connection to the proxy
+
+This exercises our support for TLS over TLS.
+
+``` sh
+dune exec cohttp-eio/examples/client_proxy.exe -- \
+ --cacert=$HOME/.mitmproxy/mitmproxy-ca-cert.pem \
+ --all-proxy=https://127.0.0.1:8888 \
+ https://httpbin.io/hostname
+```
--- /dev/null
+open Cohttp_eio
+
+let authenticator =
+ match Ca_certs.authenticator () with
+ | Ok x -> x
+ | Error (`Msg m) ->
+ Fmt.failwith "Failed to create system store X509 authenticator: %s" m
+
+let () =
+ Logs.set_reporter (Logs_fmt.reporter ());
+ Logs_threaded.enable ();
+ Logs.Src.set_level Cohttp_eio.src (Some Debug)
+
+let https ~authenticator =
+ let tls_config =
+ match Tls.Config.client ~authenticator () with
+ | Error (`Msg msg) -> failwith ("tls configuration problem: " ^ msg)
+ | Ok tls_config -> tls_config
+ in
+ fun uri socket ->
+ let host =
+ Option.bind (Uri.host uri) (fun x ->
+ Domain_name.(host (of_string_exn x)) |> Result.to_option)
+ in
+ Tls_eio.client_of_flow ?host tls_config socket
+
+let get_request_exn ~sw client url =
+ let resp, body = Client.get ~sw client url in
+ match resp.status with
+ | `OK ->
+ Eio.traceln "%s"
+ @@ Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int
+ | otherwise -> Fmt.epr "Unexpected HTTP status: %a\n" Http.Status.pp otherwise
+
+let run_client url cacert all_proxy no_proxy http_proxy https_proxy proxy_auth =
+ let scheme_proxy =
+ List.filter_map Fun.id
+ [
+ Option.map (fun p -> ("http", p)) http_proxy;
+ Option.map (fun p -> ("https", p)) https_proxy;
+ ]
+ in
+ let proxy_headers =
+ Option.map
+ (fun credential ->
+ Http.Header.init_with "Proxy-Authorization"
+ (Cohttp.Auth.string_of_credential credential))
+ proxy_auth
+ in
+
+ Eio_main.run @@ fun env ->
+ Mirage_crypto_rng_unix.use_default ();
+
+ let net = env#net in
+
+ let authenticator =
+ match cacert with
+ | None -> authenticator
+ | Some pem ->
+ (* Load a custom cacert from a file *)
+ let fs = Eio.Stdenv.fs env in
+ X509_eio.authenticator (`Ca_file Eio.Path.(fs / pem))
+ in
+
+ Client.set_proxies ?proxy_headers ?default_proxy:all_proxy
+ ?no_proxy_patterns:no_proxy ~scheme_proxies:scheme_proxy ();
+
+ let client = Client.make ~https:(Some (https ~authenticator)) net in
+
+ Eio.traceln ">>> Make calls in sequence";
+ Eio.Switch.run (fun sw ->
+ get_request_exn ~sw client url;
+ get_request_exn ~sw client url;
+ get_request_exn ~sw client url);
+
+ Eio.traceln ">>> Make calls concurrently";
+ Eio.Switch.run (fun sw ->
+ for _ = 0 to 5 do
+ Eio.Fiber.fork ~sw (fun () -> get_request_exn ~sw client url)
+ done);
+
+ Eio.traceln ">>> Make calls in parallel";
+ let dm = Eio.Stdenv.domain_mgr env in
+ Eio.Fiber.all
+ [
+ (fun () ->
+ Eio.Domain_manager.run dm (fun () ->
+ Eio.Switch.run (fun sw -> get_request_exn ~sw client url)));
+ (fun () ->
+ Eio.Domain_manager.run dm (fun () ->
+ Eio.Switch.run (fun sw -> get_request_exn ~sw client url)));
+ (fun () ->
+ Eio.Domain_manager.run dm (fun () ->
+ Eio.Switch.run (fun sw -> get_request_exn ~sw client url)));
+ (fun () ->
+ Eio.Domain_manager.run dm (fun () ->
+ Eio.Switch.run (fun sw -> get_request_exn ~sw client url)));
+ (fun () ->
+ Eio.Domain_manager.run dm (fun () ->
+ Eio.Switch.run (fun sw -> get_request_exn ~sw client url)));
+ ]
+
+(* CLI Interface *)
+
+let uri_conv =
+ let parser s =
+ match Uri.of_string s with
+ | uri -> Ok uri
+ | exception Failure _ -> Error "unable to parse URI"
+ in
+
+ let pp ppf u = Fmt.pf ppf "%s" (Uri.to_string u) in
+ Cmdliner.Arg.Conv.make ~parser ~pp ~docv:"URI" ()
+
+let credential_conv =
+ let parser s =
+ match Base64.encode s with
+ | Ok s ->
+ s |> Fmt.str "Basic %s" |> Cohttp.Auth.credential_of_string |> Result.ok
+ | Error (`Msg m) -> Error m
+ in
+ let pp ppf c = Fmt.pf ppf "%s" (Cohttp.Auth.string_of_credential c) in
+ Cmdliner.Arg.Conv.make ~parser ~pp ~docv:"CREDENTIAL" ()
+
+let uri =
+ Cmdliner.Arg.(
+ required
+ & pos 0 (some uri_conv) None
+ & info [] ~docv:"URI"
+ ~doc:"string of the remote address (e.g. https://ocaml.org)")
+
+let all_proxy =
+ let env = Cmdliner.Cmd.Env.info "ALL_PROXY" in
+ Cmdliner.Arg.(
+ value
+ & opt (some uri_conv) None
+ & info [ "all-proxy" ] ~env ~docv:"ALL_PROXY" ~doc:"Default proxy server")
+
+let no_proxy =
+ let env = Cmdliner.Cmd.Env.info "NO_PROXY" in
+ Cmdliner.Arg.(
+ value
+ & opt (some string) None
+ & info [ "no-proxy" ] ~env ~docv:"NO_PROXY"
+ ~doc:"Exclude matching hosts from proxying")
+
+let http_proxy =
+ let env = Cmdliner.Cmd.Env.info "HTTP_PROXY" in
+ Cmdliner.Arg.(
+ value
+ & opt (some uri_conv) None
+ & info [ "http-proxy" ] ~env ~docv:"HTTP_PROXY"
+ ~doc:"Proxy to use for requests using http")
+
+let https_proxy =
+ let env = Cmdliner.Cmd.Env.info "HTTPS_PROXY" in
+ Cmdliner.Arg.(
+ value
+ & opt (some uri_conv) None
+ & info [ "https-proxy" ] ~env ~docv:"HTTPS_PROXY"
+ ~doc:"Proxy to use for requests using https")
+
+let proxy_auth =
+ Cmdliner.Arg.(
+ value
+ & opt (some credential_conv) None
+ & info [ "proxy-auth" ] ~docv:"CREDENTIAL" ~doc:"Proxy credentials")
+
+let cacert =
+ Cmdliner.Arg.(
+ value
+ & opt (some string) None
+ & info [ "cacert" ] ~docv:"PEM_FILE"
+ ~doc:"Custom cert file for https authentication")
+
+let cmd =
+ let info =
+ let version = Cohttp.Conf.version in
+ let doc = "retrieve a remote URI contents" in
+ Cmdliner.Cmd.info "client_proxy" ~version ~doc
+ in
+
+ let term =
+ Cmdliner.Term.(
+ const run_client
+ $ uri
+ $ cacert
+ $ all_proxy
+ $ no_proxy
+ $ http_proxy
+ $ https_proxy
+ $ proxy_auth)
+ in
+ Cmdliner.Cmd.v info term
+
+let () = exit @@ Cmdliner.Cmd.eval cmd
(executables
- (names server1 server2 client1 docker_client client_timeout client_tls)
+ (names
+ server1
+ server2
+ client1
+ docker_client
+ client_timeout
+ client_tls
+ client_proxy)
(libraries
cohttp-eio
+ cmdliner
eio_main
eio.unix
fmt
open Eio.Std
open Utils
+module Proxy = Cohttp.Proxy.Forward
-type connection = Eio.Flow.two_way_ty r
+type connection = [ Eio.Flow.two_way_ty | Eio.Resource.close_ty ] r
type t = sw:Switch.t -> Uri.t -> connection
+type proxies = (Uri.t, Uri.t) Proxy.servers
+
+let proxies : (Http.Header.t option * proxies) option Atomic.t =
+ Atomic.make None
+
+let set_proxies ?no_proxy_patterns ?default_proxy ?(scheme_proxies = [])
+ ?proxy_headers () =
+ let servers =
+ Proxy.make_servers ~no_proxy_patterns ~default_proxy ~scheme_proxies
+ ~direct:Fun.id ~tunnel:Fun.id
+ in
+ Atomic.set proxies (Some (proxy_headers, servers))
+
+let get_proxy uri =
+ match Atomic.get proxies with
+ | None -> None
+ | Some (headers, proxies) -> (
+ match Proxy.get proxies uri with
+ | None -> None
+ | Some (Proxy.Direct _) as proxy -> proxy
+ | Some (Proxy.Tunnel p) -> Some (Proxy.Tunnel (headers, p)))
+
+let call_on_socket ~sw ?headers ?body ?(chunked = false) meth uri socket =
+ let body_length =
+ if chunked then None
+ else
+ match body with
+ | None -> Some 0L
+ | Some (Eio.Resource.T (body, ops)) ->
+ let module X = (val Eio.Resource.get ops Eio.Flow.Pi.Source) in
+ List.find_map
+ (function
+ | Body.String m -> Some (String.length (m body) |> Int64.of_int)
+ | _ -> None)
+ X.read_methods
+ in
+ let request =
+ Cohttp.Request.make_for_client ?headers
+ ~chunked:(Option.is_none body_length)
+ ?body_length meth uri
+ in
+ Eio.Buf_write.with_flow socket @@ fun output ->
+ let () =
+ Eio.Fiber.fork ~sw @@ fun () ->
+ Io.Request.write ~flush:false
+ (fun writer ->
+ match body with
+ | None -> ()
+ | Some body -> flow_to_writer body writer Io.Request.write_body)
+ request output
+ in
+ let input = Eio.Buf_read.of_flow ~max_size:max_int socket in
+ match Io.Response.read input with
+ | `Eof -> failwith "connection closed by peer"
+ | `Invalid reason -> failwith reason
+ | `Ok response -> (
+ match Cohttp.Response.has_body response with
+ | `No -> (response, Eio.Flow.string_source "")
+ | `Yes | `Unknown ->
+ let body =
+ let reader = Io.Response.make_body_reader response input in
+ flow_of_reader (fun () -> Io.Response.read_body_chunk reader)
+ in
+ (response, body))
include
Cohttp.Generic.Client.Make
let call (t : t) ~sw ?headers ?body ?(chunked = false) meth uri =
let socket = t ~sw uri in
- let body_length =
- if chunked then None
- else
- match body with
- | None -> Some 0L
- | Some (Eio.Resource.T (body, ops)) ->
- let module X = (val Eio.Resource.get ops Eio.Flow.Pi.Source) in
- List.find_map
- (function
- | Body.String m ->
- Some (String.length (m body) |> Int64.of_int)
- | _ -> None)
- X.read_methods
- in
- let request =
- Cohttp.Request.make_for_client ?headers
- ~chunked:(Option.is_none body_length)
- ?body_length meth uri
- in
- Eio.Buf_write.with_flow socket @@ fun output ->
- let () =
- Eio.Fiber.fork ~sw @@ fun () ->
- Io.Request.write ~flush:false
- (fun writer ->
- match body with
- | None -> ()
- | Some body -> flow_to_writer body writer Io.Request.write_body)
- request output
- in
- let input = Eio.Buf_read.of_flow ~max_size:max_int socket in
- match Io.Response.read input with
- | `Eof -> failwith "connection closed by peer"
- | `Invalid reason -> failwith reason
- | `Ok response -> (
- match Cohttp.Response.has_body response with
- | `No -> (response, Eio.Flow.string_source "")
- | `Yes | `Unknown ->
- let body =
- let reader = Io.Response.make_body_reader response input in
- flow_of_reader (fun () -> Io.Response.read_body_chunk reader)
- in
- (response, body))
+ call_on_socket ~sw ?headers ?body ~chunked meth uri socket
end)
(Io.IO)
| ip :: _ -> ip
| [] -> failwith "failed to resolve hostname"
+(* Create a socket for the uri, and signal whether it requires https *)
+let scheme_conn_of_uri ~sw net uri =
+ match Uri.scheme uri with
+ | Some "httpunix" ->
+ (* FIXME: while there is no standard, http+unix seems more widespread *)
+ `Plain (Eio.Net.connect ~sw net (unix_address uri) :> connection)
+ | Some "http" ->
+ `Plain (Eio.Net.connect ~sw net (tcp_address ~net uri) :> connection)
+ | Some "https" ->
+ `Https (Eio.Net.connect ~sw net (tcp_address ~net uri) :> connection)
+ | x ->
+ Fmt.failwith "Unknown scheme %a"
+ Fmt.(option ~none:(any "None") Dump.string)
+ x
+
+(* Create a tunnel to the proxy at [proxy_uri] *)
+let make_tunnel ~sw ~headers proxy_uri socket =
+ let resp, _ = call_on_socket ~sw ?headers `CONNECT proxy_uri socket in
+ match Http.Response.status resp with
+ | #Http.Status.success -> Ok ()
+ | _ -> Error (Http.Response.status resp)
+
+(* Apply the https wrapper, if provided, or else fail with an error *)
+let apply_https https uri conn =
+ match https with
+ | None -> Fmt.failwith "HTTPS not enabled (for %a)" Uri.pp uri
+ | Some wrap -> (wrap uri conn :> connection)
+
let make ~https net : t =
- let net = (net :> [ `Generic ] Eio.Net.ty r) in
- let https =
- (https
- :> (Uri.t -> [ `Generic ] Eio.Net.stream_socket_ty r -> connection) option)
+ fun ~sw uri ->
+ let scheme_conn =
+ match get_proxy uri with
+ | None -> scheme_conn_of_uri ~sw net uri
+ | Some (Proxy.Direct proxy_uri) -> scheme_conn_of_uri ~sw net proxy_uri
+ | Some (Proxy.Tunnel (proxy_headers, proxy_uri)) -> (
+ let conn =
+ match scheme_conn_of_uri ~sw net proxy_uri with
+ | `Plain socket -> socket
+ | `Https socket -> apply_https https proxy_uri socket
+ in
+ match make_tunnel ~sw ~headers:proxy_headers uri conn with
+ | Ok () ->
+ (* we know its an https connection, because we have selected a tunnelling proxy *)
+ `Https conn
+ | Error status ->
+ Fmt.failwith
+ "Proxy could not form tunnel to %a for host %a; status %a" Uri.pp
+ proxy_uri Uri.pp uri Http.Status.pp status)
in
- fun ~sw uri ->
- match Uri.scheme uri with
- | Some "httpunix" ->
- (* FIXME: while there is no standard, http+unix seems more widespread *)
- (Eio.Net.connect ~sw net (unix_address uri) :> connection)
- | Some "http" ->
- (Eio.Net.connect ~sw net (tcp_address ~net uri) :> connection)
- | Some "https" -> (
- match https with
- | Some wrap ->
- wrap uri @@ Eio.Net.connect ~sw net (tcp_address ~net uri)
- | None -> Fmt.failwith "HTTPS not enabled (for %a)" Uri.pp uri)
- | x ->
- Fmt.failwith "Unknown scheme %a"
- Fmt.(option ~none:(any "None") Dump.string)
- x
+ match scheme_conn with
+ | `Plain conn -> conn
+ | `Https conn -> apply_https https uri conn
val make :
https:
- (Uri.t -> [ `Generic ] Eio.Net.stream_socket_ty r -> _ Eio.Flow.two_way)
+ (Uri.t ->
+ [ Eio.Flow.two_way_ty | Eio.Resource.close_ty ] Eio.Std.r ->
+ [> Eio.Resource.close_ty ] Eio.Flow.two_way)
option ->
_ Eio.Net.t ->
t
- URIs of the form "httpunix://unix-path/http-path" connect to the given
Unix path. *)
-val make_generic : (sw:Switch.t -> Uri.t -> _ Eio.Flow.two_way) -> t
+val make_generic :
+ (sw:Switch.t -> Uri.t -> [> Eio.Resource.close_ty ] Eio.Flow.two_way) -> t
(** [make_generic connect] is an HTTP client that uses [connect] to get the
connection to use for a given URI. *)
+
+val set_proxies :
+ ?no_proxy_patterns:string ->
+ ?default_proxy:Uri.t ->
+ ?scheme_proxies:(string * Uri.t) list ->
+ ?proxy_headers:Http.Header.t ->
+ unit ->
+ unit
+(** [set_proxies ~default_proxy ()] configures the proxies used by clients
+ created via {!val:make}.
+
+ See {!val:Cohttp.Proxy.Forward.make_servers} for the meaning of the
+ parameters. *)
(library
(name cohttp_eio)
(public_name cohttp-eio)
- (libraries cohttp eio fmt http logs ptime uri uri.services))
+ (libraries cohttp eio fmt http logs ptime uri uri.services ipaddr))
(test
(name test)
+ (modules test)
(libraries alcotest cohttp-eio eio eio.mock eio_main logs.fmt)
(package cohttp-eio)
(preprocess
(pps ppx_here)))
+
+(test
+ (name test_forward_proxy)
+ (modules test_forward_proxy)
+ (libraries alcotest cohttp-eio eio eio.mock eio_main logs.fmt)
+ (package cohttp-eio))
--- /dev/null
+(* Tests the core behaviour if the forward proxy *)
+
+let () =
+ Logs.set_level ~all:true @@ Some Logs.Debug;
+ Logs.set_reporter (Logs_fmt.reporter ())
+
+(* Used to pass data out of the server *)
+module Req_data = struct
+ let side_channel : Http.Request.t Eio.Stream.t = Eio.Stream.create 1
+ let send t = Eio.Stream.add side_channel t
+
+ let get () =
+ if Eio.Stream.is_empty side_channel then failwith "no requests pending";
+ Eio.Stream.take side_channel
+end
+
+let t_meth : Http.Method.t Alcotest.testable =
+ Alcotest.testable Http.Method.pp (fun a b -> Http.Method.compare a b = 0)
+
+(* The proxy server sends every request to the `Req_data` side channel and
+ always responds with 200. *)
+let run_proxy_server server_port net sw =
+ let handler ~sw _conn request body =
+ let _ = Eio.Buf_read.(of_flow ~max_size:max_int body |> take_all) in
+ Eio.Fiber.fork ~sw (fun () -> Req_data.send request);
+ Cohttp_eio.Server.respond_string ~status:`OK ~body:"" ()
+ in
+ let socket =
+ Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true ~reuse_port:true
+ (`Tcp (Eio.Net.Ipaddr.V4.loopback, server_port))
+ and server = Cohttp_eio.Server.make ~callback:(handler ~sw) () in
+ Eio.Fiber.fork_daemon ~sw @@ fun () ->
+ let () = Cohttp_eio.Server.run socket server ~on_error:raise in
+ `Stop_daemon
+
+let () =
+ (* Different tests run in parallel, so the port should be unique among
+ tests *)
+ let server_port = 4243 in
+ let () =
+ Cohttp_eio.Client.set_proxies
+ ~default_proxy:
+ (Uri.of_string @@ Printf.sprintf "http://127.0.0.1:%d" server_port)
+ ()
+ in
+ Eio_main.run @@ fun env ->
+ Eio.Switch.run @@ fun sw ->
+ let () = run_proxy_server server_port env#net sw in
+ let client =
+ let noop_https_wrapper = Some (fun _ f -> f) in
+ Cohttp_eio.Client.make ~https:noop_https_wrapper env#net
+ in
+ let get_success uri =
+ let resp, _ = Cohttp_eio.Client.get ~sw client uri in
+ match Http.Response.status resp with
+ | `OK -> ()
+ | unexpected ->
+ Alcotest.failf "unexpected response from test_forward_proxy server %a"
+ Http.Status.pp unexpected
+ in
+
+ (* TESTS CASES *)
+ let direct_proxied_request () =
+ (* When the remote host is over HTTP *)
+ let uri = Uri.of_string "http://foo.org" in
+ get_success uri;
+ let req = Req_data.get () in
+ let meth = Http.Request.meth req in
+ Alcotest.(check' t_meth)
+ ~msg:"should be a GET request" ~actual:meth ~expected:`GET;
+ let host =
+ let headers = Http.Request.headers req in
+ Http.Header.get headers "host"
+ in
+ Alcotest.(check' (option string))
+ ~msg:"should request from remote host" ~actual:host
+ ~expected:(Some "foo.org")
+ and tunnelled_proxied_request () =
+ (* When the remote host is over HTTPS *)
+ let uri = Uri.of_string "https://foo.org" in
+ get_success uri;
+ let req = Req_data.get () in
+ let meth = Http.Request.meth req in
+ Alcotest.(check' t_meth)
+ ~msg:"should first initiate a CONNECT request" ~actual:meth
+ ~expected:`CONNECT;
+ let host =
+ let headers = Http.Request.headers req in
+ Http.Header.get headers "host"
+ in
+ Alcotest.(check' (option string))
+ ~msg:"should request from remote host (with port)" ~actual:host
+ ~expected:(Some "foo.org:443");
+
+ let req' = Req_data.get () in
+ let meth' = Http.Request.meth req' in
+ Alcotest.(check' t_meth)
+ ~msg:"should then send a GET request" ~actual:meth' ~expected:`GET;
+ let host =
+ let headers = Http.Request.headers req in
+ Http.Header.get headers "host"
+ in
+ Alcotest.(check' (option string))
+ ~msg:"should request from remote host (with port)" ~actual:host
+ ~expected:(Some "foo.org:443")
+ and unset_proxy () =
+ let () = Cohttp_eio.Client.set_proxies ?default_proxy:None () in
+ (* .invalid domains are guaranteed to not have hosts:
+ https://www.rfc-editor.org/rfc/rfc2606 *)
+ let uri = Uri.of_string "http://foo.invalid" in
+ match Cohttp_eio.Client.get ~sw client uri with
+ | exception Failure _ ->
+ (* This should fail, since we are not using the proxy *)
+ ()
+ | unexepcted_resp, _ ->
+ Alcotest.failf
+ "Resolution of uri should have failed, but succeeded with %a"
+ Http.Response.pp unexepcted_resp
+ in
+ Alcotest.run "cohttp-eio client"
+ [
+ ( "cohttp-eio forward proxy",
+ [
+ ("direct get", `Quick, direct_proxied_request);
+ ("tunnelled proxied request", `Quick, tunnelled_proxied_request);
+ ("unessting the proxy config", `Quick, unset_proxy);
+ ] );
+ ]
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation for the Js_of_ocaml JavaScript compiler"
String.init len (fun i -> Char.chr (Typed_array.unsafe_get u8a (offset + i)))
module String_io = Cohttp.Private.String_io
-module IO = Cohttp_lwt.Private.String_io
+
+module IO = struct
+ include Cohttp_lwt.Private.String_io
+
+ type error = |
+
+ let catch f = Lwt.map (fun v -> Result.Ok v) @@ f ()
+ let pp_error _ (e : error) = match e with _ -> .
+end
+
module Header_io = Cohttp.Private.Header_io.Make (IO)
module Body_builder (P : Params) = struct
(Response.t * Cohttp_lwt.Body.t) Lwt.t
end) =
struct
+ module IO = IO
module Request = X.Request
module Response = X.Response
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation for Unix and Windows using Lwt"
"http" {= version}
"cohttp" {= version}
"cohttp-lwt" {= version}
- "cmdliner" {>= "1.1.0"}
+ "cmdliner" {>= "2.0.0"}
"lwt" {>= "3.0.0"}
"conduit-lwt" {>= "7.1.0"}
"conduit-lwt-unix" {>= "7.1.0"}
open Cmdliner
let uri =
- let loc : Uri.t Arg.conv =
- let parse s =
- try `Ok (Uri.of_string s) with Failure _ -> `Error "unable to parse URI"
+ let loc =
+ let parser s =
+ match Uri.of_string s with
+ | uri -> Ok uri
+ | exception Failure _ -> Error "unable to parse URI"
in
- (parse, fun ppf p -> Format.fprintf ppf "%s" (Uri.to_string p))
+ let pp ppf u = Format.fprintf ppf "%s" (Uri.to_string u) in
+ Cmdliner.Arg.Conv.make ~parser ~pp ~docv:"URI" ()
in
Arg.(
required
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation using the Lwt concurrency library"
module Make (Connection : S.Connection) = struct
module Net = Connection.Net
+ module IO = Net.IO
module No_cache = Connection_cache.Make_no_cache (Connection)
module Request = Make.Request (Net.IO)
request tunnel.remote ?headers ?body ?absolute_form meth uri self.retry
end
-type no_proxy_pattern = Name of string | Ipaddr_prefix of Ipaddr.Prefix.t
-type no_proxy = Wildcard | Patterns of no_proxy_pattern list
-
-let trim_dots ~first_leading s =
- let len = String.length s in
- let i = ref 0 in
- if first_leading && !i < len && String.unsafe_get s !i = '.' then incr i;
- let j = ref (len - 1) in
- while !j >= !i && String.unsafe_get s !j = '.' do
- decr j
- done;
- if !j >= !i then String.sub s !i (!j - !i + 1) else ""
-
-let strncasecompare a b n =
- let a = String.(sub a 0 (min (length a) n) |> lowercase_ascii)
- and b = String.(sub b 0 (min (length b) n) |> lowercase_ascii) in
- String.compare a b = 0
-
-let no_proxy_from_env no_proxy =
- if no_proxy = "*" then Wildcard
- else
- let patterns =
- no_proxy
- |> String.split_on_char ','
- |> List.filter_map (fun pattern ->
- if pattern = "" then None else Some (String.trim pattern))
- |> List.map (fun pattern ->
- match Ipaddr.of_string pattern with
- | Ok addr -> Ipaddr_prefix (Ipaddr.Prefix.of_addr addr)
- | Error _ -> (
- match Ipaddr.Prefix.of_string pattern with
- | Ok prefix -> Ipaddr_prefix prefix
- | Error _ -> Name (trim_dots ~first_leading:true pattern)))
- in
- Patterns patterns
-
-let check_no_proxy_patterns host = function
- | Wildcard -> true
- | _ when String.length host = 0 -> true
- | Patterns patterns -> (
- match Ipaddr.of_string host with
- | Ok hostip ->
- List.exists
- (function
- | Name _ -> false
- | Ipaddr_prefix network -> Ipaddr.Prefix.mem hostip network)
- patterns
- | Error _ ->
- let name = trim_dots ~first_leading:false host in
- List.exists
- (function
- | Ipaddr_prefix _ -> false
- | Name pattern ->
- let patternlen = String.length pattern
- and namelen = String.length name in
- if patternlen = namelen then
- strncasecompare pattern name namelen
- else if patternlen < namelen then
- name.[namelen - patternlen - 1] = '.'
- && strncasecompare pattern
- (String.sub name (namelen - patternlen)
- (patternlen - namelen - patternlen))
- patternlen
- else false)
- patterns)
-
-let tunnel_schemes = [ "https" ]
+module Proxy = Cohttp.Proxy.Forward
module Make_proxy (Connection : S.Connection) (Sleep : S.Sleep) = struct
module Connection_cache = Make (Connection) (Sleep)
module Connection_tunnel = Make_tunnel (Connection) (Sleep)
- type proxy = Direct of Connection_cache.t | Tunnel of Connection_tunnel.t
-
type t = {
- proxies : (string * proxy) list;
- direct : proxy option;
- tunnel : proxy option;
+ proxies : (Connection_cache.t, Connection_tunnel.t) Proxy.servers;
no_proxy : Connection_cache.t;
- no_proxy_patterns : no_proxy;
}
let create ?ctx ?keep ?retry ?parallel ?depth ?(scheme_proxy = []) ?all_proxy
Connection_tunnel.create ?ctx ?keep ?retry ?parallel ?depth ?proxy_headers
proxy_uri ()
in
- let no_proxy_patterns =
- match no_proxy with
- | None -> Patterns []
- | Some no_proxy -> no_proxy_from_env no_proxy
- in
- let no_proxy = create_default () in
let proxies =
- List.map
- (fun (scheme, uri) ->
- let proxy =
- if List.mem scheme tunnel_schemes then Tunnel (create_tunnel uri)
- else Direct (create_direct uri)
- in
- (scheme, proxy))
- scheme_proxy
+ Proxy.make_servers ~no_proxy_patterns:no_proxy ~default_proxy:all_proxy
+ ~scheme_proxies:scheme_proxy ~direct:create_direct ~tunnel:create_tunnel
in
- let direct, tunnel =
- match all_proxy with
- | Some uri ->
- (Some (Direct (create_direct uri)), Some (Tunnel (create_tunnel uri)))
- | None -> (None, None)
- in
- { no_proxy; direct; tunnel; proxies; no_proxy_patterns }
+ let no_proxy = create_default () in
+ { no_proxy; proxies }
let call self ?headers ?body ?absolute_form meth uri =
- let proxy =
- if
- check_no_proxy_patterns
- (Uri.host_with_default ~default:"" uri)
- self.no_proxy_patterns
- then None
- (* Connection_cache.call self.no_proxy ?headers ?body ?absolute_form meth uri *)
- else
- let scheme = Option.value ~default:"" (Uri.scheme uri) in
- match List.assoc scheme self.proxies with
- | proxy -> Some proxy
- | exception Not_found ->
- if List.mem scheme tunnel_schemes then self.tunnel else self.direct
- in
+ let proxy = Proxy.get self.proxies uri in
match proxy with
| None ->
Connection_cache.call self.no_proxy ?headers ?body ?absolute_form meth
module type Client = sig
type ctx
+ module IO : IO with type 'a t = 'a Lwt.t
+
(** @param ctx
If provided, no connection cache is used, but
{!val:Connection_cache.Make_no_cache.create} is used to resolve uri and
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP implementation for the MirageOS unikernel"
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
- * cohttp v6.1.1
+ * cohttp v6.2.0
*)
module Make (R : Resolver_mirage.S) (S : Conduit_mirage.S) = struct
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
- * cohttp v6.1.1
+ * cohttp v6.2.0
*)
open Lwt.Infix
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
- * cohttp v6.1.1
+ * cohttp v6.2.0
*)
(** Cohttp IO implementation using Mirage channels. *)
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
- * cohttp v6.1.1
+ * cohttp v6.2.0
*)
module Key = Mirage_kv.Key
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
- * cohttp v6.1.1
+ * cohttp v6.2.0
*)
(** Serve static HTTP sites from a Mirage key-value store. *)
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Lightweight Cohttp + Lwt based HTTP server"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "CoHTTP toplevel pretty printers for HTTP types"
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "An OCaml library for HTTP clients and servers"
"stringext"
"base64" {>= "3.1.0"}
"fmt" {with-test}
+ "ipaddr" {>= "5.6.0"}
"alcotest" {with-test & >= "1.7.0"}
"odoc" {with-doc}
]
+let src = Logs.Src.create "cohttp.client" ~doc:"Cohttp Client module"
+
+module Log = (val Logs.src_log src)
+
(** The [Client] module is a collection of convenience functions for
constructing and processing requests. *)
module type BASE = sig
let call =
map_context call (fun call ?headers ?body ?chunked meth uri ->
- let () =
- Logs.info (fun m -> m "%a %a" Http.Method.pp meth Uri.pp uri)
- in
+ let () = Log.info (fun m -> m "%a %a" Http.Method.pp meth Uri.pp uri) in
call ?headers ?body ?chunked meth uri)
let delete =
module Cookie = Cookie
module Header = Header
module Link = Link
+module Proxy = Proxy
module Request = Request
module Response = Response
module S = S
(pps ppx_sexp_conv))
(libraries
base64
+ ipaddr
logs
(re_export http)
re
--- /dev/null
+module Forward = struct
+ type pattern = Name of string | Ipaddr_prefix of Ipaddr.Prefix.t
+ type no_proxy_patterns = Wildcard | Patterns of pattern list
+
+ (* Used to ignore trailing dots in hostnames, as per
+ https://github.com/curl/curl/blob/49ef2f8d1ef78e702c73f5d72242301cc2a0157e/lib/noproxy.c#L170-L172
+
+ When [first_leading = true], it also trims the first leading dot, as per
+ https://github.com/curl/curl/blob/49ef2f8d1ef78e702c73f5d72242301cc2a0157e/lib/noproxy.c#L198-L201 *)
+ let trim_dots ~first_leading s =
+ let len = String.length s in
+ let i = ref 0 in
+ if first_leading && !i < len && String.unsafe_get s !i = '.' then incr i;
+ let j = ref (len - 1) in
+ while !j >= !i && String.unsafe_get s !j = '.' do
+ decr j
+ done;
+ if !j >= !i then String.sub s !i (!j - !i + 1) else ""
+
+ let strncasecompare a b n =
+ let a = String.(sub a 0 (min (length a) n) |> lowercase_ascii)
+ and b = String.(sub b 0 (min (length b) n) |> lowercase_ascii) in
+ String.equal a b
+
+ let no_proxy_from_env_value no_proxy =
+ match no_proxy with
+ | None -> Patterns []
+ | Some no_proxy ->
+ if no_proxy = "*" then Wildcard
+ else
+ let patterns =
+ no_proxy
+ |> String.split_on_char ','
+ |> List.filter_map (fun pattern ->
+ if pattern = "" then None else Some (String.trim pattern))
+ |> List.map (fun pattern ->
+ match Ipaddr.of_string pattern with
+ | Ok addr -> Ipaddr_prefix (Ipaddr.Prefix.of_addr addr)
+ | Error _ -> (
+ match Ipaddr.Prefix.of_string pattern with
+ | Ok prefix -> Ipaddr_prefix prefix
+ | Error _ -> Name (trim_dots ~first_leading:true pattern)
+ ))
+ in
+ Patterns patterns
+
+ let check_no_proxy uri pattern =
+ let host = Uri.host_with_default ~default:"" uri in
+ if String.length host = 0 then true
+ else
+ match pattern with
+ | Wildcard -> true
+ | Patterns patterns -> (
+ match Ipaddr.of_string host with
+ | Ok hostip ->
+ List.exists
+ (function
+ | Name _ -> false
+ | Ipaddr_prefix network -> Ipaddr.Prefix.mem hostip network)
+ patterns
+ | Error _ ->
+ let name = trim_dots ~first_leading:false host in
+ List.exists
+ (function
+ | Ipaddr_prefix _ -> false
+ | Name pattern ->
+ let patternlen = String.length pattern
+ and namelen = String.length name in
+ if patternlen = namelen then
+ (* An exact (case-insensitive) match *)
+ strncasecompare pattern name namelen
+ else if patternlen < namelen then
+ (* pattern is a (case-insensitive) suffix of the host,
+ starting after any subdomain prefix.
+
+ E.g., [example.com] is a suffix of [www.example.com] and
+ [home.example.com], but not of [nonexample.com]. *)
+ let match_start = namelen - patternlen in
+ let host_suffix =
+ String.sub name match_start patternlen
+ in
+ name.[match_start - 1] = '.'
+ && strncasecompare pattern host_suffix patternlen
+ else false)
+ patterns)
+
+ type ('direct, 'tunnel) t = Direct of 'direct | Tunnel of 'tunnel
+
+ type ('direct, 'tunnel) servers = {
+ by_scheme : (string * ('direct, 'tunnel) t) list;
+ no_proxy_patterns : no_proxy_patterns;
+ default_tunnel : ('direct, 'tunnel) t option;
+ default_direct : ('direct, 'tunnel) t option;
+ }
+
+ (* Uri schemes that should be used with tunnelled proxies *)
+ let is_tunnel_scheme = function "https" -> true | _ -> false
+
+ let make_servers ~no_proxy_patterns ~(default_proxy : Uri.t option)
+ ~(scheme_proxies : (string * Uri.t) list) ~(direct : Uri.t -> 'direct)
+ ~(tunnel : Uri.t -> 'tunnel) : ('direct, 'tunnel) servers =
+ let by_scheme =
+ List.map
+ (fun (scheme, uri) ->
+ let proxy =
+ if is_tunnel_scheme scheme then Tunnel (tunnel uri)
+ else Direct (direct uri)
+ in
+ (scheme, proxy))
+ scheme_proxies
+ in
+ let no_proxy_patterns = no_proxy_from_env_value no_proxy_patterns in
+ let default_tunnel, default_direct =
+ match default_proxy with
+ | None -> (None, None)
+ | Some uri -> (Some (Tunnel (tunnel uri)), Some (Direct (direct uri)))
+ in
+ { by_scheme; no_proxy_patterns; default_tunnel; default_direct }
+
+ let get (servers : ('direct, 'tunnel) servers) (uri : Uri.t) :
+ ('direct, 'tunnel) t option =
+ if check_no_proxy uri servers.no_proxy_patterns then None
+ else
+ let scheme = Option.value ~default:"" (Uri.scheme uri) in
+ match List.assoc scheme servers.by_scheme with
+ | proxy -> Some proxy
+ | exception Not_found ->
+ if is_tunnel_scheme scheme then servers.default_tunnel
+ else servers.default_direct
+end
--- /dev/null
+(** Utilities for configuring and reasoning about forward proxies for client
+ requests *)
+module Forward : sig
+ type ('direct, 'tunnel) servers
+ (** A configuration for forward proxy servers *)
+
+ (** A forward proxying connection *)
+ type ('direct, 'tunnel) t =
+ | Direct of 'direct (** A proxy providing direct forwarding *)
+ | Tunnel of 'tunnel
+ (** A proxy using a tunnel (i.e. for https connections)) *)
+
+ val make_servers :
+ no_proxy_patterns:string option ->
+ default_proxy:Uri.t option ->
+ scheme_proxies:(string * Uri.t) list ->
+ direct:(Uri.t -> 'direct) ->
+ tunnel:(Uri.t -> 'tunnel) ->
+ ('direct, 'tunnel) servers
+ (** Create a new configuration of proxy servers
+
+ @param no_proxy_patterns
+ Disable proxies for specific hosts, specified as curl's [NO_PROXY].
+ @see <https://github.com/curl/curl/blob/master/docs/MANUAL.md#environment-variables>
+
+ @param default_proxy
+ The default proxy to use. Proxy for specific schemes have precedence
+ over this.
+
+ @param scheme_proxies
+ A mapping of (remote) scheme's to the desired proxy URI to user for
+ calls with that scheme.
+
+ @param direct
+ A function to create ['direct] connections for the given proxy URI.
+
+ @param tunnel
+ A function to create ['tunnel] connections for the given proxy URI. *)
+
+ val get : ('direct, 'tunnel) servers -> Uri.t -> ('direct, 'tunnel) t option
+ (** [get proxies uri] finds the proxy configured for the [uri], if there is
+ one given [proxies].
+
+ @param servers The configured proxy servers
+ @param uri The URI to find a proxy server for *)
+end
(package cohttp)
(action
(run ./test_path.exe)))
+
+(executable
+ (name test_proxy)
+ (modules test_proxy)
+ (forbidden_libraries base)
+ (libraries cohttp alcotest fmt ipaddr))
+
+(rule
+ (alias runtest)
+ (package cohttp)
+ (action
+ (run ./test_proxy.exe)))
--- /dev/null
+module Proxy = Cohttp.Proxy.Forward
+
+let http_proxy = "http://proxy.com"
+let https_proxy = "http://https-proxy.com"
+let fallback_proxy = "http://fallback-proxy.com"
+
+let proxies ~no_proxy_patterns =
+ Proxy.make_servers ~no_proxy_patterns
+ ~default_proxy:(Some (Uri.of_string fallback_proxy))
+ ~scheme_proxies:
+ [
+ ("http", Uri.of_string http_proxy); ("https", Uri.of_string https_proxy);
+ ]
+ ~direct:Uri.to_string ~tunnel:Uri.to_string
+
+let proxy =
+ let pp fmt = function
+ | Proxy.Direct s -> Format.fprintf fmt "Direct(%S)" s
+ | Proxy.Tunnel s -> Format.fprintf fmt "Tunnel(%S)" s
+ in
+ Alcotest.testable pp ( = )
+
+let select_http_proxy () =
+ let proxies = proxies ~no_proxy_patterns:None in
+ let expected = Some (Proxy.Direct http_proxy) in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://example.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg:"should select configured http proxy as Direct" ~actual ~expected
+
+let select_https_proxy () =
+ let proxies = proxies ~no_proxy_patterns:None in
+ let expected = Some (Proxy.Tunnel https_proxy) in
+ let actual = Proxy.get proxies @@ Uri.of_string "https://example.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg:"should select configured https proxy as Tunnel" ~actual ~expected
+
+let select_default_proxy () =
+ let proxies = proxies ~no_proxy_patterns:None in
+ let expected = Some (Proxy.Direct fallback_proxy) in
+ let actual = Proxy.get proxies @@ Uri.of_string "ftp://example.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg:"should select fallback proxy for unconfigured scheme" ~actual
+ ~expected
+
+let no_proxy_wildcard () =
+ let proxies = proxies ~no_proxy_patterns:(Some "*") in
+ let expected = None in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://example.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg:"should ensure no proxy is selected" ~actual ~expected
+
+let no_proxy_literal_pattern () =
+ let proxies = proxies ~no_proxy_patterns:(Some "example.com") in
+ let expected = None in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://example.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg:"should ensure example.com is not proxied" ~actual ~expected
+
+let no_proxy_list_of_patterns () =
+ let proxies = proxies ~no_proxy_patterns:(Some "foo.com,example.com") in
+
+ let msg = "should ensure example.com is not proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://example.com" in
+ Alcotest.(check' @@ option proxy) ~msg ~actual ~expected:None;
+
+ let msg = "should ensure foo.com is not proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://foo.com" in
+ Alcotest.(check' @@ option proxy) ~msg ~actual ~expected:None
+
+let no_proxy_subdomain_patterns () =
+ (* As per https://everything.curl.dev/usingcurl/proxies/env.html#no-proxy
+
+ > If a name in the exclusion list starts with a dot (.), then the name matches
+ that entire domain. For example .example.com matches both www.example.com and
+ home.example.com but not nonexample.com. *)
+ let proxies = proxies ~no_proxy_patterns:(Some ".example.com") in
+
+ let msg = "should ensure www.example.com is not proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://www.example.com" in
+ Alcotest.(check' @@ option proxy) ~msg ~actual ~expected:None;
+
+ let msg = "should ensure home.example.com is not proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://home.example.com" in
+ Alcotest.(check' @@ option proxy) ~msg ~actual ~expected:None;
+
+ let msg = "should ensure example.com is proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://example.com" in
+ Alcotest.(check' @@ option proxy) ~msg ~actual ~expected:None;
+
+ let msg = "nonexample.com should be proxied" in
+ let actual = Proxy.get proxies @@ Uri.of_string "http://nonexample.com" in
+ Alcotest.(check' @@ option proxy)
+ ~msg ~actual ~expected:(Some (Direct http_proxy))
+
+let () =
+ Alcotest.run "test_proxy"
+ [
+ ( "NO_PROXY",
+ [
+ ("wildcard pattern", `Quick, no_proxy_wildcard);
+ ("literal pattern", `Quick, no_proxy_literal_pattern);
+ ("list of patterns", `Quick, no_proxy_list_of_patterns);
+ ("subdomain patterns", `Quick, no_proxy_subdomain_patterns);
+ ] );
+ ( "scheme proxies",
+ [
+ ("selects http proxy", `Quick, select_http_proxy);
+ ("selects https proxy", `Quick, select_https_proxy);
+ ("selects default proxy", `Quick, select_default_proxy);
+ ] );
+ ]
(lang dune 3.8)
(name cohttp)
-(version v6.1.1)
+(version v6.2.0)
(license ISC)
(base64
(>= 3.1.0))
(fmt :with-test)
+ (ipaddr (>= 5.6.0))
(alcotest (and :with-test (>= 1.7.0)))))
(package
(cohttp-lwt
(= :version))
(cmdliner
- (>= 1.1.0))
+ (>= 2.0.0))
(lwt
(>= 3.0.0))
(conduit-lwt
stringext
(lwt
(>= 5.3.0))
+ (cmdliner
+ (and
+ :with-dev-setup
+ (>= 2.0.0)))
(uri
(and
:with-test
(>= 0.12))
(eio_main :with-test)
(mdx :with-test)
+ (ipaddr (>= 5.6.0))
logs
uri
(tls-eio (and :with-test (>= 1.0.0)))
"nixpkgs": "nixpkgs_2"
},
"locked": {
- "lastModified": 1734153276,
- "narHash": "sha256-/cvtpMFp0HArEpFi0PrPMsheauc3IJ7qWpSHnw8so2M=",
+ "lastModified": 1762899092,
+ "narHash": "sha256-Nl6547Q+Hw+RDV7cQnPmP6OTS7kncj9aN2Zx+HTlIeg=",
"owner": "nix-ocaml",
"repo": "nix-overlays",
- "rev": "4247b28ce426ccdea09a1ec014fa52785bc7ba1d",
+ "rev": "ccbb9339d0c245d3e406516c1da5bbd76568d278",
"type": "github"
},
"original": {
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1734100912,
- "narHash": "sha256-93T/KB1ppdhnaV4u5uSwO6HutSq2RzcnkqVX9YKYslE=",
+ "lastModified": 1762808364,
+ "narHash": "sha256-nwxa9s+cjXZyFuTdFSKP5enPmhLfVOnNLlMhF25Uyf4=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "2a7ebf12140f6d97941d5f8cc38e9323212ecbad",
+ "rev": "e1ce86c3e40327779390e98edab843d4a1cc9224",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "2a7ebf12140f6d97941d5f8cc38e9323212ecbad",
+ "rev": "e1ce86c3e40327779390e98edab843d4a1cc9224",
"type": "github"
}
},
outputs = { self, nixpkgs, flake-utils }:
flake-utils.lib.eachDefaultSystem (system:
let
- pkgs = (import nixpkgs {
- inherit system;
- overlays = [
- (final: prev: {
- ocamlPackages = prev.ocamlPackages.overrideScope' (oself: osuper: {
- ctypes-foreign = osuper.ctypes-foreign.overrideAttrs (_: { doCheck = false; });
- ctypes = osuper.ctypes.overrideAttrs (_: { doCheck = false; });
- mdx = osuper.mdx.override {
- # workaround for:
- # https://github.com/NixOS/nixpkgs/pull/241476/commits/1ed74f3536d29e5635d7f47a1d7b82a89f5a8077
- logs = oself.logs;
- };
- });
- })
- ];
+ pkgs = import nixpkgs { inherit system; };
+ ocamlPackages = pkgs.ocaml-ng.ocamlPackages_5_4.overrideScope (oself: osuper: {
+ ctypes-foreign = osuper.ctypes-foreign.overrideAttrs (_: { doCheck = false; });
+ ctypes = osuper.ctypes.overrideAttrs (_: { doCheck = false; });
+ mdx = (osuper.mdx.override {
+ # workaround for:
+ # https://github.com/NixOS/nixpkgs/pull/241476/commits/1ed74f3536d29e5635d7f47a1d7b82a89f5a8077
+ logs = oself.logs;
+ }).overrideAttrs (_: { doCheck = false; });
+ cmdliner = osuper.cmdliner.overrideAttrs (old: rec {
+ version = "2.1.0";
+ src = pkgs.fetchFromGitHub {
+ owner = "dbuenzli";
+ repo = "cmdliner";
+ rev = "v${version}";
+ sha256 = "sha256-ebe5I77zEKoehJ55ZszV0dQP4ZDfVpGXqDsEb2qEE24=";
+ };
+ });
});
- inherit (pkgs.ocamlPackages) buildDunePackage;
+ inherit (ocamlPackages) buildDunePackage;
pkg = attrs: buildDunePackage ({
version = "n/a";
src = ./. ;
duneVersion = "3";
doCheck = true;
} // attrs);
- ocamlformat = pkgs.ocamlformat_0_26_2;
+ ocamlformat = pkgs.ocamlformat_0_27_0;
in
- with pkgs.ocamlPackages; rec {
+ with ocamlPackages; rec {
packages = rec {
default = http;
http = pkg {
checkInputs = [
alcotest eio mdx ppx_here
tls-eio
- mirage-crypto-rng-eio
+ mirage-crypto-rng
];
propagatedBuildInputs = [ cohttp eio logs uri fmt ptime http ];
};
};
devShells.default = pkgs.mkShell {
inputsFrom = pkgs.lib.attrValues packages;
- buildInputs = [ ocamlformat ] ++ (with pkgs.ocamlPackages; [
+ buildInputs = [ ocamlformat ] ++ (with ocamlPackages; [
ocaml-lsp
]);
};
devShells.eio = pkgs.mkShell {
inputsFrom = [ cohttp-eio ];
- buildInputs = [ ocamlformat ] ++ (with pkgs; [
- ocamlPackages.ocaml-lsp gmp libev nmap curl
+ buildInputs = [ ocamlformat ocamlPackages.ocaml-lsp ] ++ (with pkgs; [
+ gmp libev nmap curl
]);
};
});
-version: "6.1.1"
+version: "6.2.0"
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "Type definitions of HTTP essentials"
projects / ocaml-cohttp.git / commitdiff