@@ -441,18 +441,105 @@ struct
441441
442442 let ok () = Ok ()
443443
444- module Local = struct
444+ module Localhost = struct
445445 type t = {
446446 clock : Clock .t ;
447447 endpoint : Endpoint .t ;
448448 udp_nat : Udp_nat .t ;
449449 dns_ips : Ipaddr.V4 .t list ;
450450 }
451- (* * Represents the local machine including NTP and DNS servers *)
451+ (* * Proxies connections to services on localhost on the host *)
452452
453453 (* * Handle IPv4 datagrams by proxying them to a remote system *)
454454 let input_ipv4 t ipv4 = match ipv4 with
455455
456+ (* Respond to ICMP *)
457+ | Ipv4 { raw; payload = Icmp _ ; _ } ->
458+ let none ~src :_ ~dst :_ _ = Lwt. return_unit in
459+ let default ~proto ~src ~dst buf = match proto with
460+ | 1 (* ICMP *)
461+ Stack_icmpv4. input t.endpoint.Endpoint. icmpv4 ~src ~dst buf
462+ | _ ->
463+ Lwt. return_unit in
464+ Stack_ipv4. input t.endpoint.Endpoint. ipv4 ~tcp: none ~udp: none ~default raw
465+ > |= ok
466+
467+ (* UDP to localhost *)
468+ | Ipv4 { src; dst; ihl; dnf; raw; ttl;
469+ payload = Udp { src = src_port; dst = dst_port; len;
470+ payload = Payload payload; _ }; _ } ->
471+ let description =
472+ Fmt. strf " %a:%d -> %a:%d" Ipaddr.V4. pp_hum src src_port Ipaddr.V4. pp_hum
473+ dst dst_port
474+ in
475+ if Cstruct. len payload < len then begin
476+ Log. err (fun f -> f " %s: dropping because reported len %d actual len %d"
477+ description len (Cstruct. len payload));
478+ Lwt. return (Ok () )
479+ end else if dnf && (Cstruct. len payload > safe_outgoing_mtu) then begin
480+ Endpoint. send_icmp_dst_unreachable t.endpoint ~src ~dst ~src_port
481+ ~dst_port ~ihl raw
482+ > |= lift_ipv4_error
483+ end else begin
484+ (* [1] For UDP to our local address, rewrite the destination
485+ to localhost. This is the inverse of the rewrite
486+ below[2] *)
487+ let datagram =
488+ { Hostnet_udp. src = Ipaddr. V4 src, src_port;
489+ dst = Ipaddr. (V4 V4. localhost), dst_port; payload }
490+ in
491+ Udp_nat. input ~t: t.udp_nat ~datagram ~ttl ()
492+ > |= ok
493+ end
494+
495+ (* TCP to local ports *)
496+ | Ipv4 { src; dst;
497+ payload = Tcp { src = src_port; dst = dst_port; syn; raw;
498+ payload = Payload _; _ }; _ } ->
499+ let id =
500+ Stack_tcp_wire. v ~src_port: dst_port ~dst: src ~src: dst ~dst_port: src_port
501+ in
502+ Endpoint. input_tcp t.endpoint ~id ~syn
503+ (Ipaddr. V4 Ipaddr.V4. localhost, dst_port) raw
504+ > |= ok
505+ | _ ->
506+ Lwt. return (Ok () )
507+
508+ let create clock endpoint udp_nat dns_ips =
509+ let tcp_stack = { clock; endpoint; udp_nat; dns_ips } in
510+ let open Lwt.Infix in
511+ (* Wire up the listeners to receive future packets: *)
512+ Switch.Port. listen endpoint.Endpoint. netif
513+ (fun buf ->
514+ let open Frame in
515+ match parse [ buf ] with
516+ | Ok (Ethernet { payload = Ipv4 ipv4 ; _ } ) ->
517+ Endpoint. touch endpoint;
518+ (input_ipv4 tcp_stack (Ipv4 ipv4) > |= function
519+ | Ok () -> ()
520+ | Error e ->
521+ Log. err (fun l ->
522+ l " error while reading IPv4 input: %a"
523+ | _ ->
524+ Lwt. return_unit
525+ )
526+ > |= function
527+ | Ok () -> Ok tcp_stack
528+ | Error _ as e -> e
529+
530+ end
531+
532+ module Gateway = struct
533+ type t = {
534+ clock : Clock .t ;
535+ endpoint : Endpoint .t ;
536+ udp_nat : Udp_nat .t ;
537+ dns_ips : Ipaddr.V4 .t list ;
538+ }
539+ (* * Services offered by vpnkit to the internal network *)
540+
541+ let input_ipv4 t ipv4 = match ipv4 with
542+
456543 (* Respond to ICMP *)
457544 | Ipv4 { raw; payload = Icmp _ ; _ } ->
458545 let none ~src :_ ~dst :_ _ = Lwt. return_unit in
@@ -501,54 +588,22 @@ struct
501588 Udp_nat. input ~t: t.udp_nat ~datagram ~ttl ()
502589 > |= ok
503590
504- (* UDP to any other port: localhost *)
505- | Ipv4 { src; dst; ihl; dnf; raw; ttl;
506- payload = Udp { src = src_port; dst = dst_port; len;
507- payload = Payload payload; _ }; _ } ->
508- let description =
509- Fmt. strf " %a:%d -> %a:%d" Ipaddr.V4. pp_hum src src_port Ipaddr.V4. pp_hum
510- dst dst_port
511- in
512- if Cstruct. len payload < len then begin
513- Log. err (fun f -> f " %s: dropping because reported len %d actual len %d"
514- description len (Cstruct. len payload));
515- Lwt. return (Ok () )
516- end else if dnf && (Cstruct. len payload > safe_outgoing_mtu) then begin
517- Endpoint. send_icmp_dst_unreachable t.endpoint ~src ~dst ~src_port
518- ~dst_port ~ihl raw
519- > |= lift_ipv4_error
520- end else begin
521- (* [1] For UDP to our local address, rewrite the destination
522- to localhost. This is the inverse of the rewrite
523- below[2] *)
524- let datagram =
525- { Hostnet_udp. src = Ipaddr. V4 src, src_port;
526- dst = Ipaddr. (V4 V4. localhost), dst_port; payload }
527- in
528- Udp_nat. input ~t: t.udp_nat ~datagram ~ttl ()
529- > |= ok
530- end
531-
532- (* TCP to local ports *)
591+ (* HTTP proxy *)
533592 | Ipv4 { src; dst;
534593 payload = Tcp { src = src_port; dst = dst_port; syn; raw;
535594 payload = Payload _; _ }; _ } ->
536595 let id =
537596 Stack_tcp_wire. v ~src_port: dst_port ~dst: src ~src: dst ~dst_port: src_port
538597 in
539- (* local HTTP proxy *)
540- let callback = match ! http with
541- | None -> None
542- | Some http -> Http_forwarder. explicit_proxy_handler ~dst: (dst, dst_port) ~t: http
543- in
544- begin match callback with
545- | None ->
546- Endpoint. input_tcp t.endpoint ~id ~syn
547- (Ipaddr. V4 Ipaddr.V4. localhost, dst_port) raw
548- > |= ok
549- | Some cb ->
550- Endpoint. intercept_tcp_syn t.endpoint ~id ~syn (fun _ -> cb) raw
551- > |= ok
598+ begin match ! http with
599+ | None -> Lwt. return (Ok () )
600+ | Some http ->
601+ begin match Http_forwarder. explicit_proxy_handler ~dst: (dst, dst_port) ~t: http with
602+ | None -> Lwt. return (Ok () )
603+ | Some cb ->
604+ Endpoint. intercept_tcp_syn t.endpoint ~id ~syn (fun _ -> cb) raw
605+ > |= ok
606+ end
552607 end
553608 | _ ->
554609 Lwt. return (Ok () )
@@ -862,13 +917,11 @@ struct
862917 let local_arp_table = [
863918 c.Configuration. lowest_ip, client_macaddr;
864919 c.Configuration. gateway_ip, c.Configuration. server_macaddr;
920+ c.Configuration. host_ip, c.Configuration. server_macaddr;
865921 ] in
866922 Global_arp_ethif. connect switch
867923 >> = fun global_arp_ethif ->
868924
869- (* Listen on local IPs *)
870- let local_ips = [ c.Configuration. gateway_ip ] in
871-
872925 let dhcp = Dhcp. make ~configuration: c clock switch in
873926
874927 let endpoints = IPMap. empty in
@@ -915,7 +968,7 @@ struct
915968 virtual IP. This is the inverse of the rewrite above[1] *)
916969 let src =
917970 if Ipaddr.V4. compare src Ipaddr.V4. localhost = 0
918- then c.Configuration. gateway_ip
971+ then c.Configuration. host_ip
919972 else src in
920973 begin
921974 find_endpoint src >> = function
@@ -1027,21 +1080,39 @@ struct
10271080 | Ok (Ethernet { payload = Ipv4 ({ dst; _ } as ipv4 ); _ } ) ->
10281081 (* For any new IP destination, create a stack to proxy for
10291082 the remote system *)
1030- if List. mem dst local_ips then begin
1083+ if dst = c. Configuration. gateway_ip then begin
10311084 begin
10321085 let open Lwt_result.Infix in
10331086 find_endpoint dst >> = fun endpoint ->
10341087 Log. debug (fun f ->
1035- f " creating local TCP/IP proxy for %a" Ipaddr.V4. pp_hum dst);
1036- Local .local_ips
1088+ f " creating gateway TCP/IP proxy for %a" Ipaddr.V4. pp_hum dst);
1089+ Gateway .[ c. Configuration. gateway_ip ]
10371090 end >> = function
10381091 | Error e ->
10391092 Log. err (fun f ->
10401093 f " Failed to create a TCP/IP stack: %a" Switch.Port. pp_error e);
10411094 Lwt. return_unit
10421095 | Ok tcp_stack ->
10431096 (* inject the ethernet frame into the new stack *)
1044- Local. input_ipv4 tcp_stack (Ipv4 ipv4) > |= function
1097+ Gateway. input_ipv4 tcp_stack (Ipv4 ipv4) > |= function
1098+ | Ok () -> ()
1099+ | Error e ->
1100+ Log. err (fun f -> f " failed to read TCP/IP input: %a"
1101+ end else if dst = c.Configuration. host_ip then begin
1102+ begin
1103+ let open Lwt_result.Infix in
1104+ find_endpoint dst >> = fun endpoint ->
1105+ Log. debug (fun f ->
1106+ f " creating localhost TCP/IP proxy for %a" Ipaddr.V4. pp_hum dst);
1107+ Localhost. create clock endpoint udp_nat [ c.Configuration. host_ip ]
1108+ end >> = function
1109+ | Error e ->
1110+ Log. err (fun f ->
1111+ f " Failed to create a TCP/IP stack: %a" Switch.Port. pp_error e);
1112+ Lwt. return_unit
1113+ | Ok tcp_stack ->
1114+ (* inject the ethernet frame into the new stack *)
1115+ Localhost. input_ipv4 tcp_stack (Ipv4 ipv4) > |= function
10451116 | Ok () -> ()
10461117 | Error e ->
10471118 Log. err (fun f -> f " failed to read TCP/IP input: %a"
@@ -1245,7 +1316,11 @@ struct
12451316 Log. info (fun f -> f " Configuration %s" Configuration. to_string c));
12461317 let global_arp_table : arp_table = {
12471318 mutex = Lwt_mutex. create() ;
1248- table = [c.Configuration. gateway_ip, c.Configuration. server_macaddr];
1319+ table = [
1320+ c.Configuration. gateway_ip, c.Configuration. server_macaddr;
1321+ c.Configuration. host_ip, c.Configuration. server_macaddr;
1322+ ];
1323+
12491324 } in
12501325 let client_uuids : uuid_table = {
12511326 mutex = Lwt_mutex. create() ;
0 commit comments