Skip to content

Commit 17c0b7e

Browse files
djs55djs55
authored
Merge pull request #320 from djs55/proxy-pass-through
Add more HTTP proxy modes
2 parents 012c07a + 0d40d76 commit 17c0b7e

File tree

4 files changed

+548
-74
lines changed

4 files changed

+548
-74
lines changed

‎src/hostnet/hostnet_http.ml

+238-62
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,19 @@ module Exclude = struct
8787

8888
end
8989

90+
let error_html title body =
91+
Printf.sprintf
92+
"<html><head>
93+
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
94+
<title>%s</title>
95+
</head><body>
96+
%s
97+
<br>
98+
<p>Server is <a href=\"https://github.com/moby/vpnkit\">moby/vpnkit</a></p>
99+
</body>
100+
</html>
101+
" title body
102+
90103
module Make
91104
(Ip: Mirage_protocols_lwt.IPV4)
92105
(Udp: Mirage_protocols_lwt.UDPV4)
@@ -105,22 +118,26 @@ module Make
105118
exclude: Exclude.t;
106119
}
107120

121+
let resolve_ip name_or_ip =
122+
match Ipaddr.of_string name_or_ip with
123+
| None ->
124+
let open Dns.Packet in
125+
let question =
126+
make_question ~q_class:Q_IN Q_A (Dns.Name.of_string name_or_ip)
127+
in
128+
Dns_resolver.resolve question
129+
>>= fun rrs ->
130+
(* Any IN record will do (NB it might be a CNAME) *)
131+
let rec find_ip = function
132+
| { cls = RR_IN; rdata = A ipv4; _ } :: _ ->
133+
Lwt.return (Ok (Ipaddr.V4 ipv4))
134+
| _ :: rest -> find_ip rest
135+
| [] -> errorf "Failed to lookup host: %s" name_or_ip in
136+
find_ip rrs
137+
| Some x -> Lwt.return (Ok x)
138+
108139
let parse_host_port x =
109140
(* host:port or [host]:port *)
110-
let find_host name_or_ip =
111-
match Ipaddr.of_string name_or_ip with
112-
| None ->
113-
let open Dns.Packet in
114-
let question =
115-
make_question ~q_class:Q_IN Q_A (Dns.Name.of_string name_or_ip)
116-
in
117-
begin Dns_resolver.resolve question >>= function
118-
| { cls = RR_IN; rdata = A ipv4; _ } :: _ ->
119-
Lwt.return (Ok (Ipaddr.V4 ipv4))
120-
| _ -> errorf "Failed to lookup host: %s" name_or_ip
121-
end
122-
| Some x -> Lwt.return (Ok x)
123-
in
124141
let parse_port port =
125142
match int_of_string port with
126143
| x -> Lwt.return (Ok x)
@@ -131,14 +148,14 @@ module Make
131148
match Uri.host uri, Uri.port uri with
132149
| Some host, Some port ->
133150
let open Lwt_result.Infix in
134-
find_host host >|= fun ip ->
151+
resolve_ip host >|= fun ip ->
135152
Some (ip, port)
136153
| _, _ ->
137154
match String.cuts ~sep:":" x with
138155
| [] -> errorf "Failed to find a :port in %s" x
139156
| [host; port] ->
140157
let open Lwt_result.Infix in
141-
find_host host >>= fun ip ->
158+
resolve_ip host >>= fun ip ->
142159
parse_port port >|= fun port ->
143160
Some (ip, port)
144161
| _ -> errorf "Failed to parse proxy address: %s" x
@@ -230,6 +247,51 @@ module Make
230247
Incoming.Response.write_body writer x >>= fun () ->
231248
proxy_body_response ~reader ~writer
232249

250+
(* Take a request and a pair (incoming, outgoing) of channels, send
251+
the request to the outgoing channel and then proxy back any response. *)
252+
let proxy_request ~description ~incoming ~outgoing ~req =
253+
let reader = Incoming.Request.make_body_reader req incoming in
254+
Outgoing.Request.write ~flush:true (fun writer ->
255+
match Incoming.Request.has_body req with
256+
| `Yes -> proxy_body_request ~reader ~writer
257+
| `No -> Lwt.return_unit
258+
| `Unknown ->
259+
Log.warn (fun f ->
260+
f "Request.has_body returned `Unknown: not sure what \
261+
to do");
262+
Lwt.return_unit
263+
) req outgoing
264+
>>= fun () ->
265+
Outgoing.Response.read outgoing >>= function
266+
| `Eof ->
267+
Log.warn (fun f -> f "%s: EOF" (description false));
268+
Lwt.return_unit
269+
| `Invalid x ->
270+
Log.warn (fun f ->
271+
f "%s: Failed to parse HTTP response: %s"
272+
(description false) x);
273+
Lwt.return_unit
274+
| `Ok res ->
275+
Log.info (fun f ->
276+
f "%s: %s %s"
277+
(description false)
278+
(Cohttp.Code.string_of_version res.Cohttp.Response.version)
279+
(Cohttp.Code.string_of_status res.Cohttp.Response.status));
280+
Log.debug (fun f ->
281+
f "%s" (Sexplib.Sexp.to_string_hum
282+
(Cohttp.Response.sexp_of_t res)));
283+
let reader = Outgoing.Response.make_body_reader res outgoing in
284+
Incoming.Response.write ~flush:true (fun writer ->
285+
match Incoming.Response.has_body res with
286+
| `Yes -> proxy_body_response ~reader ~writer
287+
| `No -> Lwt.return_unit
288+
| `Unknown ->
289+
Log.warn (fun f ->
290+
f "Response.has_body returned `Unknown: not sure \
291+
what to do");
292+
Lwt.return_unit
293+
) res incoming
294+
233295
let proxy_one ~dst ~t h incoming =
234296
Incoming.Request.read incoming >>= function
235297
| `Eof -> Lwt.return_unit
@@ -239,9 +301,14 @@ module Make
239301
Ipaddr.V4.pp_hum dst x);
240302
Lwt.return_unit
241303
| `Ok req ->
242-
(* The scheme from cohttp is missing. If we send to an HTTP
243-
proxy then we need it. *)
244-
let uri = Uri.with_scheme (Cohttp.Request.uri req) (Some "http") in
304+
(* An HTTP request will have a missing scheme so we fill it in.
305+
An HTTP proxy request will have a scheme already so we keep it.
306+
An HTTPS proxy request will be a CONNECT host:port *)
307+
let uri =
308+
let original = Cohttp.Request.uri req in
309+
match Uri.scheme original with
310+
| None -> Uri.with_scheme original (Some "http")
311+
| Some _ -> original in
245312
let address =
246313
if Exclude.matches dst (Some req) t.exclude
247314
then Ipaddr.V4 dst, 80 (* direct connection *)
@@ -271,48 +338,8 @@ module Make
271338
let req = { req with Cohttp.Request.resource = Uri.to_string uri } in
272339
Lwt.finalize (fun () ->
273340
let outgoing = Outgoing.C.create remote in
274-
let reader = Incoming.Request.make_body_reader req incoming in
275-
Outgoing.Request.write ~flush:true (fun writer ->
276-
match Incoming.Request.has_body req with
277-
| `Yes -> proxy_body_request ~reader ~writer
278-
| `No -> Lwt.return_unit
279-
| `Unknown ->
280-
Log.warn (fun f ->
281-
f "Request.has_body returned `Unknown: not sure what \
282-
to do");
283-
Lwt.return_unit
284-
) req outgoing
285-
>>= fun () ->
286-
Outgoing.Response.read outgoing >>= function
287-
| `Eof ->
288-
Log.warn (fun f -> f "EOF from %s" (string_of_address address));
289-
Lwt.return_unit
290-
| `Invalid x ->
291-
Log.warn (fun f ->
292-
f "Failed to parse HTTP response on port %s: %s"
293-
(string_of_address address) x);
294-
Lwt.return_unit
295-
| `Ok res ->
296-
Log.info (fun f ->
297-
f "%s: %s %s"
298-
(description false)
299-
(Cohttp.Code.string_of_version res.Cohttp.Response.version)
300-
(Cohttp.Code.string_of_status res.Cohttp.Response.status));
301-
Log.debug (fun f ->
302-
f "%s" (Sexplib.Sexp.to_string_hum
303-
(Cohttp.Response.sexp_of_t res)));
304-
let reader = Outgoing.Response.make_body_reader res outgoing in
305-
Incoming.Response.write ~flush:true (fun writer ->
306-
match Incoming.Response.has_body res with
307-
| `Yes -> proxy_body_response ~reader ~writer
308-
| `No -> Lwt.return_unit
309-
| `Unknown ->
310-
Log.warn (fun f ->
311-
f "Response.has_body returned `Unknown: not sure \
312-
what to do");
313-
Lwt.return_unit
314-
) res incoming
315-
) (fun () -> Socket.Stream.Tcp.close remote)
341+
proxy_request ~description ~incoming ~outgoing ~req
342+
) (fun () -> Socket.Stream.Tcp.close remote)
316343

317344
let http ~dst ~t h =
318345
let listeners _port =
@@ -431,12 +458,161 @@ module Make
431458
in
432459
Lwt.return listeners
433460

434-
let handle ~dst:(ip, port) ~t =
461+
let fetch_direct ~flow incoming =
462+
Incoming.Request.read incoming >>= function
463+
| `Eof -> Lwt.return_unit
464+
| `Invalid x ->
465+
Log.warn (fun f ->
466+
f "HTTP proxy failed to parse HTTP request: %s"
467+
x);
468+
Lwt.return_unit
469+
| `Ok req ->
470+
let uri = Cohttp.Request.uri req in
471+
let meth = Cohttp.Request.meth req in
472+
let port = match Uri.port uri with Some x -> x | None -> 80 in
473+
begin match Uri.host uri with
474+
| None ->
475+
Log.err (fun f ->
476+
f "HTTP proxy URI must contain a host element: %s"
477+
(Uri.to_string uri)
478+
);
479+
let res = Cohttp.Response.make ~version:`HTTP_1_1 ~status:`Bad_request () in
480+
Log.info (fun f -> f "HTTP proxy returning 400 Bad_request");
481+
Incoming.Response.write ~flush:true (fun writer ->
482+
Incoming.Response.write_body writer
483+
(error_html "ERROR: HTTP request is malformed"
484+
"The HTTP request must contain an absolute URI e.g. http://github.com/moby/vpnkit"
485+
)
486+
) res incoming
487+
| Some host ->
488+
resolve_ip host
489+
>>= function
490+
| Error (`Msg m) ->
491+
Log.err (fun f ->
492+
f "HTTP proxy failed to resolve %s: %s"
493+
(Uri.to_string uri) m
494+
);
495+
let res = Cohttp.Response.make ~version:`HTTP_1_1 ~status:`Service_unavailable () in
496+
Log.info (fun f -> f "HTTP proxy returning 503 Service_unavailable");
497+
Incoming.Response.write ~flush:true (fun writer ->
498+
Incoming.Response.write_body writer
499+
(error_html "ERROR: DNS resolution failed"
500+
(Printf.sprintf "The hostname %s could not be resolved." host)
501+
)
502+
) res incoming
503+
| Ok ipv4 ->
504+
let address = ipv4, port in
505+
let description outgoing =
506+
Printf.sprintf "HTTP proxy %s %s:%d Host:%s"
507+
(if outgoing then "-->" else "<--")
508+
(Ipaddr.to_string @@ fst address)
509+
(snd address)
510+
host
511+
in
512+
Log.info (fun f ->
513+
f "%s: %s %s"
514+
(description true)
515+
(Cohttp.(Code.string_of_method meth))
516+
(Uri.path uri));
517+
begin Socket.Stream.Tcp.connect address >>= function
518+
| Error _ ->
519+
Log.err (fun f ->
520+
f "%s: Failed to connect to %s" (description true) (string_of_address address));
521+
let res = Cohttp.Response.make ~version:`HTTP_1_1 ~status:`Service_unavailable () in
522+
Log.info (fun f -> f "%s: returning 503 Service_unavailable" (description false));
523+
Incoming.Response.write ~flush:true (fun writer ->
524+
Incoming.Response.write_body writer
525+
(error_html "ERROR: connection refused"
526+
(Printf.sprintf "The proxy could not connect to %s" (string_of_address address))
527+
)
528+
) res incoming
529+
| Ok remote ->
530+
Lwt.finalize (fun () ->
531+
Log.info (fun f ->
532+
f "%s: Successfully connected to %s" (description true) (string_of_address address));
533+
let outgoing = Outgoing.C.create remote in
534+
match Cohttp.Request.meth req with
535+
| `CONNECT ->
536+
(* return 200 OK and start a TCP proxy *)
537+
let response = "HTTP/1.1 200 OK\r\n\r\n" in
538+
Incoming.C.write_string incoming response 0 (String.length response);
539+
begin Incoming.C.flush incoming >>= function
540+
| Error _ ->
541+
Log.err (fun f -> f "%s: failed to return 200 OK" (description false));
542+
Lwt.return_unit
543+
| Ok () ->
544+
Lwt.join [
545+
a_t flow ~incoming ~outgoing;
546+
b_t remote ~incoming ~outgoing
547+
]
548+
end
549+
| _ ->
550+
(* The absolute URI used by the proxy should be converted back into
551+
a relative URI and a Host: header *)
552+
let req = { req with
553+
Cohttp.Request.headers = Cohttp.Header.add req.Cohttp.Request.headers "host" host;
554+
resource = Uri.path_and_query uri
555+
} in
556+
proxy_request ~description ~incoming ~outgoing ~req
557+
) (fun () -> Socket.Stream.Tcp.close remote)
558+
end
559+
end
560+
561+
(* A regular, non-transparent HTTP proxy implementation. *)
562+
let proxy () =
563+
let listeners _port =
564+
Log.debug (fun f -> f "HTTP TCP handshake complete");
565+
let f flow =
566+
Lwt.finalize (fun () ->
567+
let incoming = Incoming.C.create flow in
568+
let rec loop () = fetch_direct ~flow incoming >>= loop in
569+
loop ()
570+
) (fun () -> Tcp.close flow)
571+
in
572+
Some f
573+
in
574+
Lwt.return listeners
575+
576+
let tcp ~dst:(original_ip, original_port) ((ip, port) as address) =
577+
let listeners _port =
578+
let f flow =
579+
Lwt.finalize (fun () ->
580+
let description =
581+
Fmt.strf "%s:%d %s %s:%d" (Ipaddr.V4.to_string original_ip) original_port
582+
"-->" (Ipaddr.to_string ip) port
583+
in
584+
Log.debug (fun f -> f "%s: HTTP proxy TCP handshake complete" description);
585+
Socket.Stream.Tcp.connect address >>= function
586+
| Error _ ->
587+
Log.err (fun f ->
588+
f "%s: Failed to connect to %s" description (string_of_address address));
589+
Lwt.return_unit
590+
| Ok remote ->
591+
let outgoing = Outgoing.C.create remote in
592+
Lwt.finalize (fun () ->
593+
let incoming = Incoming.C.create flow in
594+
Lwt.join [
595+
a_t flow ~incoming ~outgoing;
596+
b_t remote ~incoming ~outgoing
597+
]
598+
) (fun () -> Socket.Stream.Tcp.close remote)
599+
) (fun () -> Tcp.close flow)
600+
in Some f
601+
in
602+
Lwt.return listeners
603+
604+
let transparent_proxy_handler ~dst:(ip, port) ~t =
435605
match port, t.http, t.https with
436606
| 80, Some h, _ -> Some (http ~dst:ip ~t h)
437607
| 443, _, Some h ->
438608
if Exclude.matches ip None t.exclude
439609
then None
440610
else Some (https ~dst:ip h)
441611
| _, _, _ -> None
612+
613+
let explicit_proxy_handler ~dst:(ip, port) ~t =
614+
match port, t.http, t.https with
615+
| 3128, Some h, _ -> Some (tcp ~dst:(ip, port) h)
616+
| 3128, None, _ -> Some (proxy ())
617+
| _, _, _ -> None
442618
end

‎src/hostnet/hostnet_http.mli

+9-1
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,15 @@ sig
3434
val to_json: t -> Ezjsonm.t
3535
(** [to_json t] encodes [t] into json *)
3636

37-
val handle: dst:(Ipaddr.V4.t * int) -> t:t ->
37+
val transparent_proxy_handler: dst:(Ipaddr.V4.t * int) -> t:t ->
3838
(int -> (Tcp.flow -> unit Lwt.t) option) Lwt.t option
39+
(** Intercept outgoing HTTP flows and redirect to the upstream proxy
40+
if one is defined. *)
41+
42+
val explicit_proxy_handler: dst:(Ipaddr.V4.t * int) -> t:t ->
43+
(int -> (Tcp.flow -> unit Lwt.t) option) Lwt.t option
44+
(** Intercept outgoing HTTP proxy flows and if an upstream proxy is
45+
defined, redirect to it, otherwise implement the proxy function
46+
ourselves. *)
3947

4048
end

0 commit comments

Comments
 (0)