Mirage time variant

src/ipv6/ipv6.ml

@@ -24,7 +24,6 @@ open Lwt.Infix
 module Make (N : Mirage_net.S)
             (E : Ethernet.S)
             (R : Mirage_random.S)
-            (T : Mirage_time.S)
             (C : Mirage_clock.MCLOCK) = struct
   type ipaddr   = Ipaddr.V6.t
   type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
@@ -56,7 +55,7 @@ module Make (N : Mirage_net.S)
         | Some u, _ -> Lwt.wakeup_later u (); None
       in
       Lwt_list.iter_s (output_ign t) outs (* MCP: replace with propagation *) >>= fun () ->
-      T.sleep_ns (Duration.of_sec 1) >>= fun () ->
+      Mirage_time.sleep_ns (Duration.of_sec 1) >>= fun () ->
       loop u
     in
     loop (Some u)
@@ -155,7 +154,7 @@ module Make (N : Mirage_net.S)
           ~ipv4:(fun _ -> Lwt.return_unit)
           ~ipv6:(input t ~tcp:noop ~udp:noop ~default:(fun ~proto:_ -> noop))
       in
-      let timeout = T.sleep_ns (Duration.of_sec 3) in
+      let timeout = Mirage_time.sleep_ns (Duration.of_sec 3) in
       Lwt.pick [
         (* MCP: replace this error swallowing with proper propagation *)
         (Lwt_list.iter_s (output_ign t) outs >>= fun () ->

src/ipv6/ipv6.mli

@@ -17,7 +17,6 @@
 module Make (N : Mirage_net.S)
             (E : Ethernet.S)
             (R : Mirage_random.S)
-            (T : Mirage_time.S)
             (Clock : Mirage_clock.MCLOCK) : sig
   include Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t
   val connect :

src/stack-direct/tcpip_stack_direct.ml

@@ -135,7 +135,6 @@ module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.I
 end
 
 module MakeV4V6
-    (Time     : Mirage_time.S)
     (Random   : Mirage_random.S)
     (Netif    : Mirage_net.S)
     (Eth      : Ethernet.S)

src/stack-direct/tcpip_stack_direct.mli

@@ -21,7 +21,6 @@ module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.I
 end
 
 module MakeV4V6
-    (Time     : Mirage_time.S)
     (Random   : Mirage_random.S)
     (Netif    : Mirage_net.S)
     (Ethernet : Ethernet.S)

src/tcp/ack.ml

@@ -61,9 +61,9 @@ end
 
 
 (* Delayed ACKs *)
-module Delayed (Time:Mirage_time.S) : M = struct
+module Delayed : M = struct
 
-  module TT = Tcptimer.Make(Time)
+  module TT = Tcptimer.Make
 
   type delayed_r = {
     send_ack: Sequence.t Lwt_mvar.t;

src/tcp/ack.mli

@@ -26,4 +26,4 @@ end
 
 module Immediate : M
 
-module Delayed(T:Mirage_time.S) : M
+module Delayed : M

src/tcp/flow.ml

@@ -20,16 +20,16 @@ open Lwt.Infix
 let src = Logs.Src.create "tcp.pcb" ~doc:"Mirage TCP PCB module"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make(Ip: Tcpip.Ip.S)(Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK)(Random:Mirage_random.S) =
+module Make(Ip: Tcpip.Ip.S)(Clock:Mirage_clock.MCLOCK)(Random:Mirage_random.S) =
 struct
 
   module ACK = Ack.Immediate
-  module RXS = Segment.Rx(Time)(ACK)
-  module TXS = Segment.Tx(Time)(Clock)
-  module UTX = User_buffer.Tx(Time)(Clock)
+  module RXS = Segment.Rx(ACK)
+  module TXS = Segment.Tx(Clock)
+  module UTX = User_buffer.Tx(Clock)
   module WIRE = Wire.Make(Ip)
-  module STATE = State.Make(Time)
-  module KEEPALIVE = Keepalive.Make(Time)(Clock)
+  module STATE = State.Make
+  module KEEPALIVE = Keepalive.Make(Clock)
 
   type error = [ Tcpip.Tcp.error | WIRE.error]
 
@@ -678,7 +678,7 @@ struct
     let rxtime = match count with
       | 0 -> 3 | 1 -> 6 | 2 -> 12 | 3 -> 24 | _ -> 48
     in
-    Time.sleep_ns (Duration.of_sec rxtime) >>= fun () ->
+    Mirage_time.sleep_ns (Duration.of_sec rxtime) >>= fun () ->
     match hashtbl_find t.connects id with
     | None                -> Lwt.return_unit
     | Some (wakener, isn, _) ->

src/tcp/flow.mli

@@ -15,7 +15,6 @@
  *)
 
 module Make (IP:Tcpip.Ip.S)
-            (TM:Mirage_time.S)
             (C:Mirage_clock.MCLOCK)
             (R:Mirage_random.S) : sig
   include Tcpip.Tcp.S with type ipaddr = IP.ipaddr

src/tcp/keepalive.ml

@@ -49,7 +49,7 @@ let next ~configuration ~ns state =
       end
   end
 
-  module Make(T:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) = struct
+  module Make(Clock:Mirage_clock.MCLOCK) = struct
     type t = {
       configuration: Tcpip.Tcp.Keepalive.t;
       callback: ([ `SendProbe | `Close ] -> unit Lwt.t);
@@ -64,7 +64,7 @@ let next ~configuration ~ns state =
       let ns = Int64.sub (Clock.elapsed_ns ()) t.start in
       match next ~configuration:t.configuration ~ns t.state with
       | `Wait ns, state ->
-        T.sleep_ns ns >>= fun () ->
+        Mirage_time.sleep_ns ns >>= fun () ->
         t.state <- state;
         restart t
       | `SendProbe, state ->

src/tcp/keepalive.mli

@@ -44,7 +44,7 @@ val next: configuration:Tcpip.Tcp.Keepalive.t -> ns:int64 -> state -> action * s
     that we last received a packet [ns] nanoseconds ago and the new state
     of the connection *)
 
-module Make(T:Mirage_time.S)(Clock:Mirage_clock.MCLOCK): sig
+module Make(Clock:Mirage_clock.MCLOCK): sig
   type t
   (** A keep-alive timer *)
 

src/tcp/segment.ml

@@ -53,9 +53,9 @@ let rec reset_seq segs =
    It also looks for control messages and dispatches them to
    the Rtx queue to ack messages or close channels.
 *)
-module Rx(Time:Mirage_time.S)(ACK: Ack.M) = struct
+module Rx(ACK: Ack.M) = struct
   open Tcp_packet
-  module StateTick = State.Make(Time)
+  module StateTick = State.Make
 
   (* Individual received TCP segment
      TODO: this will change when IP fragments work *)
@@ -235,10 +235,10 @@ type tx_flags = (* At most one of Syn/Fin/Rst/Psh allowed *)
   | Rst
   | Psh
 
-module Tx (Time:Mirage_time.S) (Clock:Mirage_clock.MCLOCK) = struct
+module Tx (Clock:Mirage_clock.MCLOCK) = struct
 
-  module StateTick = State.Make(Time)
-  module TT = Tcptimer.Make(Time)
+  module StateTick = State.Make
+  module TT = Tcptimer.Make
   module TX = Window.Make(Clock)
 
   type ('a, 'b) xmit =

src/tcp/segment.mli

@@ -24,7 +24,7 @@
     the Rtx queue to ack messages or close channels.
 *)
 
-module Rx (T:Mirage_time.S)(ACK:Ack.M) : sig
+module Rx (ACK:Ack.M) : sig
 
   type segment = { header: Tcp_packet.t; payload: Cstruct.t }
   (** Individual received TCP segment *)
@@ -57,7 +57,7 @@ type tx_flags = No_flags | Syn | Fin | Rst | Psh
 (** Either Syn/Fin/Rst allowed, but not combinations *)
 
 (** Pre-transmission queue *)
-module Tx (Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) : sig
+module Tx (Clock:Mirage_clock.MCLOCK) : sig
 
   type ('a, 'b) xmit = flags:tx_flags -> wnd:Window.t -> options:Options.t list ->
     seq:Sequence.t -> Cstruct.t -> ('a, 'b) result Lwt.t

src/tcp/state.ml

@@ -92,14 +92,14 @@ let pp_tcpstate fmt = function
 
 let pp fmt t = pf fmt "{ %a }" pp_tcpstate t.state
 
-module Make(Time:Mirage_time.S) = struct
+module Make = struct
 
   let fin_wait_2_time = (* 60 *) Duration.of_sec 10
   let time_wait_time = (* 30 *) Duration.of_sec 2
 
   let rec finwait2timer t count timeout =
     Log.debug (fun fmt -> fmt "finwait2timer %Lu" timeout);
-    Time.sleep_ns timeout >>= fun () ->
+    Mirage_time.sleep_ns timeout >>= fun () ->
     match t.state with
     | Fin_wait_2 i ->
       Log.debug (fun f -> f "finwait2timer: Fin_wait_2");
@@ -116,7 +116,7 @@ module Make(Time:Mirage_time.S) = struct
 
   let timewait t twomsl =
     Log.debug (fun fmt -> fmt "timewait %Lu" twomsl);
-    Time.sleep_ns twomsl >>= fun () ->
+    Mirage_time.sleep_ns twomsl >>= fun () ->
     t.state <- Closed;
     Log.debug (fun fmt -> fmt "timewait on_close");
     t.on_close ();

src/tcp/state.mli

@@ -56,7 +56,7 @@ val on_close : t -> unit
 
 val pp: Format.formatter -> t -> unit
 
-module Make(Time : Mirage_time.S) : sig
+module Make : sig
   val fin_wait_2_time : int64
   val time_wait_time : int64
   val finwait2timer : t -> int -> int64 -> unit Lwt.t

src/tcp/tcptimer.ml

@@ -32,7 +32,7 @@ type t = {
   mutable running: bool;
 }
 
-module Make(Time:Mirage_time.S) = struct
+module Make = struct
   let t ~period_ns ~expire =
     let running = false in
     {period_ns; expire; running}
@@ -42,7 +42,7 @@ module Make(Time:Mirage_time.S) = struct
     Stats.incr_timer ();
     let rec aux t s =
       Log.debug (fun f -> f "timerloop: sleeping for %Lu ns" t.period_ns);
-      Time.sleep_ns t.period_ns >>= fun () ->
+      Mirage_time.sleep_ns t.period_ns >>= fun () ->
       t.expire s >>= function
       | Stoptimer ->
         Stats.decr_timer ();

src/tcp/tcptimer.mli

@@ -23,7 +23,7 @@ type tr =
   | Continue of Sequence.t
   | ContinueSetPeriod of (time * Sequence.t)
 
-module Make(T:Mirage_time.S) : sig
+module Make : sig
   val t : period_ns: time -> expire: (Sequence.t -> tr Lwt.t) -> t
 
   val start : t -> ?p:time -> Sequence.t -> unit Lwt.t

src/tcp/user_buffer.ml

@@ -116,9 +116,9 @@ end
    to decide how to throttle or breakup its data production with this
    information.
 *)
-module Tx(Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) = struct
+module Tx(Clock:Mirage_clock.MCLOCK) = struct
 
-  module TXS = Segment.Tx(Time)(Clock)
+  module TXS = Segment.Tx(Clock)
 
   type t = {
     wnd: Window.t;

src/tcp/user_buffer.mli

@@ -27,12 +27,12 @@ module Rx : sig
   val monitor: t -> int32 Lwt_mvar.t -> unit
 end
 
-module Tx(Time:Mirage_time.S)(Clock:Mirage_clock.MCLOCK) : sig
+module Tx(Clock:Mirage_clock.MCLOCK) : sig
 
   type t
 
   module TXS : sig
-    type t = Segment.Tx(Time)(Clock).t
+    type t = Segment.Tx(Clock).t
     val output : ?flags:Segment.tx_flags -> ?options:Options.t list -> t ->
       Cstruct.t -> unit Lwt.t
   end

tcpip.opam

@@ -30,8 +30,8 @@ depends: [
   "cstruct-lwt"
   "mirage-net" {>= "3.0.0"}
   "mirage-clock" {>= "3.0.0"}
-  "mirage-random" {>= "2.0.0"}
-  "mirage-time" {>= "2.0.0"}
+  "mirage-random" {>= "2.0.0" & < "4.0.0"}
+  "mirage-time" {>= "4.0.0"}
   "ipaddr" {>= "5.0.0"}
   "macaddr" {>="4.0.0"}
   "macaddr-cstruct"
@@ -48,7 +48,7 @@ depends: [
   "alcotest" {with-test & >="1.5.0"}
   "pcap-format" {with-test}
   "mirage-clock-unix" {with-test & >= "3.0.0"}
-  "mirage-random-test" {with-test & >= "0.1.0"}
+  "mirage-crypto-rng" {with-test & >= "0.11.0"}
   "ipaddr-cstruct"
   "macaddr-cstruct"
   "lru" {>= "0.3.0"}

test/dune

@@ -1,6 +1,6 @@
 (test
  (name test)
- (libraries alcotest mirage-random-test lwt.unix logs logs.fmt
+ (libraries alcotest mirage-crypto-rng mirage-crypto-rng.unix lwt.unix logs logs.fmt
    mirage-flow mirage-vnetif mirage-clock-unix pcap-format duration
    mirage-random arp arp.mirage ethernet tcpip.ipv4 tcpip.tcp tcpip.udp
    tcpip.stack-direct tcpip.icmpv4 tcpip.udpv4v6-socket tcpip.tcpv4v6-socket

test/low_level.ml

@@ -11,8 +11,8 @@ module VNETIF_STACK = Vnetif_common.VNETIF_STACK(Vnetif_backends.Basic)
 module Time = Vnetif_common.Time
 module V = Vnetif.Make(Vnetif_backends.Basic)
 module E = Ethernet.Make(V)
-module A = Arp.Make(E)(Time)
-module I = Static_ipv4.Make(Mirage_random_test)(Vnetif_common.Clock)(E)(A)
+module A = Arp.Make(E)
+module I = Static_ipv4.Make(Mirage_crypto_rng)(Vnetif_common.Clock)(E)(A)
 module Wire = Tcp.Wire
 module WIRE = Wire.Make(I)
 module Tcp_wire = Tcp.Tcp_wire

test/static_arp.ml

@@ -1,7 +1,7 @@
 open Lwt.Infix
 
-module Make(E : Ethernet.S)(Time : Mirage_time.S) = struct
-  module A = Arp.Make(E)(Time)
+module Make(E : Ethernet.S) = struct
+  module A = Arp.Make(E)
   (* generally repurpose A, but substitute input and query, and add functions
      for adding/deleting entries *)
   type error = A.error

test/test.ml

@@ -39,8 +39,7 @@ let run test () =
 
 let () =
   Printexc.record_backtrace true;
-  (* someone has to call Mirage_random_test.initialize () *)
-  Mirage_random_test.initialize ();
+  Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
   (* enable logging to stdout for all modules *)
   Logs.set_reporter (Logs_fmt.reporter ());
   Logs.set_level ~all:true (Some Logs.Debug);

test/test_deadlock.ml

@@ -10,13 +10,7 @@ module Client_log = (val Logs.src_log client_log : Logs.LOG)
 
 module TCPIP =
 struct
-  module RANDOM = Mirage_random_test
-
-  module TIME =
-  struct
-    type 'a io = 'a Lwt.t
-    let sleep_ns nanos = Lwt_unix.sleep (Int64.to_float nanos /. 1e9)
-  end
+  module RANDOM = Mirage_crypto_rng
 
   module MCLOCK = Mclock
 
@@ -25,14 +19,14 @@ struct
     module B      = Basic_backend.Make
     module NETIF  = Vnetif.Make(B)
     module ETHIF  = Ethernet.Make(NETIF)
-    module ARPV4  = Arp.Make(ETHIF)(TIME)
+    module ARPV4  = Arp.Make(ETHIF)
     module IPV4   = Static_ipv4.Make(RANDOM)(MCLOCK)(ETHIF)(ARPV4)
-    module IPV6   = Ipv6.Make(NETIF)(ETHIF)(RANDOM)(TIME)(MCLOCK)
+    module IPV6   = Ipv6.Make(NETIF)(ETHIF)(RANDOM)(MCLOCK)
     module IP     = Tcpip_stack_direct.IPV4V6(IPV4)(IPV6)
     module ICMPV4 = Icmpv4.Make(IPV4)
     module UDP    = Udp.Make(IP)(RANDOM)
-    module TCP    = Tcp.Flow.Make(IP)(TIME)(MCLOCK)(RANDOM)
-    module TCPIP  = Tcpip_stack_direct.MakeV4V6(TIME)(RANDOM)(NETIF)(ETHIF)(ARPV4)(IP)(ICMPV4)(UDP)(TCP)
+    module TCP    = Tcp.Flow.Make(IP)(MCLOCK)(RANDOM)
+    module TCPIP  = Tcpip_stack_direct.MakeV4V6(RANDOM)(NETIF)(ETHIF)(ARPV4)(IP)(ICMPV4)(UDP)(TCP)
   end
   open M
 
@@ -80,7 +74,7 @@ let test_digest netif1 netif2 =
   TCPIP.make `Server netif2 >>= fun server_stack ->
 
   let send_data () =
-    let data = Mirage_random_test.generate 100_000_000 |> Cstruct.to_string in
+    let data = Mirage_crypto_rng.generate 100_000_000 |> Cstruct.to_string in
     let t0   = Unix.gettimeofday () in
     TCPIP.TCP.create_connection
       TCPIP.(tcp @@ tcpip server_stack) (Ipaddr.V4 TCPIP.client_ip, port) >>= function

test/test_icmpv4.ml

@@ -7,7 +7,7 @@ module Time = Vnetif_common.Time
 module B = Basic_backend.Make
 module V = Vnetif.Make(B)
 module E = Ethernet.Make(V)
-module Static_arp = Static_arp.Make(E)(Time)
+module Static_arp = Static_arp.Make(E)
 
 open Lwt.Infix
 
@@ -18,10 +18,10 @@ type decomposed = {
   ethernet_header : Ethernet.Packet.t;
 }
 
-module Ip = Static_ipv4.Make(Mirage_random_test)(Mclock)(E)(Static_arp)
+module Ip = Static_ipv4.Make(Mirage_crypto_rng)(Mclock)(E)(Static_arp)
 module Icmp = Icmpv4.Make(Ip)
 
-module Udp = Udp.Make(Ip)(Mirage_random_test)
+module Udp = Udp.Make(Ip)(Mirage_crypto_rng)
 
 type stack = {
   backend : B.t;