# qubes-mirage-firewall — Architectural Audit

Scope: runtime stability, logic/routing correctness, and state/resource isolation
across the main packet loop (`unikernel.ml`, `dispatcher.ml`), the NAT/DNS shims
(`my_nat.ml`, `my_dns.ml`), client state (`client_eth.ml`), and the
`duniverse/mirage-qubes` + `duniverse/mirage-nat` integration.

Findings are ordered by severity. Every point is High priority per the brief.

---

## 1. No global `Lwt.async_exception_hook` — any uncaught async exception kills the whole firewall

* **Location:** `unikernel.ml:start` (missing installation); triggered from
  `dispatcher.ml:400` (`Lwt.async (fun () -> Lwt.pick [qubesdb_updater; listener])`)
  and every frame dispatch in `duniverse/mirage-net-xen/lib/backend.ml:188`
  (`Lwt.async (fun () -> fn data)`).
* **Priority:** High
* **Technical Description:** The unikernel never overrides
  `Lwt.async_exception_hook`. The Lwt default (see
  `duniverse/lwt/src/core/lwt.ml:1134`) prints the exception and calls
  `exit 2`. The per-client `listener` is run under `Lwt.async` and only rescues
  `Lwt.Canceled` — every other exception is re-raised with `Lwt.fail e`
  (`dispatcher.ml:395`). The listener body ends in
  `>|= or_raise "Listen on client interface" Netback.pp_error`
  (`dispatcher.ml:394`), and `or_raise` raises `Failure` (`fw_utils.ml:33`).
  So a backend error on *one* client's ring turns into an unhandled exception in
  an `Lwt.async` fiber.
* **System Impact:** A single client VM's interface fault (ring teardown race,
  map failure, unexpected Netback error) does not just drop that client — it
  reaches the default hook and calls `exit 2`, terminating the unikernel and
  disconnecting **every** client behind the firewall. This converts a
  per-client, recoverable condition into a total outage.
* **Refactoring Suggestion:**
  ```ocaml
  (* At the very start of [start ()], before any Lwt.async is scheduled. *)
  let () =
    Lwt.async_exception_hook := (fun ex ->
        Log.err (fun f ->
            f "Uncaught asynchronous exception (isolated, not fatal): %s"
              (Printexc.to_string ex)))
  ```
  This keeps a faulting fiber from taking down unrelated clients. Combine with
  narrowing the per-client `listener`/`qubesdb_updater` catch-alls so a fatal
  client error is logged and the client is cleaned up, rather than re-raised.

---

## 2. `Client_eth.remove_client` uses `assert` on externally-driven state → crash

* **Location:** `client_eth.ml:47` (`remove_client`), invoked from
  `dispatcher.ml:420` via `Cleanup.on_cleanup`.
* **Priority:** High
* **Technical Description:** `remove_client` does
  `assert (Ipaddr.V4.Map.mem ip t.iface_of_ip)` before removing. The cleanup
  callback that calls it is registered *before* the asynchronous
  `add_client router iface` has necessarily completed (`dispatcher.ml:420-428`),
  and `Client_eth.add_client` may block indefinitely in `aux ()`
  (`client_eth.ml:30-39`) waiting for a previous client with the same IP to go
  away. If the VM disconnects while `add_client` is still waiting, the cleanup
  runs `remove_client` for an `iface` that was never inserted, so the assertion
  fails. The assertion is also wrong under IP reuse: it can remove a *newer*
  client that legitimately holds the IP.
* **System Impact:** `assert` raises `Assert_failure`. `Cleanup.cleanup` runs
  synchronously inside the `Dao.watch_clients` callback (`dispatcher.ml:451`),
  which is part of the `net_listener` branch of `Lwt.choose`
  (`unikernel.ml:124`). The exception propagates out of the client-watch loop
  and tears down the main dispatcher — again a whole-firewall failure driven by
  ordinary VM lifecycle timing.
* **Refactoring Suggestion:** Make removal idempotent and identity-checked so it
  never asserts and never evicts a different client that reused the IP:
  ```ocaml
  let remove_client t iface =
    let ip = iface#other_ip in
    match Ipaddr.V4.Map.find_opt ip t.iface_of_ip with
    | Some cur when cur == iface ->        (* physical identity *)
        t.iface_of_ip <- Ipaddr.V4.Map.remove ip t.iface_of_ip;
        Lwt_condition.broadcast t.changed ()
    | Some _ ->
        (* IP already reassigned to a newer client; leave it in place. *)
        Log.info (fun f ->
            f "remove_client: %a already replaced, ignoring" Ipaddr.V4.pp ip)
    | None -> ()  (* add_client never completed; nothing to do *)
  ```

---

## 3. Startup network-config path uses `assert` instead of waiting for QubesDB

* **Location:** `unikernel.ml:79-96` (`network_config`).
* **Priority:** High
* **Technical Description:** When no command-line IPs are given, the config is
  read from QubesDB. If `netvm_ip` or `our_ip` come back as `0.0.0.0` (netvm not
  attached yet, or keys present but empty), the code logs an informational
  "aborting" message and then executes
  `assert (config.netvm_ip <> zero_ip && config.our_ip <> zero_ip)`
  (`unikernel.ml:89`). Note this differs from `Dao.read_network_config`, which
  only waits for *missing* keys (`dao.ml:159-168`) — a present-but-zero value
  passes that loop and lands on the assertion.
* **System Impact:** On boot ordering where the firewall starts before its netvm
  is assigned, `Assert_failure` crashes the unikernel instead of waiting, so the
  VM enters a crash/restart loop rather than coming up and converging once the
  netvm appears.
* **Refactoring Suggestion:** Treat zero-valued IPs the same as missing keys and
  wait for a QubesDB change, mirroring the existing retry loop:
  ```ocaml
  let rec await_valid_config bindings =
    let config = Dao.try_read_network_config bindings in
    if config.netvm_ip = zero_ip || config.our_ip = zero_ip then begin
      Log.warn (fun f ->
          f "netvm/our IP not configured yet; waiting for QubesDB change...");
      Qubes.DB.after qubesDB bindings >>= await_valid_config
    end else Lwt.return config
  in
  await_valid_config (Qubes.DB.bindings qubesDB)
  ```
  (Requires exposing `try_read_network_config`, or adding a
  `read_network_config` variant that also rejects zero addresses.)

---

## 4. `Memory_pressure.status` runs `Gc.full_major` on the per-packet hot path

* **Location:** `memory_pressure.ml:14-21`, called from
  `dispatcher.ml:240` (`ipv4_from_client`) and `dispatcher.ml:239`
  (`ipv4_from_netvm`) — i.e. once per forwarded packet.
* **Priority:** High
* **Technical Description:** `status ()` returns `` `Ok `` when free/heap > 0.5.
  Otherwise it unconditionally runs `Gc.full_major (); Xen_os.Memory.trim ()`
  and re-measures, declaring `` `Memory_critical `` only if free < 0.6. There is
  no hysteresis or rate limiting: whenever the free fraction sits in the
  ~0.4–0.6 band, *every single packet* triggers a full major GC plus heap trim.
* **System Impact:** Under sustained moderate memory usage the firewall performs
  a stop-the-world `full_major` per packet, collapsing throughput and inflating
  latency by orders of magnitude — the kind of stall that can look like a hang
  or trip watchdogs, precisely when the system is already stressed.
* **Refactoring Suggestion:** Decouple the expensive reclaim from the fast path;
  rate-limit the forced GC and add hysteresis:
  ```ocaml
  let last_gc = ref 0L
  let min_gc_interval_ns = 1_000_000_000L  (* at most once/sec *)

  let status () =
    let stats = Xen_os.Memory.quick_stat () in
    if fraction_free stats > 0.5 then `Ok
    else begin
      let now = Mirage_mtime.elapsed_ns () in
      if Int64.sub now !last_gc > min_gc_interval_ns then begin
        last_gc := now;
        Gc.full_major ();
        Xen_os.Memory.trim ()
      end;
      if fraction_free (Xen_os.Memory.quick_stat ()) < 0.6
      then `Memory_critical else `Ok
    end
  ```

---

## 5. Shared DNS request table keyed only by 16-bit txid — collisions silently lose queries

* **Location:** `my_dns.ml:17-38` (`requests`, `read`) and `my_dns.ml:60-77`
  (`send_recv`).
* **Priority:** High
* **Technical Description:** In-flight DNS queries share one
  `Lwt_condition.t IM.t` keyed by the DNS transaction id
  (`ctx.requests <- IM.add id cond ctx.requests`, `my_dns.ml:69`). If two
  resolutions are in flight with the same id, the second `IM.add` overwrites the
  first's condition variable, so the first waiter is never signalled and only
  unblocks via timeout. On completion each caller does `IM.remove id`
  (`my_dns.ml:75`), so the loser also deletes the winner's live entry. `read`
  (`my_dns.ml:31-38`) matches responses purely by the leading 16-bit id and
  broadcasts to whatever condition currently occupies that slot — with no check
  that the response corresponds to that specific outstanding query.
* **System Impact:** Concurrent `dnsname=` rule resolutions (all issued from the
  firewall's own resolver) can drop each other, causing spurious rule-resolution
  failures. Because `matches_dest` treats an unresolved name as `` `No_match ``
  (`rules.ml:65-69`), a lost DNS reply degrades to silently *not matching an
  allow rule* — traffic the user intended to permit is dropped, and matching
  becomes nondeterministic under load.
* **Refactoring Suggestion:** Key outstanding requests by a monotonically unique
  token rather than the wire id, and reject a duplicate id instead of
  clobbering:
  ```ocaml
  match IM.find_opt id ctx.requests with
  | Some _ ->
      (* id already outstanding; force a fresh id upstream instead of
         overwriting the existing waiter *)
      Lwt.return (Error (`Msg "duplicate DNS transaction id in flight"))
  | None ->
      let cond = Lwt_condition.create () in
      ctx.requests <- IM.add id cond ctx.requests;
      ...
  ```
  A more robust fix threads a private per-request key and verifies the response
  question section before broadcasting.

---

## 6. `My_nat.free_udp_port` last-resort fallback shares one port with no eviction

* **Location:** `my_nat.ml:40-57` (`free_udp_port`), `my_nat.ml:59` (`dns_port`).
* **Priority:** High
* **Technical Description:** After 10 failed attempts to find a free source
  port, `free_udp_port` returns `(t.last_resort_port, Fun.id)` — a fixed port
  with a no-op eviction closure, and it is *not* added to `udp_dns`. Multiple
  concurrent DNS queries that hit the fallback therefore all share
  `last_resort_port`. If they target the same resolver, their NAT 5-tuples
  `(src, dst, src_port, dst_port)` collide, and `dns_port` (`my_nat.ml:59`)
  treats that single port as belonging to DNS permanently.
* **System Impact:** Under port pressure, DNS responses can be routed to the
  wrong outstanding query (mixing state between logically separate lookups) or
  fail NAT insertion, undermining the isolation the NAT table is meant to
  provide. The fixed reserved port also permanently narrows the usable ephemeral
  range.
* **Refactoring Suggestion:** Treat exhaustion as a hard failure the caller must
  handle rather than silently multiplexing onto one shared port:
  ```ocaml
  let free_udp_port t ~src ~dst ~dst_port =
    let rec go retries =
      if retries = 0 then None
      else
        match pick_free_port t `Udp with
        | None -> go (retries - 1)
        | Some src_port ->
            if Nat.is_port_free t.table `Udp ~src ~dst ~src_port ~dst_port then begin
              t.udp_dns <- S.add src_port t.udp_dns;
              Some (src_port, fun () -> t.udp_dns <- S.remove src_port t.udp_dns)
            end else go (retries - 1)
    in
    go 10
  (* send_recv then reports Error (`Msg "no free UDP port") instead of colliding. *)
  ```

---

## 7. `specialtarget=dns` combined with an explicit `proto=` bypasses the DNS destination/port restriction

* **Location:** `rules.ml:22-49` (`Classifier.matches_proto`).
* **Priority:** High
* **Technical Description:** The match is structured on
  `(rule.proto, rule.specialtarget)`. The `` `dns `` special target is only
  enforced in the `None, Some `dns` arm (destination must be in `dns_servers`
  and port must be 53). As soon as `rule.proto` is `Some _`, the
  `Some rule_proto, _` arm matches and **ignores `specialtarget` entirely** —
  the destination-IP and port-53 constraints are dropped, and with
  `dstports = None` the rule matches that protocol to *any* destination/port.
* **System Impact:** A rule the user wrote to scope traffic to the DNS resolvers
  (e.g. `proto=udp specialtarget=dns`) is silently widened to allow that
  protocol to every destination. This is a routing/boundary-enforcement
  correctness defect: the configured firewall policy is more permissive than the
  administrator specified.
* **Refactoring Suggestion:** When `specialtarget = Some `dns`, apply the DNS
  destination/port constraint regardless of whether `proto` is set:
  ```ocaml
  let matches_proto rule dns_servers packet =
    let dns_ok () =
      List.mem packet.ipv4_header.Ipv4_packet.dst dns_servers
      && (match packet.transport_header with
          | `TCP h -> h.Tcp.Tcp_packet.dst_port = dns_port
          | `UDP h -> h.Udp_packet.dst_port = dns_port
          | _ -> false)
    in
    match rule.Q.proto, rule.Q.specialtarget with
    | _, Some `dns when not (dns_ok ()) -> false
    | None, (None | Some `dns) -> true
    | Some rule_proto, _ -> (* existing proto/port matching *) ...
  ```

---

## Notes / lower-confidence observations

* `dispatcher.ml:331-333` intentionally re-routes a client frame whose source is
  the netvm IP through `ipv4_from_netvm` (documented BSD-gateway case). Correct,
  but worth a comment that it relies on the earlier source-IP validation.
* `duniverse/mirage-qubes/lib/dB.ml:99` logs "fatal database de-synchronization"
  on `rm` of an absent key but continues; acceptable, not a crash.
* `Cleanup.cleanup` (`cleanup.ml`) runs callbacks synchronously with no
  per-callback exception guard; if any cleanup raises (see finding 2) subsequent
  cleanups are skipped. Wrapping each callback in a `try … with` would make
  teardown robust.