Skip to content

Commit

Permalink
Merge pull request #494 from hannesm/mirage-430
Browse files Browse the repository at this point in the history 
remove V4-only and V6-only stack (as done in mirage 4.3.0)
  • Loading branch information
@hannesm
hannesm authored Oct 9, 2022
2 parents efbebdf + f94b095 commit 4bae549
Show file tree
Hide file tree
Showing 25 changed files with 191 additions and 1,323 deletions.
124 changes: 0 additions & 124 deletions src/core/stack.ml
View file
Original file line number Diff line number Diff line change
@@ -1,108 +1,3 @@
module type V4 = sig

type t
(** The type representing the internal state of the IPv4 stack. *)

val disconnect: t -> unit Lwt.t
(** Disconnect from the IPv4 stack. While this might take some time to
complete, it can never result in an error. *)

module UDPV4: Udp.S with type ipaddr = Ipaddr.V4.t

module TCPV4: Tcp.S with type ipaddr = Ipaddr.V4.t

module IPV4: Ip.S with type ipaddr = Ipaddr.V4.t

val udpv4: t -> UDPV4.t
(** [udpv4 t] obtains a descriptor for use with the [UDPV4] module,
usually to transmit traffic. *)

val tcpv4: t -> TCPV4.t
(** [tcpv4 t] obtains a descriptor for use with the [TCPV4] module,
usually to initiate outgoing connections. *)

val ipv4: t -> IPV4.t
(** [ipv4 t] obtains a descriptor for use with the [IPV4] module,
which can handle raw IPv4 frames, or manipulate IP address
configuration on the stack interface. *)

val listen_udpv4: t -> port:int -> UDPV4.callback -> unit
[@@ocaml.deprecated "use UDPV4.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_udpv4 t ~port cb] registers the [cb] callback on the
UDPv4 [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash. *)

val listen_tcpv4: ?keepalive:Tcp.Keepalive.t
-> t -> port:int -> (TCPV4.flow -> unit Lwt.t) -> unit
[@@ocaml.deprecated "use TCPV4.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_tcpv4 ~keepalive t ~port cb] registers the [cb] callback
on the TCPv4 [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash.
If [~keepalive] is provided then these keepalive settings will be
applied to the accepted connections before the callback is called. *)

val listen: t -> unit Lwt.t
(** [listen t] requests that the stack listen for traffic on the
network interface associated with the stack, and demultiplex
traffic to the appropriate callbacks. *)
end

module type V6 = sig
type t
(** The type representing the internal state of the IPv6 stack. *)

val disconnect: t -> unit Lwt.t
(** Disconnect from the IPv6 stack. While this might take some time to
complete, it can never result in an error. *)

module UDP: Udp.S with type ipaddr = Ipaddr.V6.t

module TCP: Tcp.S with type ipaddr = Ipaddr.V6.t

module IP: Ip.S with type ipaddr = Ipaddr.V6.t

val udp: t -> UDP.t
(** [udp t] obtains a descriptor for use with the [UDPV6] module,
usually to transmit traffic. *)

val tcp: t -> TCP.t
(** [tcp t] obtains a descriptor for use with the [TCPV6] module,
usually to initiate outgoing connections. *)

val ip: t -> IP.t
(** [ip t] obtains a descriptor for use with the [IPV6] module,
which can handle raw IPv6 frames, or manipulate IP address
configuration on the stack interface. *)

val listen_udp: t -> port:int -> UDP.callback -> unit
[@@ocaml.deprecated "use UDP.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_udp t ~port cb] registers the [cb] callback on the
UDPv6 [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash. *)

val listen_tcp: ?keepalive:Tcp.Keepalive.t
-> t -> port:int -> (TCP.flow -> unit Lwt.t) -> unit
[@@ocaml.deprecated "use TCP.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_tcp ~keepalive t ~port cb] registers the [cb] callback
on the TCPv6 [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash.
If [~keepalive] is provided then these keepalive settings will be
applied to the accepted connections before the callback is called. *)

val listen: t -> unit Lwt.t
(** [listen t] requests that the stack listen for traffic on the
network interface associated with the stack, and demultiplex
traffic to the appropriate callbacks. *)
end

module type V4V6 = sig
type t
(** The type representing the internal state of the dual IPv4 and IPv6 stack. *)
Expand Down Expand Up @@ -130,25 +25,6 @@ module type V4V6 = sig
which can handle raw IPv4 and IPv6 frames, or manipulate IP address
configuration on the stack interface. *)

val listen_udp: t -> port:int -> UDP.callback -> unit
[@@ocaml.deprecated "use UDP.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_udp t ~port cb] registers the [cb] callback on the
UDP [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash. *)

val listen_tcp: ?keepalive:Tcp.Keepalive.t
-> t -> port:int -> (TCP.flow -> unit Lwt.t) -> unit
[@@ocaml.deprecated "use TCP.listen instead (since mirage-protocols 6.0.0)."]
(** [listen_tcp ~keepalive t ~port cb] registers the [cb] callback
on the TCP [port] and immediately return. If [port] is invalid (not
between 0 and 65535 inclusive), it raises [Invalid_argument].
Multiple bindings to the same port will overwrite previous
bindings, so callbacks will not chain if ports clash.
If [~keepalive] is provided then these keepalive settings will be
applied to the accepted connections before the callback is called. *)

val listen: t -> unit Lwt.t
(** [listen t] requests that the stack listen for traffic on the
network interface associated with the stack, and demultiplex
Expand Down
182 changes: 0 additions & 182 deletions src/stack-direct/tcpip_stack_direct.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,182 +19,6 @@ 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 Make
(Time : Mirage_time.S)
(Random : Mirage_random.S)
(Netif : Mirage_net.S)
(Eth : Ethernet.S)
(Arpv4 : Arp.S)
(Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t)
(Icmpv4 : Icmpv4.S)
(Udpv4 : Tcpip.Udp.S with type ipaddr = Ipaddr.V4.t)
(Tcpv4 : Tcpip.Tcp.S with type ipaddr = Ipaddr.V4.t) = struct

module UDPV4 = Udpv4
module TCPV4 = Tcpv4
module IPV4 = Ipv4

type t = {
netif : Netif.t;
ethif : Eth.t;
arpv4 : Arpv4.t;
ipv4 : Ipv4.t;
icmpv4: Icmpv4.t;
udpv4 : Udpv4.t;
tcpv4 : Tcpv4.t;
mutable task : unit Lwt.t option;
}

let pp fmt t =
Format.fprintf fmt "mac=%a,ip=%a" Macaddr.pp (Eth.mac t.ethif)
Fmt.(list ~sep:(any ", ") Ipaddr.V4.pp) (Ipv4.get_ip t.ipv4)

let tcpv4 { tcpv4; _ } = tcpv4
let udpv4 { udpv4; _ } = udpv4
let ipv4 { ipv4; _ } = ipv4

let listen_udpv4 t ~port callback =
Udpv4.listen t.udpv4 ~port callback

let listen_tcpv4 ?keepalive t ~port process =
Tcpv4.listen t.tcpv4 ~port ?keepalive process

let listen t =
Lwt.catch (fun () ->
Log.debug (fun f -> f "Establishing or updating listener for stack %a" pp t);
let ethif_listener = Eth.input
~arpv4:(Arpv4.input t.arpv4)
~ipv4:(
Ipv4.input
~tcp:(Tcpv4.input t.tcpv4)
~udp:(Udpv4.input t.udpv4)
~default:(fun ~proto ~src ~dst buf ->
match proto with
| 1 -> Icmpv4.input t.icmpv4 ~src ~dst buf
| _ -> Lwt.return_unit)
t.ipv4)
~ipv6:(fun _ -> Lwt.return_unit)
t.ethif
in
Netif.listen t.netif ~header_size:Ethernet.Packet.sizeof_ethernet ethif_listener
>>= function
| Error e ->
Log.warn (fun p -> p "%a" Netif.pp_error e) ;
(* XXX: error should be passed to the caller *)
Lwt.return_unit
| Ok _res ->
let nstat = Netif.get_stats_counters t.netif in
let open Mirage_net in
Log.info (fun f ->
f "listening loop of interface %s terminated regularly:@ %Lu bytes \
(%lu packets) received, %Lu bytes (%lu packets) sent@ "
(Macaddr.to_string (Netif.mac t.netif))
nstat.rx_bytes nstat.rx_pkts
nstat.tx_bytes nstat.tx_pkts) ;
Lwt.return_unit)
(function
| Lwt.Canceled ->
Log.info (fun f -> f "listen of %a cancelled" pp t);
Lwt.return_unit
| e -> Lwt.fail e)

let connect netif ethif arpv4 ipv4 icmpv4 udpv4 tcpv4 =
let t = { netif; ethif; arpv4; ipv4; icmpv4; tcpv4; udpv4; task = None } in
Log.info (fun f -> f "TCP/IP V4 stack assembled: %a" pp t);
Lwt.async (fun () -> let task = listen t in t.task <- Some task; task);
Lwt.return t

let disconnect t =
Log.info (fun f -> f "TCP/IP V4 stack disconnected: %a" pp t);
(match t.task with None -> () | Some task -> Lwt.cancel task);
Lwt.return_unit
end

module MakeV6
(Time : Mirage_time.S)
(Random : Mirage_random.S)
(Netif : Mirage_net.S)
(Eth : Ethernet.S)
(Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t)
(Udpv6 : Tcpip.Udp.S with type ipaddr = Ipaddr.V6.t)
(Tcpv6 : Tcpip.Tcp.S with type ipaddr = Ipaddr.V6.t) = struct

module UDP = Udpv6
module TCP = Tcpv6
module IP = Ipv6

type t = {
netif : Netif.t;
ethif : Eth.t;
ipv6 : Ipv6.t;
udpv6 : Udpv6.t;
tcpv6 : Tcpv6.t;
mutable task : unit Lwt.t option;
}

let pp fmt t =
Format.fprintf fmt "mac=%a,ip=%a" Macaddr.pp (Eth.mac t.ethif)
Fmt.(list ~sep:(any ", ") Ipaddr.V6.pp) (Ipv6.get_ip t.ipv6)

let tcp { tcpv6; _ } = tcpv6
let udp { udpv6; _ } = udpv6
let ip { ipv6; _ } = ipv6

let listen_udp t ~port callback =
Udpv6.listen t.udpv6 ~port callback

let listen_tcp ?keepalive t ~port process =
Tcpv6.listen t.tcpv6 ~port ?keepalive process

let listen t =
Lwt.catch (fun () ->
Log.debug (fun f -> f "Establishing or updating listener for stack %a" pp t);
let ethif_listener = Eth.input
~arpv4:(fun _ -> Lwt.return_unit)
~ipv4:(fun _ -> Lwt.return_unit)
~ipv6:(
Ipv6.input
~tcp:(Tcpv6.input t.tcpv6)
~udp:(Udpv6.input t.udpv6)
~default:(fun ~proto:_ ~src:_ ~dst:_ _ -> Lwt.return_unit)
t.ipv6)
t.ethif
in
Netif.listen t.netif ~header_size:Ethernet.Packet.sizeof_ethernet ethif_listener
>>= function
| Error e ->
Log.warn (fun p -> p "%a" Netif.pp_error e) ;
(* XXX: error should be passed to the caller *)
Lwt.return_unit
| Ok _res ->
let nstat = Netif.get_stats_counters t.netif in
let open Mirage_net in
Log.info (fun f ->
f "listening loop of interface %s terminated regularly:@ %Lu bytes \
(%lu packets) received, %Lu bytes (%lu packets) sent@ "
(Macaddr.to_string (Netif.mac t.netif))
nstat.rx_bytes nstat.rx_pkts
nstat.tx_bytes nstat.tx_pkts) ;
Lwt.return_unit)
(function
| Lwt.Canceled ->
Log.info (fun f -> f "listen of %a cancelled" pp t);
Lwt.return_unit
| e -> Lwt.fail e)

let connect netif ethif ipv6 udpv6 tcpv6 =
let t = { netif; ethif; ipv6; tcpv6; udpv6; task = None } in
Log.info (fun f -> f "TCP/IP V6 stack assembled: %a" pp t);
Lwt.async (fun () -> let task = listen t in t.task <- Some task; task);
Lwt.return t

let disconnect t =
Log.info (fun f -> f "TCP/IP V6 stack disconnected: %a" pp t);
(match t.task with None -> () | Some task -> Lwt.cancel task);
Lwt.return_unit

end

module IPV4V6 (Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t) (Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t) = struct

type ipaddr = Ipaddr.t
Expand Down Expand Up @@ -344,12 +168,6 @@ module MakeV4V6
let udp { udp; _ } = udp
let ip { ip; _ } = ip

let listen_udp t ~port callback =
Udp.listen t.udp ~port callback

let listen_tcp ?keepalive t ~port process =
Tcp.listen t.tcp ~port ?keepalive process

let listen t =
Lwt.catch (fun () ->
Log.debug (fun f -> f "Establishing or updating listener for stack %a" pp t);
Expand Down
45 changes: 0 additions & 45 deletions src/stack-direct/tcpip_stack_direct.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,51 +14,6 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

module Make
(Time : Mirage_time.S)
(Random : Mirage_random.S)
(Netif : Mirage_net.S)
(Ethernet : Ethernet.S)
(Arpv4 : Arp.S)
(Ipv4 : Tcpip.Ip.S with type ipaddr = Ipaddr.V4.t)
(Icmpv4 : Icmpv4.S)
(Udpv4 : Tcpip.Udp.S with type ipaddr = Ipaddr.V4.t)
(Tcpv4 : Tcpip.Tcp.S with type ipaddr = Ipaddr.V4.t) : sig
include Tcpip.Stack.V4
with module IPV4 = Ipv4
and module TCPV4 = Tcpv4
and module UDPV4 = Udpv4

val connect : Netif.t -> Ethernet.t -> Arpv4.t -> Ipv4.t -> Icmpv4.t ->
Udpv4.t -> Tcpv4.t -> t Lwt.t
(** [connect] assembles the arguments into a network stack, then calls
`listen` on the assembled stack before returning it to the caller. The
initial `listen` functions to ensure that the lower-level layers (e.g.
ARP) are functioning, so that if the user wishes to establish outbound
connections, they will be able to do so. *)
end

module MakeV6
(Time : Mirage_time.S)
(Random : Mirage_random.S)
(Netif : Mirage_net.S)
(Ethernet : Ethernet.S)
(Ipv6 : Tcpip.Ip.S with type ipaddr = Ipaddr.V6.t)
(Udpv6 : Tcpip.Udp.S with type ipaddr = Ipaddr.V6.t)
(Tcpv6 : Tcpip.Tcp.S with type ipaddr = Ipaddr.V6.t) : sig
include Tcpip.Stack.V6
with module IP = Ipv6
and module TCP = Tcpv6
and module UDP = Udpv6

val connect : Netif.t -> Ethernet.t -> Ipv6.t -> Udpv6.t -> Tcpv6.t -> t Lwt.t
(** [connect] assembles the arguments into a network stack, then calls
`listen` on the assembled stack before returning it to the caller. The
initial `listen` functions to ensure that the lower-level layers are
functioning, so that if the user wishes to establish outbound connections,
they will be able to do so. *)
end

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

Expand Down
Loading

0 comments on commit 4bae549

Please sign in to comment.