Fix the qubes unikernel with tests, actually we can reach a website o…

…n QubeOS The issue was related to the Ethernet layer where we used wrong MAC address Co-authored: Hannes Mehnert <[email protected]>
robur-coop · May 30, 2024 · 9b690f3 · 9b690f3
1 parent 5687e35
commit 9b690f3
Show file tree

Hide file tree

Showing 4 changed files with 69 additions and 37 deletions.
diff --git a/clients.ml b/clients.ml
@@ -25,7 +25,7 @@ let create config =
 let default_gateway t = t.default_gateway
 
 let add_client t vif =
-  let (_, ip) = vif.Vif.ip in
+  let (_, ip) = vif.Vif.ipaddr in
   let rec go () =
     match Ipaddr.V4.Map.find_opt ip t.vif_of_ip with
     | Some old ->
@@ -42,7 +42,7 @@ let add_client t vif =
   go ()
 
 let rem_client t vif =
-  let (_, ip) = vif.Vif.ip in
+  let (_, ip) = vif.Vif.ipaddr in
   assert (Ipaddr.V4.Map.mem ip t.vif_of_ip);
   t.vif_of_ip <- Ipaddr.V4.Map.remove ip t.vif_of_ip;
   Lwt_condition.broadcast t.update ()
@@ -59,7 +59,7 @@ let classify t ip =
       | None -> `External ip
 
 let resolve t : host -> Ipaddr.t = function
-  | `Client vif -> Ipaddr.V4 (snd vif.Vif.ip)
+  | `Client vif -> Ipaddr.V4 (snd vif.Vif.ipaddr)
   | `Firewall -> Ipaddr.V4 t.default_gateway
   | `External addr -> addr
 
@@ -90,7 +90,7 @@ module ARP = struct
     let pf (f : ?header:string -> ?tags:_ -> _) fmt =
       f ("who-has %a? " ^^ fmt) Ipaddr.V4.pp req_ipv4
     in
-    if req_ipv4 = snd t.vif.Vif.ip then begin
+    if req_ipv4 = snd t.vif.Vif.ipaddr then begin
       Log.info (fun f -> pf f "ignoring request for client's own IP");
       None
     end else match lookup t req_ipv4 with

diff --git a/unikernel.ml b/unikernel.ml
@@ -13,7 +13,6 @@ module Main
     (KV : Mirage_kv.RO) =
 struct
   module O = Miragevpn_mirage.Make (R) (M) (P) (T) (S)
-  module I = Static_ipv4.Make (R) (M) (Vif.Client_ethernet) (Vif.Client_arp)
 
   type t =
     { ovpn : O.t
@@ -23,11 +22,6 @@ struct
     ; ic : (Vif.t * Nat_packet.t) Lwt_stream.t * ((Vif.t * Nat_packet.t) option -> unit)
     ; clients : Clients.t }
 
-  let log = Logs.Src.create "nat"
-
-  module L = (val Logs.src_log log : Logs.LOG)
-  module Private_routing = Routing.Make (L) (Vif.Client_arp)
-
   module Nat = struct
     let fail_to_parse ~protocol ~payload =
       Result.iter_error @@ fun msg ->
@@ -82,14 +76,21 @@ struct
 
     let output_private t packet =
       match payload_to_buffer packet with
-      | None -> Lwt.return_unit
-      | Some (buf, proto, hdr) -> Lwt.return_unit
-        (*
-        let ipaddr = Ipaddr.V4.localhost in
-        let* _ = I.write ipaddr ~ttl:hdr.Ipv4_packet.ttl
-          ~src:hdr.Ipv4_packet.src hdr.Ipv4_packet.dst proto (fun _ -> 0) [ buf ] in
+      | None ->
+        Logs.warn (fun m -> m "couldn't encode packet");
         Lwt.return_unit
-        *)
+      | Some (buf, proto, hdr) ->
+        let ipaddr = hdr.Ipv4_packet.dst in
+        match Clients.lookup t.clients ipaddr with
+        | Some vif ->
+          Logs.debug (fun m -> m "Sending a packet to %a" Ipaddr.V4.pp ipaddr);
+          let* r = Vif.Client_ip.write vif.Vif.ip ~ttl:hdr.Ipv4_packet.ttl
+            ~src:hdr.Ipv4_packet.src hdr.Ipv4_packet.dst proto (fun _ -> 0) [ buf ] in
+          (match r with
+          | Ok _ -> ();
+          | Error e -> Logs.warn (fun m -> m "error while sending: %a" Vif.Client_ip.pp_error e));
+          Lwt.return_unit
+        | None -> Logs.warn (fun m -> m "%a does not exist as a client" Ipaddr.V4.pp ipaddr); Lwt.return_unit
   end
 
   let local_network a b = Ipaddr.V4.compare a b = 0

diff --git a/vif.ml b/vif.ml
@@ -6,32 +6,60 @@ module Netbackend = Backend.Make (Xenstore.Make (Xen_os.Xs))
 
    [unikernel] <-[client_ethernet0]-> [client0]
                <-[client_ethernet.]-> [client.]
-               <-[client_eitherntn]-> [clientN]
+               <-[client_ethernetn]-> [clientN]
+*)
+module Client_ethernet = Ethernet.Make (Netbackend)
+module Underlying_arp = Arp.Make (Client_ethernet) (Xen_os.Time)
+module R = Mirage_crypto_rng_mirage.Make(Xen_os.Time)(Mclock)
 
-   Vif0 is:
+module Client_arp = struct
+  type t =
+    { arp : Underlying_arp.t
+    ; your_ip : Ipaddr.V4.t
+    ; my_mac : Macaddr.t
+    ; your_mac : Macaddr.t }
 
-   [sys-net] <-[vif0]-> [unikernel] *)
-module Client_ethernet = Ethernet.Make (Netbackend)
-module Client_arp = Arp.Make (Client_ethernet) (Xen_os.Time)
-module Vif0 = Ethernet.Make (Netif)
+  let connect ~my_mac your_ip ~your_mac ethernet =
+    let open Lwt.Syntax in
+    let* arp = Underlying_arp.connect ethernet in
+    Lwt.return { arp ; your_ip ; my_mac ; your_mac }
+
+  type error = Underlying_arp.error
+  let pp_error = Underlying_arp.pp_error
+
+  let disconnect _ = Lwt.return_unit
+  let get_ips t = Underlying_arp.get_ips t.arp
+  let set_ips t ips = Underlying_arp.set_ips t.arp ips
+  let remove_ip t ip = Underlying_arp.remove_ip t.arp ip
+  let add_ip t ip = Underlying_arp.add_ip t.arp ip
+  let input t buf = Underlying_arp.input t.arp buf
+  let pp ppf _ = Fmt.string ppf "arp"
+
+  let query t ip =
+    if Ipaddr.V4.compare t.your_ip ip = 0
+    then Lwt.return_ok t.your_mac else Lwt.return_ok t.my_mac
+end
+
+module Client_ip = Static_ipv4.Make(R)(Mclock)(Client_ethernet)(Client_arp)
 
-type t = {
-  ip : Ipaddr.V4.t * Ipaddr.V4.t;
-  mac : Macaddr.t * Macaddr.t;
-  ethernet : Client_ethernet.t;
-  arp : Client_arp.t;
-  domid : int;
-}
+type t =
+  { ipaddr : Ipaddr.V4.t * Ipaddr.V4.t
+  ; mac : Macaddr.t * Macaddr.t
+  ; ethernet : Client_ethernet.t
+  ; arp : Client_arp.t
+  ; ip : Client_ip.t
+  ; domid : int }
 
 let make backend { Dao.Client_vif.domid; device_id } ~gateway ipaddr =
   let open Lwt.Syntax in
   let* ethernet = Client_ethernet.connect backend in
-  let* arp = Client_arp.connect ethernet in
-  let ((_my_mac, _our_mac) as mac) =
+  let ((my_mac, your_mac) as mac) =
     (Client_ethernet.mac ethernet, Netbackend.frontend_mac backend)
   in
-  let ((_my_ip, _our_ip) as ip) = (gateway, ipaddr) in
-  Lwt.return { mac; ip; ethernet; arp; domid }
+  let ((_my_ip, your_ip) as ipaddr) = (gateway, ipaddr) in
+  let* arp = Client_arp.connect ~my_mac your_ip ~your_mac ethernet in
+  let* ip = Client_ip.connect ~cidr:(Ipaddr.V4.Prefix.make 0 your_ip) ~gateway ethernet arp in
+  Lwt.return { mac; ip; ethernet; arp; ipaddr; domid }
 
-let pp ppf { ip = _, ip; mac = _, mac; domid; _ } =
+let pp ppf { ipaddr = _, ip; mac = _, mac; domid; _ } =
   Fmt.pf ppf "dom%d:%a[%a]" domid Ipaddr.V4.pp ip Macaddr.pp mac
diff --git a/vif.mli b/vif.mli
@@ -1,12 +1,15 @@
 module Netbackend : module type of Backend.Make (Xenstore.Make (Xen_os.Xs))
 module Client_ethernet : module type of Ethernet.Make (Netbackend)
-module Client_arp : module type of Arp.Make (Client_ethernet) (Xen_os.Time)
+module R : module type of Mirage_crypto_rng_mirage.Make(Xen_os.Time)(Mclock)
+module Client_arp : Arp.S
+module Client_ip : module type of Static_ipv4.Make (R) (Mclock) (Client_ethernet) (Client_arp)
 
 type t = {
-  ip : Ipaddr.V4.t * Ipaddr.V4.t;
+  ipaddr : Ipaddr.V4.t * Ipaddr.V4.t;
   mac : Macaddr.t * Macaddr.t;
   ethernet : Client_ethernet.t;
   arp : Client_arp.t;
+  ip : Client_ip.t;
   domid : int;
 }