Skip to content

Commit 080dc84

Browse files
committed
eio(client): 'run' inject stack
Make `run` function inject stack parameter. Address reviewer comments.
1 parent 955b2ad commit 080dc84

File tree

3 files changed

+60
-46
lines changed

3 files changed

+60
-46
lines changed

eio/client/dns_client_eio.ml

Lines changed: 49 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,18 @@
1-
module E = Eio
2-
3-
type env = <
4-
clock : E.Time.clock ;
5-
net : E.Net.t;
6-
fs : E.Dir.t;
7-
secure_random : E.Flow.source;
8-
>
1+
type 'a env = <
2+
clock : Eio.Time.clock ;
3+
net : Eio.Net.t ;
4+
fs : Eio.Fs.dir Eio.Path.t ;
5+
secure_random : Eio.Flow.source;
6+
..
7+
> as 'a
98

109
type io_addr = Ipaddr.t * int
11-
type stack = env * E.Switch.t
10+
type stack = {
11+
sw : Eio.Switch.t;
12+
clock : Eio.Time.clock;
13+
net : Eio.Net.t;
14+
resolv_conf : Eio.Fs.dir Eio.Path.t
15+
}
1216

1317
module Transport : Dns_client.S
1418
with type io_addr = io_addr
@@ -18,7 +22,7 @@ module Transport : Dns_client.S
1822
type nonrec io_addr = io_addr
1923
type nonrec stack = stack
2024
type +'a io = 'a
21-
type context = E.Net.stream_socket
25+
type context = <Eio.Net.stream_socket; Eio.Flow.close>
2226

2327
type nameservers =
2428
| Static of io_addr Queue.t
@@ -30,17 +34,15 @@ module Transport : Dns_client.S
3034
type t = {
3135
nameservers : nameservers ;
3236
timeout_ns : int64 ; (* Timeout in nano seconds *)
33-
env : env;
34-
sw : E.Switch.t ;
35-
mutex : E.Mutex.t ;
37+
stack : stack;
38+
mutex : Eio.Mutex.t ;
3639
}
3740

38-
let read_file env file =
39-
match E.Dir.load env#fs file with
41+
let read_file file =
42+
match Eio.Path.load file with
4043
| content -> Ok content
41-
| exception e ->
42-
let err = "Error while reading file: " ^ file ^ ". " ^ (Printexc.to_string e) in
43-
Error (`Msg err)
44+
| exception e ->
45+
Fmt.error_msg "Error while reading file %a: %a" Eio.Path.pp file Fmt.exn e
4446

4547
(* Prioritises IPv6 nameservers before IPv4 nameservers so that we
4648
are more conformant with the happy eyballs RFC when implementing it.
@@ -71,7 +73,7 @@ module Transport : Dns_client.S
7173
|> List.map (fun ip -> ip, 53)
7274
|> ipv6_first_queue
7375

74-
let create ?nameservers ~timeout (env, sw) =
76+
let create ?nameservers ~timeout stack =
7577
let nameservers =
7678
match nameservers with
7779
| Some (proto, ns) -> begin
@@ -87,7 +89,7 @@ module Transport : Dns_client.S
8789
let nameservers, digest =
8890
match
8991
let ( let* ) = Result.bind in
90-
let* data = read_file env "/etc/resolv.conf" in
92+
let* data = read_file stack.resolv_conf in
9193
let* ips = decode_resolv_conf data in
9294
Ok (ips, Digest.string data)
9395
with
@@ -96,8 +98,8 @@ module Transport : Dns_client.S
9698
in
9799
(Resolv_conf { nameservers; digest })
98100
in
99-
let mutex = E.Mutex.create () in
100-
{ nameservers; timeout_ns = timeout; env; sw; mutex }
101+
let mutex = Eio.Mutex.create () in
102+
{ nameservers; timeout_ns = timeout; stack; mutex }
101103

102104
let nameservers0
103105
{ nameservers =
@@ -130,7 +132,7 @@ module Transport : Dns_client.S
130132
resolv_conf.digest <- None;
131133
resolv_conf.nameservers <- default_resolvers ()
132134
in
133-
match read_file t.env "/etc/resolv.conf", resolv_conf.digest with
135+
match read_file t.stack.resolv_conf, resolv_conf.digest with
134136
| Ok data, Some d ->
135137
let digest = Digest.string data in
136138
if Digest.equal digest d then () else decode_update data digest
@@ -154,17 +156,17 @@ module Transport : Dns_client.S
154156
if n >= Queue.length ns_q then
155157
Error (`Msg "Unable to connect to specified nameservers")
156158
else
157-
let (ip, port) = E.Mutex.use_ro t.mutex @@ fun () -> Queue.peek ns_q in
158-
let ip = ipaddr_octects ip |> E.Net.Ipaddr.of_raw in
159+
let (ip, port) = Eio.Mutex.use_ro t.mutex @@ fun () -> Queue.peek ns_q in
160+
let ip = ipaddr_octects ip |> Eio.Net.Ipaddr.of_raw in
159161
let stream = `Tcp (ip, port) in
160162
try
161163
let timeout = Duration.to_f t.timeout_ns in
162-
E.Time.with_timeout_exn t.env#clock timeout @@ fun () ->
163-
let flow = E.Net.connect ~sw:t.sw t.env#net stream in
164+
Eio.Time.with_timeout_exn t.stack.clock timeout @@ fun () ->
165+
let flow = Eio.Net.connect ~sw:t.stack.sw t.stack.net stream in
164166
Ok flow
165-
with E.Time.Timeout ->
167+
with Eio.Time.Timeout ->
166168
(* Push the non responsive nameserver to the back of the queue. *)
167-
let ns = E.Mutex.use_rw ~protect:true t.mutex @@ fun () -> Queue.pop ns_q in
169+
let ns = Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () -> Queue.pop ns_q in
168170
Queue.push ns ns_q;
169171
try_ns_connection t (n + 1) ns_q
170172

@@ -176,23 +178,33 @@ module Transport : Dns_client.S
176178
let send_recv ctx dns_query =
177179
if Cstruct.length dns_query > 4 then
178180
try
179-
let src = E.Flow.cstruct_source [dns_query] in
180-
E.Flow.copy src ctx;
181+
let src = Eio.Flow.cstruct_source [dns_query] in
182+
Eio.Flow.copy src ctx;
181183
let dns_response = Cstruct.create 2048 in
182-
let got = E.Flow.read ctx dns_response in
184+
let got = Eio.Flow.read ctx dns_response in
183185
Ok (Cstruct.sub dns_response 0 got)
184186
with e -> Error (`Msg (Printexc.to_string e))
185187
else
186188
Error (`Msg "Invalid DNS query packet (data length <= 4)")
187189

188-
let close flow = try E.Flow.close flow with _ -> ()
190+
let close flow = Eio.Flow.close flow
189191
let bind a f = f a
190192
let lift v = v
191193
end
192194

193-
module Client = Dns_client.Make(Transport)
194195
module type DNS_CLIENT = module type of Dns_client.Make(Transport)
195196

196-
let run env (f:(module DNS_CLIENT) -> 'a) =
197-
Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () ->
198-
f (module Client)
197+
module Client = Dns_client.Make(Transport)
198+
199+
let run ?(resolv_conf = "/etc/resolv.conf") env (f: Transport.stack -> (module DNS_CLIENT) -> 'a) =
200+
Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env (fun () ->
201+
Eio.Switch.run (fun sw ->
202+
let stack = {
203+
sw;
204+
clock=env#clock;
205+
net = env#net;
206+
resolv_conf = Eio.Path.(env#fs / resolv_conf) }
207+
in
208+
f stack (module Client)
209+
)
210+
)

eio/client/dns_client_eio.mli

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,19 @@
1-
type env = <
1+
type 'a env = <
22
clock : Eio.Time.clock ;
33
net : Eio.Net.t ;
4-
fs : Eio.Dir.t ;
4+
fs : Eio.Fs.dir Eio.Path.t ;
55
secure_random : Eio.Flow.source ;
6-
>
6+
..
7+
> as 'a
78

89
module Transport : Dns_client.S
910
with type io_addr = Ipaddr.t * int
10-
and type stack = env * Eio.Switch.t
1111
and type +'a io = 'a
1212

1313
module type DNS_CLIENT = module type of Dns_client.Make(Transport)
1414

15-
val run : < env; ..> -> ((module DNS_CLIENT) -> 'a) -> 'a
15+
val run :
16+
?resolv_conf:string
17+
-> _ env
18+
-> (Transport.stack -> (module DNS_CLIENT) -> 'a)
19+
-> 'a

eio/client/ohost.ml

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,8 @@ let (let+) r f = Result.map f r
88

99
let display_host_ips h_name =
1010
Eio_main.run @@ fun env ->
11-
Eio.Switch.run @@ fun sw ->
12-
Dns_client_eio.run env @@ fun (module Client) ->
13-
let env = (env :> Dns_client_eio.env) in
14-
let c = Client.create (env, sw) in
11+
Dns_client_eio.run env @@ fun stack (module Client) ->
12+
let c = Client.create stack in
1513
let domain = Domain_name.(host_exn (of_string_exn h_name)) in
1614
let ipv4 =
1715
let+ addr = Client.gethostbyname c domain in

0 commit comments

Comments
 (0)