diff --git a/Dockerfile b/Dockerfile index a6b1c52..6b277c2 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,13 +1,13 @@ # Pin the base image to a specific hash for maximum reproducibility. # It will probably still work on newer images, though, unless Debian # changes some compiler optimisations (unlikely). -#FROM ocaml/opam2:debian-9-ocaml-4.04 -FROM ocaml/opam2@sha256:feebac4b6f9df9ed52ca1fe7266335cb9fdfffbdc0f6ba4f5e8603ece7e8b096 +#FROM ocaml/opam2:debian-9-ocaml-4.07 +FROM ocaml/opam2@sha256:5ff7e5a1d4ab951dcc26cca7834fa57dce8bb08d1d27ba67a0e51071c2197599 # Pin last known-good version for reproducible builds. # Remove this line (and the base image pin above) if you want to test with the # latest versions. -RUN git fetch origin && git reset --hard 1fa4c078f5b145bd4a455eb0a5559f761d0a94c0 && opam update +RUN git fetch origin && git reset --hard 95448cbb9fad7515e104222f92b3d1e0bee70ede && opam update RUN sudo apt-get install -y m4 libxen-dev pkg-config RUN opam install -y vchan xen-gnt mirage-xen-ocaml mirage-xen-minios io-page mirage-xen mirage mirage-nat mirage-qubes diff --git a/README.md b/README.md index 02dc576..b63222a 100644 --- a/README.md +++ b/README.md @@ -27,6 +27,9 @@ This took about 10 minutes on my laptop (it will be much quicker if you run it a The symlink step at the start isn't needed if your build VM is standalone. It gives Docker more disk space and avoids losing the Docker image cache when you reboot the Qube. +Note: the object files are stored in the `_build` directory to speed up incremental builds. +If you change the dependencies, you will need to delete this directory before rebuilding. + You can also build without Docker, as for any normal Mirage unikernel; see [the Mirage installation instructions](https://mirage.io/wiki/install) for details. diff --git a/build-with-docker.sh b/build-with-docker.sh index 7ba6fa6..8836e95 100755 --- a/build-with-docker.sh +++ b/build-with-docker.sh @@ -5,5 +5,5 @@ docker build -t qubes-mirage-firewall . echo Building Firewall... docker run --rm -i -v `pwd`:/home/opam/qubes-mirage-firewall qubes-mirage-firewall echo "SHA2 of build: $(sha256sum qubes_firewall.xen)" -echo "SHA2 last known: 3605a97fbdb9e699a9ceb9e43def8a3cdd04e5cefb48b5824df8f55e7f949203" +echo "SHA2 last known: 21bd3e48dbca42ea5327a4fc6e27f9fe1f35f97e65864fff64e7a7675191148c" echo "(hashes should match for released versions)" diff --git a/client_eth.ml b/client_eth.ml index 751274b..e8e20c1 100644 --- a/client_eth.ml +++ b/client_eth.ml @@ -30,7 +30,7 @@ let add_client t iface = if IpMap.mem ip t.iface_of_ip then ( (* Wait for old client to disappear before adding one with the same IP address. Otherwise, its [remove_client] call will remove the new client instead. *) - Log.info (fun f -> f "Waiting for old client %a to go away before accepting new one" Ipaddr.V4.pp_hum ip); + Log.info (fun f -> f "Waiting for old client %a to go away before accepting new one" Ipaddr.V4.pp ip); Lwt_condition.wait t.changed >>= aux ) else ( t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface; diff --git a/client_net.ml b/client_net.ml index 995b5f5..4b906e7 100644 --- a/client_net.ml +++ b/client_net.ml @@ -65,7 +65,7 @@ let input_ipv4 ~client_ip ~router packet = if src = client_ip then Firewall.ipv4_from_client router packet else ( Log.warn (fun f -> f "Incorrect source IP %a in IP packet from %a (dropping)" - Ipaddr.V4.pp_hum src Ipaddr.V4.pp_hum client_ip); + Ipaddr.V4.pp src Ipaddr.V4.pp client_ip); return () ) diff --git a/config.ml b/config.ml index 3f112fb..c115c1b 100644 --- a/config.ml +++ b/config.ml @@ -20,10 +20,12 @@ let main = ~packages:[ package "vchan"; package "cstruct"; + package "astring"; package "tcpip" ~sublibs:["stack-direct"; "xen"; "arpv4"] ~min:"3.1.0"; package "shared-memory-ring" ~min:"3.0.0"; package "netchannel" ~min:"1.8.0"; package "mirage-net-xen" ~min:"1.7.1"; + package "ipaddr" ~min:"3.0.0"; package "mirage-qubes"; package "mirage-nat"; package "mirage-logs"; diff --git a/firewall.ml b/firewall.ml index 337c5c8..98f5b21 100644 --- a/firewall.ml +++ b/firewall.ml @@ -18,7 +18,7 @@ let transmit_ipv4 packet iface = (fun () -> iface#writev Ethif_wire.IPv4 transport) (fun ex -> Log.warn (fun f -> f "Failed to write packet to %a: %s" - Ipaddr.V4.pp_hum iface#other_ip + Ipaddr.V4.pp iface#other_ip (Printexc.to_string ex)); Lwt.return () ) @@ -58,10 +58,10 @@ let pp_ports fmt {sport; dport} = Format.fprintf fmt "sport=%d dport=%d" sport dport let pp_host fmt = function - | `Client c -> Ipaddr.V4.pp_hum fmt (c#other_ip) - | `Unknown_client ip -> Format.fprintf fmt "unknown-client(%a)" Ipaddr.pp_hum ip + | `Client c -> Ipaddr.V4.pp fmt (c#other_ip) + | `Unknown_client ip -> Format.fprintf fmt "unknown-client(%a)" Ipaddr.pp ip | `NetVM -> Format.pp_print_string fmt "net-vm" - | `External ip -> Format.fprintf fmt "external(%a)" Ipaddr.pp_hum ip + | `External ip -> Format.fprintf fmt "external(%a)" Ipaddr.pp ip | `Firewall_uplink -> Format.pp_print_string fmt "firewall(uplink)" | `Client_gateway -> Format.pp_print_string fmt "firewall(client-gw)"