Add command-line argument --gateway-names

We now have

- `--host-names`: DNS names for the localhost proxied services
- `--gateway-names`: DNS names for the gateway IP (where DNS, NTP, HTTP
  proxies are running)

Signed-off-by: David Scott <[email protected]>

Author: djs55

src/bin/main.ml

@@ -339,7 +339,7 @@ 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 host_ip lowest_ip highest_ip
       dhcp_json_path mtu log_destination
@@ -358,6 +358,8 @@ 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
@@ -372,6 +374,7 @@ let hvsock_addr_of_uri ~default_serviceid uri =
       max_connections;
       port_max_idle_time;
       host_names;
+      gateway_names;
       dns = Configuration.no_dns_servers;
       dns_path;
       http_intercept_path = http;
@@ -528,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 \
@@ -619,7 +630,7 @@ 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
+        $ 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

@@ -52,10 +52,11 @@ type t = {
   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; 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"
+  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)
@@ -74,6 +75,7 @@ let to_string t =
     (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 })
@@ -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 = {
@@ -111,6 +115,7 @@ let default = {
   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_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

src/hostnet/slirp.ml

@@ -109,16 +109,16 @@ struct
   module Udp_nat = Hostnet_udp.Make(Host.Sockets)(Clock)(Host.Time)
   module Icmp_nat = Hostnet_icmp.Make(Host.Sockets)(Clock)(Host.Time)
 
-  let dns_forwarder ~local_address ~host_names clock =
-    Dns_forwarder.create ~local_address ~host_names clock (Dns_policy.config ())
+  let dns_forwarder ~local_address ~builtin_names clock =
+    Dns_forwarder.create ~local_address ~builtin_names clock (Dns_policy.config ())
 
   (* Global variable containing the global DNS configuration *)
   let dns =
     let ip = Ipaddr.V4 Configuration.default_gateway_ip in
     let local_address = { Dns_forward.Config.Address.ip; port = 0 } in
     ref (
       Clock.connect () >>= fun clock ->
-      dns_forwarder ~local_address ~host_names:[] clock
+      dns_forwarder ~local_address ~builtin_names:[] clock
     )
 
   (* Global variable containing the global HTTP proxy configuration *)
@@ -837,12 +837,12 @@ struct
     let get_nat_table_size t = Udp_nat.get_nat_table_size t.udp_nat
 
     let update_dns
-        ?(local_ip = Ipaddr.V4 Ipaddr.V4.localhost) ?(host_names = []) clock
+        ?(local_ip = Ipaddr.V4 Ipaddr.V4.localhost) ?(builtin_names = []) clock
       =
       let local_address =
         { Dns_forward.Config.Address.ip = local_ip; port = 0 }
       in
-      dns := dns_forwarder ~local_address ~host_names clock
+      dns := dns_forwarder ~local_address ~builtin_names clock
 
     let update_http ?http:http_config ?https ?exclude () =
       Http_forwarder.create ?http:http_config ?https ?exclude ()
@@ -1176,7 +1176,10 @@ struct
     let local_address =
       { Dns_forward.Config.Address.ip = Ipaddr.V4 local_ip; port = 0 }
     in
-    dns := dns_forwarder ~local_address ~host_names:c.Configuration.host_names clock
+    let builtin_names =
+      (List.map (fun name -> name, Ipaddr.V4 c.Configuration.gateway_ip) c.Configuration.gateway_names)
+      @ (List.map (fun name -> name, Ipaddr.V4 c.Configuration.host_ip) c.Configuration.host_names) in
+    dns := dns_forwarder ~local_address ~builtin_names clock
 
   let update_dhcp c =
     Log.info (fun f ->

src/hostnet/slirp.mli

@@ -46,7 +46,7 @@ sig
     val get_nat_table_size: connection -> int
     (** Return the number of active NAT table entries *)
 
-    val update_dns: ?local_ip:Ipaddr.t -> ?host_names:Dns.Name.t list ->
+    val update_dns: ?local_ip:Ipaddr.t -> ?builtin_names:(Dns.Name.t * Ipaddr.t) list ->
       Clock.t -> unit
     (** Update the DNS forwarder following a configuration change *)
 

src/hostnet_test/suite.ml

@@ -28,12 +28,12 @@ let test_dhcp_query () =
   in
   run ~pcap:"test_dhcp_query.pcap" t
 
-let set_dns_policy ?host_names use_host =
+let set_dns_policy ?builtin_names use_host =
   Mclock.connect () >|= fun clock ->
   Dns_policy.remove ~priority:3;
   Dns_policy.add ~priority:3
     ~config:(if use_host then `Host else Dns_policy.google_dns);
-  Slirp_stack.Debug.update_dns ?host_names clock
+  Slirp_stack.Debug.update_dns ?builtin_names clock
 
 let test_dns_query server use_host () =
   let t _ stack =
@@ -51,7 +51,7 @@ let test_dns_query server use_host () =
 let test_builtin_dns_query server use_host () =
   let name = "experimental.host.name.localhost" in
   let t _ stack =
-    set_dns_policy ~host_names:[ Dns.Name.of_string name ] use_host
+    set_dns_policy ~builtin_names:[ Dns.Name.of_string name, Ipaddr.V4 (Ipaddr.V4.localhost) ] use_host
     >>= fun () ->
     let resolver = DNS.create stack.Client.t in
     DNS.gethostbyname ~server resolver name >>= function