adapt to mirage-nat 2.1.0 API (Nat_packet returns a Fragments.Cache.t - which is now a Lru.F.t)

This commit is contained in:
Hannes Mehnert 2020-02-08 15:58:37 +01:00
parent 554e73a46d
commit 88fec9fa49
3 changed files with 12 additions and 6 deletions

View File

@ -57,7 +57,9 @@ let input_arp ~fixed_arp ~iface request =
(** Handle an IPv4 packet from the client. *)
let input_ipv4 get_ts cache ~iface ~router packet =
match Nat_packet.of_ipv4_packet cache ~now:(get_ts ()) packet with
let cache', r = Nat_packet.of_ipv4_packet !cache ~now:(get_ts ()) packet in
cache := cache';
match r with
| Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message: %a" Nat_packet.pp_error e);
Lwt.return_unit
@ -84,7 +86,7 @@ let add_vif get_ts { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanu
Router.add_client router iface >>= fun () ->
Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface);
let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in
let fragment_cache = Fragments.Cache.create (256 * 1024) in
let fragment_cache = ref (Fragments.Cache.empty (256 * 1024)) in
Netback.listen backend ~header_size:Ethernet_wire.sizeof_ethernet (fun frame ->
match Ethernet_packet.Unmarshal.of_cstruct frame with
| Error err -> Log.warn (fun f -> f "Invalid Ethernet frame: %s" err); Lwt.return_unit

View File

@ -31,7 +31,7 @@ let main =
package "mirage-net-xen";
package "ipaddr" ~min:"4.0.0";
package "mirage-qubes" ~min:"0.8.0";
package "mirage-nat" ~min:"2.0.0";
package "mirage-nat" ~min:"2.1.0";
package "mirage-logs";
package "mirage-xen" ~min:"5.0.0";
]

View File

@ -16,7 +16,7 @@ type t = {
eth : Eth.t;
arp : Arp.t;
interface : interface;
fragments : Fragments.Cache.t;
mutable fragments : Fragments.Cache.t;
}
class netvm_iface eth mac ~my_ip ~other_ip : interface = object
@ -37,7 +37,11 @@ let listen t get_ts router =
Eth.input t.eth
~arpv4:(Arp.input t.arp)
~ipv4:(fun ip ->
match Nat_packet.of_ipv4_packet t.fragments ~now:(get_ts ()) ip with
let cache, r =
Nat_packet.of_ipv4_packet t.fragments ~now:(get_ts ()) ip
in
t.fragments <- cache;
match r with
| Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message from uplink: %a" Nat_packet.pp_error e);
Lwt.return_unit
@ -63,5 +67,5 @@ let connect config =
let interface = new netvm_iface eth netvm_mac
~my_ip:ip
~other_ip:config.Dao.uplink_netvm_ip in
let fragments = Fragments.Cache.create (256 * 1024) in
let fragments = Fragments.Cache.empty (256 * 1024) in
Lwt.return { net; eth; arp; interface ; fragments }