IP: add get_cidr : t -> cidr list

src/core/ip.ml

@@ -17,6 +17,8 @@ module type S = sig
   val pp_error: error Fmt.t
   type ipaddr
   val pp_ipaddr : ipaddr Fmt.t
+  type cidr
+  val pp_cidr : cidr Fmt.t
   type t
   val disconnect : t -> unit Lwt.t
   type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
@@ -30,5 +32,6 @@ module type S = sig
   val pseudoheader : t -> ?src:ipaddr -> ipaddr -> proto -> int -> Cstruct.t
   val src: t -> dst:ipaddr -> ipaddr
   val get_ip: t -> ipaddr list
+  val get_cidr: t -> cidr list
   val mtu: t -> dst:ipaddr -> int
 end

src/core/ip.mli

@@ -28,6 +28,12 @@ module type S = sig
   val pp_ipaddr : ipaddr Fmt.t
   (** [pp_ipaddr] is the pretty-printer for IP addresses. *)
 
+  type cidr
+  (** The type for the IP address and netmask. *)
+
+  val pp_cidr : cidr Fmt.t
+  (** [pp_cidr] is the pretty-printer for the CIDR. *)
+
   type t
   (** The type representing the internal state of the IP layer. *)
 
@@ -78,7 +84,12 @@ module type S = sig
   val get_ip: t -> ipaddr list
   (** Get the IP addresses associated with this interface. For IPv4, only
       one IP address can be set at a time, so the list will always be of
-      length 1 (and may be the default value, 0.0.0.0). *)
+      length 1 (and may be the default value, [[10.0.0.2]]). *)
+
+  val get_cidr: t -> cidr list
+  (** Get the CIDRs associated with this interface. For IPv4, only
+      one CIDR can be set at a time, so the list will always be of
+      length 1, e.g. [[10.0.0.2/24]]. *)
 
   val mtu: t -> dst:ipaddr -> int
   (** [mtu ~dst ip] is the Maximum Transmission Unit of the [ip] i.e. the

src/ipv4/static_ipv4.ml

@@ -33,6 +33,10 @@ module Make (R: Mirage_random.S) (C: Mirage_clock.MCLOCK) (Ethernet: Ethernet.S)
 
   let pp_ipaddr = Ipaddr.V4.pp
 
+  type cidr = Ipaddr.V4.Prefix.t
+
+  let pp_cidr = Ipaddr.V4.Prefix.pp
+
   type t = {
     ethif : Ethernet.t;
     arp : Arpv4.t;
@@ -170,6 +174,8 @@ module Make (R: Mirage_random.S) (C: Mirage_clock.MCLOCK) (Ethernet: Ethernet.S)
 
   let get_ip t = [Ipaddr.V4.Prefix.address t.cidr]
 
+  let get_cidr t = [t.cidr]
+
   let pseudoheader t ?src dst proto len =
     let src = match src with None -> Ipaddr.V4.Prefix.address t.cidr | Some x -> x in
     Ipv4_packet.Marshal.pseudoheader ~src ~dst ~proto len

src/ipv4/static_ipv4.mli

@@ -15,7 +15,7 @@
  *)
 
 module Make (R: Mirage_random.S) (C: Mirage_clock.MCLOCK) (E: Ethernet.S) (A: Arp.S) : sig
-  include Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t
+  include Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t and type cidr = Ipaddr.V4.Prefix.t
 
   val connect : ?no_init:bool -> cidr:Ipaddr.V4.Prefix.t -> ?gateway:Ipaddr.V4.t ->
     ?fragment_cache_size:int -> E.t -> A.t -> t Lwt.t

src/ipv6/ipv6.ml

@@ -31,6 +31,10 @@ module Make (N : Mirage_net.S)
 
   let pp_ipaddr = Ipaddr.V6.pp
 
+  type cidr = Ipaddr.V6.Prefix.t
+
+  let pp_cidr = Ipaddr.V6.Prefix.pp
+
   type t =
     { ethif : E.t;
       mutable ctx : Ndpv6.context }
@@ -114,6 +118,9 @@ module Make (N : Mirage_net.S)
   let get_ip t =
     Ndpv6.get_ip t.ctx
 
+  let get_cidr t =
+    Ndpv6.get_prefix t.ctx
+
   let pseudoheader t ?src:source dst proto len =
     let ph = Cstruct.create (16 + 16 + 8) in
     let src = match source with None -> src t ~dst | Some x -> x in

src/ipv6/ipv6.mli

@@ -19,7 +19,7 @@ module Make (N : Mirage_net.S)
             (R : Mirage_random.S)
             (T : Mirage_time.S)
             (Clock : Mirage_clock.MCLOCK) : sig
-  include Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t
+  include Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t and type cidr = Ipaddr.V6.Prefix.t
   val connect :
     ?no_init:bool ->
     ?handle_ra:bool ->

src/ipv6/ndpv6.ml

@@ -41,7 +41,6 @@ module Log = (val Logs.src_log src : Logs.LOG)
 
 module Ipaddr = Ipaddr.V6
 
-type buffer = Cstruct.t
 type ipaddr = Ipaddr.t
 type prefix = Ipaddr.Prefix.t
 type time   = int64
@@ -1021,9 +1020,9 @@ module Parser = struct
 end
 
 type event =
-  [ `Tcp of ipaddr * ipaddr * buffer
-  | `Udp of ipaddr * ipaddr * buffer
-  | `Default of int * ipaddr * ipaddr * buffer ]
+  [ `Tcp of ipaddr * ipaddr * Cstruct.t
+  | `Udp of ipaddr * ipaddr * Cstruct.t
+  | `Default of int * ipaddr * ipaddr * Cstruct.t ]
 
 (* TODO add destination cache *)
 type context =

src/ipv6/ndpv6.mli

@@ -14,28 +14,27 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-type buffer = Cstruct.t
 type ipaddr = Ipaddr.V6.t
 type prefix = Ipaddr.V6.Prefix.t
 type time   = int64
 
-val checksum : buffer -> buffer list -> int
+val checksum : Cstruct.t -> Cstruct.t list -> int
 
 type event =
-  [ `Tcp of ipaddr * ipaddr * buffer
-  | `Udp of ipaddr * ipaddr * buffer
-  | `Default of int * ipaddr * ipaddr * buffer ]
+  [ `Tcp of ipaddr * ipaddr * Cstruct.t
+  | `Udp of ipaddr * ipaddr * Cstruct.t
+  | `Default of int * ipaddr * ipaddr * Cstruct.t ]
 
 type context
 
 val local : handle_ra:bool -> now:time -> random:(int -> Cstruct.t) -> Macaddr.t ->
-  context * (Macaddr.t * int * (buffer -> int)) list
+  context * (Macaddr.t * int * (Cstruct.t -> int)) list
 (** [local ~handle_ra ~now ~random mac] is a pair [ctx, outs] where [ctx] is a local IPv6 context
     associated to the hardware address [mac].  [outs] is a list of ethif packets
     to be sent. *)
 
 val add_ip : now:time -> context -> ipaddr ->
-  context * (Macaddr.t * int * (buffer -> int)) list
+  context * (Macaddr.t * int * (Cstruct.t -> int)) list
 (** [add_ip ~now ctx ip] is [ctx', outs] where [ctx'] is [ctx] updated with a
     new local ip and [outs] is a list of ethif packets to be sent. *)
 
@@ -46,22 +45,22 @@ val select_source : context -> ipaddr -> ipaddr
 (** [select_source ctx ip] returns the ip that should be put in the source field
     of a packet destined to [ip]. *)
 
-val handle : now:time -> random:(int -> Cstruct.t) -> context -> buffer ->
-  context * (Macaddr.t * int * (buffer -> int)) list * event list
+val handle : now:time -> random:(int -> Cstruct.t) -> context -> Cstruct.t ->
+  context * (Macaddr.t * int * (Cstruct.t -> int)) list * event list
 (** [handle ~now ~random ctx buf] handles an incoming ipv6 packet.  It returns
     [ctx', bufs, evs] where [ctx'] is the updated context, [bufs] is a list of
     packets to be sent and [evs] is a list of packets to be passed to the higher
     layers (udp, tcp, etc) for further processing. *)
 
 val send : now:time -> context -> ?src:ipaddr -> ipaddr -> Tcpip.Ip.proto ->
-  int -> (buffer -> buffer -> int) -> context * (Macaddr.t * int * (buffer -> int)) list
+  int -> (Cstruct.t -> Cstruct.t -> int) -> context * (Macaddr.t * int * (Cstruct.t -> int)) list
 (** [send ~now ctx ?src dst proto size fillf] starts route resolution and assembles an
     ipv6 packet of [size] for sending with header and body passed to [fillf].
     It returns a pair [ctx', dst_size_fills] where [ctx'] is the updated
     context and [dst, size, fillf] is a list of packets to be sent, specified
     by destination, their size, and fill function. *)
 
-val tick : now:time -> context -> context * (Macaddr.t * int * (buffer -> int)) list
+val tick : now:time -> context -> context * (Macaddr.t * int * (Cstruct.t -> int)) list
 (** [tick ~now ctx] should be called periodically (every 1s is good).  It
     returns [ctx', bufs] where [ctx'] is the updated context and [bufs] is a list of
     packets to be sent. *)

src/stack-direct/tcpip_stack_direct.ml

@@ -19,13 +19,18 @@ open Lwt.Infix
 let src = Logs.Src.create "tcpip-stack-direct" ~doc:"Pure OCaml TCP/IP stack"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t) = struct
+module IPV4V6
+    (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t and type cidr = Ipaddr.V4.Prefix.t)
+    (Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t and type cidr = Ipaddr.V6.Prefix.t) = struct
 
   type ipaddr   = Ipaddr.t
   type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
 
   let pp_ipaddr = Ipaddr.pp
 
+  type cidr = Ipaddr.Prefix.t
+  let pp_cidr = Ipaddr.Prefix.pp
+
   type error = [ Tcpip.Ip.error | `Ipv4 of Ipv4.error | `Ipv6 of Ipv6.error | `Msg of string ]
 
   let pp_error ppf = function
@@ -129,6 +134,10 @@ module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.I
     List.map (fun ip -> Ipaddr.V4 ip) (Ipv4.get_ip t.ipv4) @
     List.map (fun ip -> Ipaddr.V6 ip) (Ipv6.get_ip t.ipv6)
 
+  let get_cidr t =
+    List.map (fun cidr -> Ipaddr.V4 cidr) (Ipv4.get_cidr t.ipv4) @
+    List.map (fun cidr -> Ipaddr.V6 cidr) (Ipv6.get_cidr t.ipv6)
+
   let mtu t ~dst = match dst with
     | Ipaddr.V4 dst -> Ipv4.mtu t.ipv4 ~dst
     | Ipaddr.V6 dst -> Ipv6.mtu t.ipv6 ~dst

src/stack-direct/tcpip_stack_direct.mli

@@ -14,8 +14,10 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t) : sig
-  include Tcpip.Ip.S with type ipaddr = Ipaddr.t
+module IPV4V6
+    (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t and type cidr = Ipaddr.V4.Prefix.t)
+    (Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t and type cidr = Ipaddr.V6.Prefix.t) : sig
+  include Tcpip.Ip.S with type ipaddr = Ipaddr.t and type cidr = Ipaddr.Prefix.t
 
   val connect : ipv4_only:bool -> ipv6_only:bool -> Ipv4.t -> Ipv6.t -> t Lwt.t
 end

src/stack-unix/ipv4_socket.ml

@@ -18,9 +18,11 @@ type t = unit
 type error = Tcpip.Ip.error
 type ipaddr = Ipaddr.V4.t
 type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type cidr = Ipaddr.V4.Prefix.t
 
 let pp_error = Tcpip.Ip.pp_error
 let pp_ipaddr = Ipaddr.V4.pp
+let pp_cidr = Ipaddr.V4.Prefix.pp
 
 let mtu _ ~dst:_ = 1500 - Ipv4_wire.sizeof_ipv4
 
@@ -32,5 +34,6 @@ let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
   Lwt.fail (Failure "Not implemented")
 
 let get_ip _ = [Ipaddr.V4.any]
+let get_cidr _ = [Ipaddr.V4.Prefix.global]
 let src _ ~dst:_ = raise (Failure "Not implemented")
 let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")

src/stack-unix/ipv4v6_socket.ml

@@ -18,9 +18,11 @@ type t = unit
 type error = Tcpip.Ip.error
 type ipaddr = Ipaddr.t
 type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type cidr = Ipaddr.Prefix.t
 
 let pp_error = Tcpip.Ip.pp_error
 let pp_ipaddr = Ipaddr.pp
+let pp_cidr = Ipaddr.Prefix.pp
 
 let mtu _ ~dst = match dst with
   | Ipaddr.V4 _ -> 1500 - Ipv4_wire.sizeof_ipv4
@@ -34,5 +36,6 @@ let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
   Lwt.fail (Failure "Not implemented")
 
 let get_ip _ = [Ipaddr.V6 Ipaddr.V6.unspecified]
+let get_cidr _ = [Ipaddr.Prefix.of_string_exn "::/0"]
 let src _ ~dst:_ = raise (Failure "Not implemented")
 let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")

src/stack-unix/ipv6_socket.ml

@@ -19,9 +19,11 @@ type t = unit
 type error = Tcpip.Ip.error
 type ipaddr = Ipaddr.V6.t
 type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type cidr = Ipaddr.V6.Prefix.t
 
 let pp_error = Tcpip.Ip.pp_error
 let pp_ipaddr = Ipaddr.V6.pp
+let pp_cidr = Ipaddr.V6.Prefix.pp
 
 let mtu _ ~dst:_ = 1500 - Ipv6_wire.sizeof_ipv6
 
@@ -33,5 +35,6 @@ let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
   Lwt.fail (Failure "Not implemented")
 
 let get_ip _ = [Ipaddr.V6.unspecified]
+let get_cidr _ = [Ipaddr.V6.Prefix.of_string_exn "::/0"]
 let src _ ~dst:_ = raise (Failure "Not implemented")
 let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")