Merge pull request #322 from djs55/internal-ip

Separate the localhost proxy from internal services

Author: djs55

Makefile

@@ -42,7 +42,8 @@ vpnkit.exe:
 .PHONY: test
 test:
 	jbuilder build --dev src/hostnet_test/main.exe
-	./_build/default/src/hostnet_test/main.exe
+	# One test requires 1026 file descriptors
+	ulimit -n 1500 && ./_build/default/src/hostnet_test/main.exe
 
 .PHONY: OSS-LICENSES
 OSS-LICENSES:

scripts/common.sh

@@ -37,8 +37,6 @@ opam install $(ls -1 ${OPAM_REPO}/packages/upstream) -y
 OPAMVERBOSE=1 opam install --deps-only -t vpnkit -y
 
 OPAMVERBOSE=1 make
-# One test requires 1026 file descriptors
-ulimit -n 1500
 OPAMVERBOSE=1 make test
 OPAMVERBOSE=1 make artefacts
 OPAMVERBOSE=1 make OSS-LICENSES

src/bin/main.ml

@@ -339,9 +339,9 @@ let hvsock_addr_of_uri ~default_serviceid uri =
 
   let main
       socket_url port_control_url introspection_url diagnostics_url
-      max_connections vsock_path db_path db_branch dns http hosts host_names
+      max_connections vsock_path db_path db_branch dns http hosts host_names gateway_names
       listen_backlog port_max_idle_time debug
-      server_macaddr domain allowed_bind_addresses gateway_ip lowest_ip highest_ip
+      server_macaddr domain allowed_bind_addresses gateway_ip host_ip lowest_ip highest_ip
       dhcp_json_path mtu log_destination
     =
     let level =
@@ -358,19 +358,23 @@ let hvsock_addr_of_uri ~default_serviceid uri =
     end;
 
     let host_names = List.map Dns.Name.of_string @@ Astring.String.cuts ~sep:"," host_names in
+    let gateway_names = List.map Dns.Name.of_string @@ Astring.String.cuts ~sep:"," gateway_names in
+
     let dns_path, resolver = match dns with
     | None -> None, Configuration.default_resolver
     | Some file -> Some file, `Upstream in
     let server_macaddr = Macaddr.of_string_exn server_macaddr in
     let allowed_bind_addresses = Configuration.Parse.ipv4_list [] allowed_bind_addresses in
     let gateway_ip = Ipaddr.V4.of_string_exn gateway_ip in
+    let host_ip = Ipaddr.V4.of_string_exn host_ip in
     let lowest_ip = Ipaddr.V4.of_string_exn lowest_ip in
     let highest_ip = Ipaddr.V4.of_string_exn highest_ip in
     let configuration = {
       Configuration.default with
       max_connections;
       port_max_idle_time;
       host_names;
+      gateway_names;
       dns = Configuration.no_dns_servers;
       dns_path;
       http_intercept_path = http;
@@ -379,6 +383,7 @@ let hvsock_addr_of_uri ~default_serviceid uri =
       domain;
       allowed_bind_addresses;
       gateway_ip;
+      host_ip;
       lowest_ip;
       highest_ip;
       dhcp_json_path;
@@ -526,7 +531,15 @@ let host_names =
       "Comma-separated list of DNS names to map to the Host's virtual IP"
       ["host-names"]
   in
-  Arg.(value & opt string "vpnkit.host" doc)
+  Arg.(value & opt string "host.internal" doc)
+
+let gateway_names =
+  let doc =
+    Arg.info ~doc:
+      "Comma-separated list of DNS names to map to the gateway's virtual IP"
+      ["gateway-names"]
+  in
+  Arg.(value & opt string "gateway.internal" doc)
 
 let listen_backlog =
   let doc = "Specify a maximum listen(2) backlog. If no override is specified \
@@ -567,6 +580,14 @@ let gateway_ip =
   in
   Arg.(value & opt string (Ipaddr.V4.to_string Configuration.default_gateway_ip) doc)
 
+let host_ip =
+  let doc =
+    Arg.info ~doc:
+      "IP address which represents the host. Connections to this IP will be forwarded to localhost on the host."
+      [ "host-ip" ]
+  in
+  Arg.(value & opt string (Ipaddr.V4.to_string Configuration.default_host_ip) doc)
+
 let lowest_ip =
   let doc =
     Arg.info ~doc:
@@ -609,8 +630,8 @@ let command =
   Term.(pure main
         $ socket $ port_control_path $ introspection_path $ diagnostics_path
         $ max_connections $ vsock_path $ db_path $ db_branch $ dns $ http $ hosts
-        $ host_names $ listen_backlog $ port_max_idle_time $ debug
-        $ server_macaddr $ domain $ allowed_bind_addresses $ gateway_ip
+        $ host_names $ gateway_names $ listen_backlog $ port_max_idle_time $ debug
+        $ server_macaddr $ domain $ allowed_bind_addresses $ gateway_ip $ host_ip
         $ lowest_ip $ highest_ip $ dhcp_json_path $ mtu $ Logging.log_destination),
   Term.info (Filename.basename Sys.argv.(0)) ~version:"%%VERSION%%" ~doc ~man
 

src/hostnet/configuration.ml

@@ -41,21 +41,22 @@ type t = {
   domain: string option;
   allowed_bind_addresses: Ipaddr.V4.t list;
   gateway_ip: Ipaddr.V4.t;
+  host_ip: Ipaddr.V4.t;
   (* TODO: remove this from the record since it is not constant across all clients *)
   lowest_ip: Ipaddr.V4.t;
   highest_ip: Ipaddr.V4.t;
-  extra_dns: Ipaddr.V4.t list;
   dhcp_json_path: string option;
   dhcp_configuration: Dhcp_configuration.t option;
   mtu: int;
   http_intercept: Ezjsonm.value option;
   http_intercept_path: string option;
   port_max_idle_time: int;
   host_names: Dns.Name.t list;
+  gateway_names: Dns.Name.t list;
 }
 
 let to_string t =
-  Printf.sprintf "server_macaddr = %s; max_connection = %s; dns_path = %s; dns = %s; resolver = %s; domain = %s; allowed_bind_addresses = %s; gateway_ip = %s; lowest_ip = %s; highest_ip = %s; extra_dns = %s; dhcp_json_path = %s; dhcp_configuration = %s; mtu = %d; http_intercept = %s; http_intercept_path = %s; port_max_idle_time = %s; host_names = %s"
+  Printf.sprintf "server_macaddr = %s; max_connection = %s; dns_path = %s; dns = %s; resolver = %s; domain = %s; allowed_bind_addresses = %s; gateway_ip = %s; host_ip = %s; lowest_ip = %s; highest_ip = %s; dhcp_json_path = %s; dhcp_configuration = %s; mtu = %d; http_intercept = %s; http_intercept_path = %s; port_max_idle_time = %s; host_names = %s; gateway_name = %s"
     (Macaddr.to_string t.server_macaddr)
     (match t.max_connections with None -> "None" | Some x -> string_of_int x)
     (match t.dns_path with None -> "None" | Some x -> x)
@@ -64,24 +65,25 @@ let to_string t =
     (match t.domain with None -> "None" | Some x -> x)
     (String.concat ", " (List.map Ipaddr.V4.to_string t.allowed_bind_addresses))
     (Ipaddr.V4.to_string t.gateway_ip)
+    (Ipaddr.V4.to_string t.host_ip)
     (Ipaddr.V4.to_string t.lowest_ip)
     (Ipaddr.V4.to_string t.highest_ip)
-    (String.concat ", " (List.map Ipaddr.V4.to_string t.extra_dns))
     (match t.dhcp_json_path with None -> "None" | Some x -> x)
     (match t.dhcp_configuration with None -> "None" | Some x -> Dhcp_configuration.to_string x)
     t.mtu
     (match t.http_intercept with None -> "None" | Some x -> Ezjsonm.(to_string @@ wrap x))
     (match t.http_intercept_path with None -> "None" | Some x -> x)
     (string_of_int t.port_max_idle_time)
     (String.concat ", " (List.map Dns.Name.to_string t.host_names))
+    (String.concat ", " (List.map Dns.Name.to_string t.gateway_names))
 
 let no_dns_servers =
   Dns_forward.Config.({ servers = Server.Set.empty; search = []; assume_offline_after_drops = None })
 
-let default_lowest_ip = Ipaddr.V4.of_string_exn "192.168.65.2"
+let default_lowest_ip = Ipaddr.V4.of_string_exn "192.168.65.3"
 let default_gateway_ip = Ipaddr.V4.of_string_exn "192.168.65.1"
+let default_host_ip = Ipaddr.V4.of_string_exn "192.168.65.2"
 let default_highest_ip = Ipaddr.V4.of_string_exn "192.168.65.254"
-let default_extra_dns = []
 (* The default MTU is limited by the maximum message size on a Hyper-V
    socket. On currently available windows versions, we need to stay
    below 8192 bytes *)
@@ -90,6 +92,8 @@ let default_port_max_idle_time = 300
 (* random MAC from https://www.hellion.org.uk/cgi-bin/randmac.pl *)
 let default_server_macaddr = Macaddr.of_string_exn "F6:16:36:BC:F9:C6"
 let default_host_names = [ Dns.Name.of_string "vpnkit.host" ]
+let default_gateway_names = [ Dns.Name.of_string "gateway.internal" ]
+
 let default_resolver = `Host
 
 let default = {
@@ -101,16 +105,17 @@ let default = {
   domain = None;
   allowed_bind_addresses = [];
   gateway_ip = default_gateway_ip;
+  host_ip = default_host_ip;
   lowest_ip = default_lowest_ip;
   highest_ip = default_highest_ip;
-  extra_dns = default_extra_dns;
   dhcp_json_path = None;
   dhcp_configuration = None;
   mtu = default_mtu;
   http_intercept = None;
   http_intercept_path = None;
   port_max_idle_time = default_port_max_idle_time;
   host_names = default_host_names;
+  gateway_names = default_gateway_names;
 }
 
 module Parse = struct

src/hostnet/hostnet_dhcp.ml

@@ -46,7 +46,7 @@ module Make (Clock: Mirage_clock_lwt.MCLOCK) (Netif: Mirage_net_lwt.S) = struct
        resolved in the future *)
     let low_ip, high_ip =
       let open Ipaddr.V4 in
-      let all_static_ips = c.Configuration.gateway_ip :: c.Configuration.lowest_ip :: c.Configuration.extra_dns in
+      let all_static_ips = [ c.Configuration.gateway_ip; c.Configuration.lowest_ip ] in
       let highest = maximum_ip all_static_ips in
       let i32 = to_int32 highest in
       of_int32 @@ Int32.succ i32, of_int32 @@ Int32.succ @@ Int32.succ i32 in
@@ -73,7 +73,7 @@ module Make (Clock: Mirage_clock_lwt.MCLOCK) (Netif: Mirage_net_lwt.S) = struct
         | _, _ -> Configuration.default_domain in
       let options = [
         Dhcp_wire.Routers [ c.Configuration.gateway_ip ];
-        Dhcp_wire.Dns_servers (c.Configuration.gateway_ip :: c.Configuration.extra_dns);
+        Dhcp_wire.Dns_servers [ c.Configuration.gateway_ip ];
         Dhcp_wire.Ntp_servers [ c.Configuration.gateway_ip ];
         Dhcp_wire.Broadcast_addr (Ipaddr.V4.Prefix.broadcast prefix);
         Dhcp_wire.Subnet_mask (Ipaddr.V4.Prefix.netmask prefix);

src/hostnet/hostnet_dns.ml

@@ -135,16 +135,31 @@ let try_etc_hosts =
     end
   | _ -> None
 
-let try_builtins local_ip host_names question =
+let try_builtins builtin_names question =
   let open Dns.Packet in
-  match local_ip, question with
-  | Ipaddr.V4 local_ip, { q_class = Q_IN; q_type = (Q_A|Q_AAAA); q_name; _ }
-    when List.mem q_name host_names ->
-    Log.info (fun f ->
-        f "DNS: %s is a builtin: %a" (Dns.Name.to_string q_name)
-          Ipaddr.V4.pp_hum local_ip);
-    Some [ { name = q_name; cls = RR_IN; flush = false; ttl = 0l;
-             rdata = A local_ip } ]
+  match question with
+  | { q_class = Q_IN; q_type = (Q_A|Q_AAAA); q_name; _ } ->
+    let bindings = List.filter (fun (name, _) -> name = q_name) builtin_names in
+    let ipv4_rrs =
+      List.fold_left (fun acc (_, ip) ->
+        match ip with
+        | Ipaddr.V4 ipv4 -> { name = q_name; cls = RR_IN; flush = false; ttl = 0l; rdata = A ipv4 } :: acc
+        | _ -> acc
+      ) [] bindings in
+    let ipv6_rrs =
+      List.fold_left (fun acc (_, ip) ->
+        match ip with
+        | Ipaddr.V6 ipv6 -> { name = q_name; cls = RR_IN; flush = false; ttl = 0l; rdata = AAAA ipv6 } :: acc
+        | _ -> acc
+      ) [] bindings in
+    let rrs = if question.q_type = Q_A then ipv4_rrs else ipv6_rrs in
+    if rrs = [] then None else begin
+      Log.info (fun f ->
+        f "DNS: %s is a builtin: %s" (Dns.Name.to_string q_name)
+          (String.concat "; " (List.map (fun rr -> Dns.Packet.rr_to_string rr) rrs))
+      );
+      Some rrs
+    end
   | _ -> None
 
 module Make
@@ -191,7 +206,7 @@ struct
 
   type t = {
     local_ip: Ipaddr.t;
-    host_names: Dns.Name.t list;
+    builtin_names: (Dns.Name.t * Ipaddr.t) list;
     resolver: resolver;
   }
 
@@ -271,13 +286,13 @@ struct
     | None ->
       Random.int bound
 
-  let create ~local_address ~host_names =
+  let create ~local_address ~builtin_names =
     let local_ip = local_address.Dns_forward.Config.Address.ip in
     Log.info (fun f ->
-      let prefix = match host_names with
-        | [] -> "No DNS names"
-        | _ -> Printf.sprintf "DNS names [ %s ]" (String.concat ", " @@ List.map Dns.Name.to_string host_names) in
-      f "%s will map to local IP %s" prefix (Ipaddr.to_string local_ip));
+      let suffix = match builtin_names with
+        | [] -> "no builtin DNS names; everything will be forwarded"
+        | _ -> Printf.sprintf "builtin DNS names [ %s ]" (String.concat ", " @@ List.map (fun (name, ip) -> Dns.Name.to_string name ^ " -> " ^ (Ipaddr.to_string ip)) builtin_names) in
+      f "DNS server configured with %s" suffix);
     fun clock -> function
     | `Upstream config ->
       let open Dns_forward.Config.Address in
@@ -300,11 +315,11 @@ struct
       >>= fun dns_udp_resolver ->
       Dns_tcp_resolver.create ~gen_transaction_id ~message_cb config clock
       >>= fun dns_tcp_resolver ->
-      Lwt.return { local_ip; host_names;
+      Lwt.return { local_ip; builtin_names;
                    resolver = Upstream { dns_tcp_resolver; dns_udp_resolver } }
     | `Host ->
       Log.info (fun f -> f "Will use the host's DNS resolver");
-      Lwt.return { local_ip; host_names; resolver = Host }
+      Lwt.return { local_ip; builtin_names; resolver = Host }
 
   let answer t is_tcp buf =
     let open Dns.Packet in
@@ -327,7 +342,7 @@ struct
         | Some answers ->
           Lwt.return (Ok (marshal @@ reply answers))
         | None ->
-          match try_builtins t.local_ip t.host_names question with
+          match try_builtins t.builtin_names question with
           | Some answers ->
             Lwt.return (Ok (marshal @@ reply answers))
           | None ->

src/hostnet/hostnet_dns.mli

@@ -26,7 +26,7 @@ sig
 
   val create:
     local_address:Dns_forward.Config.Address.t ->
-    host_names:Dns.Name.t list ->
+    builtin_names:(Dns.Name.t * Ipaddr.t) list ->
     Clock.t -> Config.t -> t Lwt.t
   (** Create a DNS forwarding instance based on the given
       configuration, either [`Upstream config]: send DNS requests to