Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update conduit-mirage to v4v6 #380

Merged
merged 10 commits into from
Apr 15, 2021
3 changes: 3 additions & 0 deletions conduit-mirage.opam
Original file line number Diff line number Diff line change
Expand Up @@ -38,5 +38,8 @@ build: [
["dune" "build" "-p" name "-j" jobs]
dinosaure marked this conversation as resolved.
Show resolved Hide resolved
["dune" "runtest" "-p" name] {with-test}
]
pin-depends: [
"dns-client" "git+https://github.com/mirage/ocaml-dns.git#cfec9fe8237d6c4b6e8465f5fbc3781ee0a0b7f5"
]
dev-repo: "git+https://github.com/mirage/ocaml-conduit.git"
synopsis: "A network connection establishment library for MirageOS"
18 changes: 7 additions & 11 deletions src/conduit-mirage/conduit_mirage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@ let err_domain_sockets_not_supported =

let err_vchan_not_supported = fail "%s: VCHAN is not supported"
let err_unknown = fail "%s: unknown endpoint type"
let err_ipv6 = fail "%s: IPv6 is not supported"

let err_not_supported = function
| `TLS _ -> err_tls_not_supported
Expand Down Expand Up @@ -64,32 +63,29 @@ end
let tcp_client i p = Lwt.return (`TCP (i, p))
let tcp_server _ p = Lwt.return (`TCP p)

module TCP (S : Mirage_stack.V4) = struct
module Flow = S.TCPV4
module TCP (S : Mirage_stack.V4V6) = struct
module Flow = S.TCP

type flow = Flow.flow
type t = S.t

let err_tcp e =
Lwt.fail
@@ Failure (Format.asprintf "TCP connection failed: %a" S.TCPV4.pp_error e)
@@ Failure (Format.asprintf "TCP connection failed: %a" S.TCP.pp_error e)

let connect (t : t) (c : client) =
match c with
| `TCP (ip, port) -> (
match Ipaddr.to_v4 ip with
| None -> err_ipv6 "connect"
| Some ip -> (
S.TCPV4.create_connection (S.tcpv4 t) (ip, port) >>= function
| Error e -> err_tcp e
| Ok flow -> Lwt.return flow))
S.TCP.create_connection (S.tcp t) (ip, port) >>= function
| Error e -> err_tcp e
| Ok flow -> Lwt.return flow)
| _ -> err_not_supported c "connect"

let listen (t : t) (s : server) fn =
match s with
| `TCP port ->
let s, _u = Lwt.task () in
S.listen_tcpv4 t ~port (fun flow -> fn flow);
S.listen_tcp t ~port (fun flow -> fn flow);
s
| _ -> err_not_supported s "listen"
end
Expand Down
4 changes: 2 additions & 2 deletions src/conduit-mirage/conduit_mirage.mli
Original file line number Diff line number Diff line change
Expand Up @@ -83,8 +83,8 @@ end

(** {2 TCP} *)

module TCP (S : Mirage_stack.V4) :
S with type t = S.t and type flow = S.TCPV4.flow
module TCP (S : Mirage_stack.V4V6) :
S with type t = S.t and type flow = S.TCP.flow

(** {2 VCHAN} *)

Expand Down
2 changes: 1 addition & 1 deletion src/conduit-mirage/resolver_mirage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ module Make
(R : Mirage_random.S)
(T : Mirage_time.S)
(C : Mirage_clock.MCLOCK)
(S : Mirage_stack.V4) =
(S : Mirage_stack.V4V6) =
struct
include Resolver_lwt

Expand Down
4 changes: 2 additions & 2 deletions src/conduit-mirage/resolver_mirage.mli
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,9 @@ module Make
(R : Mirage_random.S)
(T : Mirage_time.S)
(C : Mirage_clock.MCLOCK)
(S : Mirage_stack.V4) : sig
(S : Mirage_stack.V4V6) : sig
include S

val v : ?ns:Ipaddr.V4.t -> ?ns_port:int -> S.t -> t
val v : ?ns:Ipaddr.t -> ?ns_port:int -> S.t -> t
(** [v ?ns ?ns_port ?stack ()] TODO *)
end
10 changes: 6 additions & 4 deletions tests/conduit-mirage/simple/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,14 @@ let client : Conduit_mirage.client =

let server : Conduit_mirage.server = `TCP 12345

module TCP = Conduit_mirage.TCP (Tcpip_stack_socket.V4)
module TCP = Conduit_mirage.TCP (Tcpip_stack_socket.V4V6)

let tcp () =
Udpv4_socket.connect Ipaddr.V4.Prefix.global >>= fun udp ->
Tcpv4_socket.connect Ipaddr.V4.Prefix.global >>= fun tcp ->
Tcpip_stack_socket.V4.connect udp tcp
let ipv4_only = false and ipv6_only = false in
Udpv4v6_socket.connect ~ipv4_only ~ipv6_only Ipaddr.V4.Prefix.global None
>>= fun udp ->
Tcpv4v6_socket.connect ~ipv4_only ~ipv6_only Ipaddr.V4.Prefix.global None
>>= fun tcp -> Tcpip_stack_socket.V4V6.connect udp tcp

let _client () = tcp () >>= fun t -> TCP.connect t client

Expand Down