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.

Sign up for GitHub

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

Jump to bottom

secondary server, mirage layer #347

Merged
merged 3 commits into from Dec 6, 2023
Merged

secondary server, mirage layer #347

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f08efee
secondary server, mirage layer
hannesm Nov 28, 2023
8eb1555
address @reynir review: no optional arguments, make timer mandatory
hannesm Nov 28, 2023
8e152f6
minor nits
hannesm Nov 28, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
35 changes: 19 additions & 16 deletions mirage/server/dns_server_mirage.ml
View file
Open in desktop
Expand Up @@ -178,7 +178,7 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
end
in

let rec close ip =
let rec close ~timer ip =
(match Ipaddr.Map.find_opt ip !tcp_out with
| None -> Lwt.return_unit
| Some f -> T.close f) >>= fun () ->
Expand All @@ -187,12 +187,15 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
let elapsed = M.elapsed_ns () in
let state', out = Dns_server.Secondary.closed !state now elapsed ip in
state := state' ;
request (ip, out)
and read_and_handle ip f =
if not timer then
request ~timer (ip, out)
else
Lwt.return_unit
reynir marked this conversation as resolved.
Show resolved Hide resolved
and read_and_handle ~timer ip f =
Dns.read_tcp f >>= function
| Error () ->
Log.debug (fun m -> m "removing %a from tcp_out" Ipaddr.pp ip) ;
close ip
close ~timer ip
| Ok data ->
inc `Tcp_query;
let now = Ptime.v (P.now_d_ps ()) in
Expand All @@ -208,15 +211,15 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
Dns.send_tcp (Dns.flow f) x >>= function
| Error () ->
Log.debug (fun m -> m "removing %a from tcp_out" Ipaddr.pp ip) ;
close ip >|= fun () -> Error ()
close ~timer ip >|= fun () -> Error ()
| Ok () -> Lwt.return (Ok ())) >>= fun r ->
(match out with
| None -> Lwt.return_unit
| Some (ip, data) -> request_one (ip, data)) >>= fun () ->
| Some (ip, data) -> request_one ~timer (ip, data)) >>= fun () ->
match r with
| Ok () -> read_and_handle ip f
| Ok () -> read_and_handle ~timer ip f
| Error () -> Lwt.return_unit
and request (ip, data) =
and request ~timer (ip, data) =
inc `Notify;
let dport = 53 in
match Ipaddr.Map.find_opt ip !tcp_out with
Expand All @@ -228,13 +231,13 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
| Error e ->
Log.err (fun m -> m "error %a while establishing tcp connection to %a:%d"
T.pp_error e Ipaddr.pp ip dport) ;
close ip
close ~timer ip
| Ok flow ->
tcp_out := Ipaddr.Map.add ip flow !tcp_out ;
Dns.send_tcp_multiple flow data >>= function
| Error () -> close ip
| Error () -> close ~timer ip
| Ok () ->
Lwt.async (fun () -> read_and_handle ip (Dns.of_flow flow)) ;
Lwt.async (fun () -> read_and_handle ~timer ip (Dns.of_flow flow)) ;
Lwt.return_unit
end
| Some flow ->
Expand All @@ -245,8 +248,8 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
Ipaddr.pp ip dport) ;
T.close flow >>= fun () ->
tcp_out := Ipaddr.Map.remove ip !tcp_out ;
request (ip, data)
and request_one (ip, d) = request (ip, [ d ])
request ~timer (ip, data)
and request_one ~timer (ip, d) = request ~timer (ip, [ d ])
in

let udp_cb ~src ~dst:_ ~src_port buf =
Expand All @@ -260,7 +263,7 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
maybe_update_state t >>= fun () ->
(match out with
| None -> ()
| Some (ip, cs) -> Lwt.async (fun () -> request_one (ip, cs))) ;
| Some (ip, cs) -> Lwt.async (fun () -> request_one ~timer:false (ip, cs))) ;
match answer with
| None -> Lwt.return_unit
| Some out -> inc `Udp_answer; Dns.send_udp stack port src src_port out
Expand All @@ -287,7 +290,7 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
maybe_update_state t >>= fun () ->
(match out with
| None -> ()
| Some (ip, cs) -> Lwt.async (fun () -> request_one (ip, cs)));
| Some (ip, cs) -> Lwt.async (fun () -> request_one ~timer:false (ip, cs)));
match answer with
| None ->
Log.warn (fun m -> m "no TCP output") ;
Expand All @@ -309,7 +312,7 @@ module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (TIME : Mirage_t
let t, out = Dns_server.Secondary.timer !state now elapsed in
maybe_update_state t >>= fun () ->
List.iter (fun (ip, cs) ->
Lwt.async (fun () -> request (ip, cs))) out ;
Lwt.async (fun () -> request ~timer:true (ip, cs))) out ;
TIME.sleep_ns (Duration.of_sec timer) >>= fun () ->
time ()
in
Expand Down