manage a dynamic uplink

[palainp]

Dear developpers, this PR wants to solve #146 [1] and #156 (or at least helps a bit). To do this I had to merge several source files (uplink, client_net, router, firewall) into a single one.
I also had to add some mutable fields :( and haven't figured out how to do that another way so far.
With all theses changes around I'll feel way more confident if any Ocaml guru wants to look further into dispatcher.ml. There is certainly room for improvements here :)

[1]: I didn't managed to set up properly a OpenBSD netvm, but with this PR it correctly sends packets to the désigned gw IP.

[palainp]

It doesn't have conflicts with main now. I'll wait for integration of latest mirage version in opam-repository for updating Dockerfile and the final hashsum to have a green CI :)

[palainp]

The last commit is needed as OpenBSD netvm (but connected as a client) can now send packets to us with other src addresses (EDIT: for reference https://forum.qubes-os.org/t/combination-of-openbsd-sys-net-miragefw/25457/24).

[hannesm]

thanks a lot, @palainp -- since this works, and also fixes the OpenBSD-netVM issue, we should merge and cut a release!? :D

[palainp]

Thank you @hannesm , this PR also allows to change netvm on the fly which hasn't been tested too much (at least by me), but it works as before when we don't change the netvm. Testing is on my todo short-term list.

[palainp]

I'll push some commits for updating to mirage 4.5.0 and latest ocaml-solo5 as soon as podman build it :)

Regarding the netvm change when qmf is running, I only have an issue caused when a user is doing something wrong:

qvm-prefs qmf netvm sys-net
qvm-prefs qmf netvm sys-net # <- this triggers a change in QubesDB but the netvm IP address has not been changed

This situation will freeze the traffic, and there is probably something than can be done in our code but a workaround it to change the netvm to another one, and all is fine even if we set back again to sys-net after that.

[palainp]

Just in case there is still some pending warning and I don't really know how to fix them:

File "dispatcher.ml", line 92, characters 36-42:
92 |   let create ~config ~clients ~nat ?uplink =
                                         ^^^^^^
Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
File "dispatcher.ml", line 103, characters 24-30:
103 |   let update t ~config ?uplink =
                              ^^^^^^
Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
File "dispatcher.ml", line 521, characters 12-35:
521 |             U.disconnect uplink.udp;
                  ^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 522, characters 12-34:
522 |             I.disconnect uplink.ip;
                  ^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 525, characters 12-37:
525 |             Arp.disconnect uplink.arp;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 526, characters 12-43:
526 |             UplinkEth.disconnect uplink.eth;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 527, characters 12-39:
527 |             Netif.disconnect uplink.net;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 92, characters 36-42:
92 |   let create ~config ~clients ~nat ?uplink =
                                         ^^^^^^
Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
File "dispatcher.ml", line 103, characters 24-30:
103 |   let update t ~config ?uplink =
                              ^^^^^^
Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
File "dispatcher.ml", line 521, characters 12-35:
521 |             U.disconnect uplink.udp;
                  ^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 522, characters 12-34:
522 |             I.disconnect uplink.ip;
                  ^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 525, characters 12-37:
525 |             Arp.disconnect uplink.arp;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 526, characters 12-43:
526 |             UplinkEth.disconnect uplink.eth;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.
File "dispatcher.ml", line 527, characters 12-39:
527 |             Netif.disconnect uplink.net;
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10 [non-unit-statement]: this expression should have type unit.

[hannesm]

The unerasable-optional-argument - redefine the order: let create ?uplink ~config ~clients ~nat should do the trick :)

The disconnect, I'm not sure about and will have to dig deeper.

[palainp]

Thank you @hannesm. I'm unsure why I tried with ?uplink, now it's ~uplink and it's still ok :)
Regarding the *.disconnect they return Lwt.return_unit so now it's fixed.

[hannesm]

I did a build with docker, and the result is:
SHA2 of build: 163991ea96842e03d378501a0be99057ad2489440aff8ae81d850624d98fd3f0 ./dist/qubes-firewall.xen

If you get the same hash, feel free to update it in the shell script, and merge :)

[palainp]

Thank you @hannesm I also have the same hashsum so it's ok!