diff --git a/charrua-client.opam b/charrua-client.opam index 4974a23..1544556 100644 --- a/charrua-client.opam +++ b/charrua-client.opam @@ -25,7 +25,7 @@ depends: [ "macaddr" {>= "4.0.0"} "mirage-random" {>= "2.0.0"} "mirage-clock" {>= "3.0.0"} - "mirage-time" {>= "2.0.0"} + "mirage-time" {>= "4.0.0"} "mirage-net" {>= "3.0.0"} "duration" "logs" diff --git a/client/lwt/dhcp_client_lwt.ml b/client/lwt/dhcp_client_lwt.ml index 0c62b9c..b945742 100644 --- a/client/lwt/dhcp_client_lwt.ml +++ b/client/lwt/dhcp_client_lwt.ml @@ -1,7 +1,7 @@ let src = Logs.Src.create "dhcp_client_lwt" module Log = (val Logs.src_log src : Logs.LOG) -module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) = struct +module Make(Random : Mirage_random.S)(Net : Mirage_net.S) = struct open Lwt.Infix type lease = Dhcp_wire.pkt @@ -25,7 +25,7 @@ module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) let c = ref client in let rec do_renew c t = - Time.sleep_ns @@ Duration.of_sec t >>= fun () -> + Mirage_time.sleep_ns @@ Duration.of_sec t >>= fun () -> match Dhcp_client.renew c with | `Noop -> Log.debug (fun f -> f "Can't renew this lease; won't try"); Lwt.return_unit | `Response (c, pkt) -> @@ -44,7 +44,7 @@ module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) Log.err (fun f -> f "Failed to write initial lease discovery request: %a" Net.pp_error e); Lwt.return_unit | Ok () -> - Time.sleep_ns sleep_interval >>= fun () -> + Mirage_time.sleep_ns sleep_interval >>= fun () -> match Dhcp_client.lease !c with | Some _lease -> Lwt.return_unit | None -> @@ -81,7 +81,7 @@ module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) c := s; match renew with | true -> - Time.sleep_ns @@ Duration.of_sec 1800 >>= fun () -> + Mirage_time.sleep_ns @@ Duration.of_sec 1800 >>= fun () -> do_renew !c 1800 | false -> push None; diff --git a/client/lwt/dhcp_client_lwt.mli b/client/lwt/dhcp_client_lwt.mli index 65f38e4..1542b6e 100644 --- a/client/lwt/dhcp_client_lwt.mli +++ b/client/lwt/dhcp_client_lwt.mli @@ -1,4 +1,4 @@ -module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) : sig +module Make(Random : Mirage_random.S)(Net : Mirage_net.S) : sig type lease = Dhcp_wire.pkt type t = lease Lwt_stream.t diff --git a/client/mirage/dhcp_client_mirage.ml b/client/mirage/dhcp_client_mirage.ml index 379b652..0d2143e 100644 --- a/client/mirage/dhcp_client_mirage.ml +++ b/client/mirage/dhcp_client_mirage.ml @@ -22,13 +22,13 @@ let config_of_lease lease = | [] -> Some (network, None) | hd::_ -> Some (network, Some hd) -module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Net : Mirage_net.S) = struct +module Make(Random : Mirage_random.S)(Net : Mirage_net.S) = struct open Lwt.Infix type t = (Ipaddr.V4.Prefix.t * Ipaddr.V4.t option) Lwt_stream.t let connect ?(requests : Dhcp_wire.option_code list option) net = - let module Lwt_client = Dhcp_client_lwt.Make(Random)(Time)(Net) in + let module Lwt_client = Dhcp_client_lwt.Make(Random)(Net) in Lwt_client.connect ~renew:false ?requests net >>= fun lease_stream -> Lwt.return @@ Lwt_stream.filter_map config_of_lease lease_stream end diff --git a/client/mirage/dhcp_client_mirage.mli b/client/mirage/dhcp_client_mirage.mli index 3af489a..ad4df25 100644 --- a/client/mirage/dhcp_client_mirage.mli +++ b/client/mirage/dhcp_client_mirage.mli @@ -1,4 +1,4 @@ -module Make(Random : Mirage_random.S)(Time : Mirage_time.S) (Network : Mirage_net.S) : sig +module Make(Random : Mirage_random.S)(Network : Mirage_net.S) : sig type t = (Ipaddr.V4.Prefix.t * Ipaddr.V4.t option) Lwt_stream.t val connect : ?requests:Dhcp_wire.option_code list -> Network.t -> t Lwt.t diff --git a/client/mirage/dhcp_ipv4.ml b/client/mirage/dhcp_ipv4.ml index 250be8b..b292054 100644 --- a/client/mirage/dhcp_ipv4.ml +++ b/client/mirage/dhcp_ipv4.ml @@ -1,8 +1,8 @@ open Lwt.Infix -module Make(R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Time : Mirage_time.S) (Network : Mirage_net.S) (E : Ethernet.S) (Arp : Arp.S) = struct +module Make(R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Network : Mirage_net.S) (E : Ethernet.S) (Arp : Arp.S) = struct (* for now, just wrap a static ipv4 *) - module DHCP = Dhcp_client_mirage.Make(R)(Time)(Network) + module DHCP = Dhcp_client_mirage.Make(R)(Network) include Static_ipv4.Make(R)(C)(E)(Arp) let connect net ethernet arp = DHCP.connect net >>= fun dhcp -> diff --git a/client/mirage/dhcp_ipv4.mli b/client/mirage/dhcp_ipv4.mli index 05d8867..6224e43 100644 --- a/client/mirage/dhcp_ipv4.mli +++ b/client/mirage/dhcp_ipv4.mli @@ -14,7 +14,7 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -module Make(R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Time : Mirage_time.S) (Network : Mirage_net.S) (E : Ethernet.S) (Arp : Arp.S) : sig +module Make(R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Network : Mirage_net.S) (E : Ethernet.S) (Arp : Arp.S) : sig include Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t val connect : Network.t -> E.t -> Arp.t -> t Lwt.t (** Connect to an ipv4 device using information from a DHCP lease. *) diff --git a/test/client/lwt/test_client_lwt.ml b/test/client/lwt/test_client_lwt.ml index 2e7e8f1..7028aa7 100644 --- a/test/client/lwt/test_client_lwt.ml +++ b/test/client/lwt/test_client_lwt.ml @@ -7,12 +7,6 @@ module No_random = struct let generate ?g:_ n = Cstruct.create n end -module No_time = struct - let sleep_ns n = - Format.printf "Ignoring request to wait %f seconds\n" (Duration.to_f n); - Lwt.pause () -end - module No_net = struct type error = Mirage_net.Net.error let pp_error = Mirage_net.Net.pp_error @@ -42,7 +36,7 @@ end let keep_trying () = Lwt_main.run @@ ( - let module Client = Dhcp_client_lwt.Make(No_random)(No_time)(No_net) in + let module Client = Dhcp_client_lwt.Make(No_random)(No_net) in let net = No_net.connect ~mac:(Macaddr.of_string_exn "c0:ff:ee:c0:ff:ee") () in let test = Client.connect net >>= Lwt_stream.get >|= function