resolver: demote and condense log messages

Author: hannesm

mirage/resolver/dns_resolver_mirage.ml

@@ -128,20 +128,19 @@ module Make (S : Tcpip.Stack.V4V6) = struct
         Dns_resolver.handle_buf !state now ts req `Udp src src_port buf
       in
       if not req then
-        (Log.app (fun m -> m "unlisten on UDP %d" lport);
-         S.UDP.unlisten (S.udp stack) ~port:lport);
+        S.UDP.unlisten (S.udp stack) ~port:lport;
       state := new_state ;
       Lwt_list.iter_p handle_answer answers >>= fun () ->
       Lwt_list.iter_p handle_query queries
     in
     if udp then begin
       S.UDP.listen (S.udp stack) ~port (udp_cb port true);
-      Log.app (fun f -> f "DNS resolver listening on UDP port %d" port);
+      Log.info (fun f -> f "DNS resolver listening on UDP port %d" port);
     end;
 
     let tcp_cb query flow =
       let dst_ip, dst_port = T.dst flow in
-      Log.info (fun m -> m "tcp connection from %a:%d" Ipaddr.pp dst_ip dst_port) ;
+      Log.debug (fun m -> m "tcp connection from %a:%d" Ipaddr.pp dst_ip dst_port) ;
       tcp_in := FM.add (dst_ip, dst_port) (`Tcp flow) !tcp_in ;
       let f = Dns.of_flow flow in
       let rec loop () =
@@ -197,7 +196,7 @@ module Make (S : Tcpip.Stack.V4V6) = struct
           TLS.pp_write_error e);
         Lwt.return_unit
       | Ok tls ->
-        Log.info (fun m -> m "tls connection from %a:%d" Ipaddr.pp dst_ip dst_port);
+        Log.debug (fun m -> m "tls connection from %a:%d" Ipaddr.pp dst_ip dst_port);
         tcp_in := FM.add (dst_ip, dst_port) (`Tls tls) !tcp_in ;
         let tls_and_linger = { tls_flow = tls ; linger = Cstruct.empty } in
         let rec loop () =

resolver/dns_resolver.ml

@@ -486,7 +486,7 @@ let handle_buf t now ts query proto sender sport buf =
           Log.debug (fun m -> m "handled delegation %a:%d" Ipaddr.pp sender sport) ;
           handle_delegation t ts proto sender sport res dele
         | `None ->
-          Log.info (fun m -> m "resolving %a:%d" Ipaddr.pp sender sport) ;
+          Log.debug (fun m -> m "resolving %a:%d" Ipaddr.pp sender sport) ;
           (* DNSSEC request DS / DNSKEY / NS from auth *)
           resolve t ts proto sender sport res
       end

resolver/dns_resolver_cache.ml

@@ -283,14 +283,12 @@ let answer t ts name typ =
       `Packet (packet t true Rcode.NoError ~signed:(is_signed r) data Domain_name.Map.empty), t
 
 let handle_query t ~dnssec ~rng ip_proto ts (qname, qtype) =
-  Log.info (fun m -> m "handle query %a (%a)"
-                Domain_name.pp qname Packet.Question.pp_qtype qtype);
   match answer t ts qname qtype with
   | `Packet (flags, data), t ->
-    Log.info (fun m -> m "reply for %a (%a)" Domain_name.pp qname Packet.Question.pp_qtype qtype);
+    Log.debug (fun m -> m "handle_query: reply %a (%a)" Domain_name.pp qname
+                  Packet.Question.pp_qtype qtype);
     `Reply (flags, data), t
   | `Query name, t ->
-    Log.info (fun m -> m "query for %a (%a): %a" Domain_name.pp qname Packet.Question.pp_qtype qtype Domain_name.pp name);
     (* DS should be requested at the parent *)
     let name', recover =
       if Domain_name.count_labels name > 1 && qtype = `K (Rr_map.K Ds) then
@@ -301,8 +299,9 @@ let handle_query t ~dnssec ~rng ip_proto ts (qname, qtype) =
     in
     let zone, name'', types, ip, t = resolve t ~dnssec ~rng ip_proto ts name' qtype in
     let name'' = recover name'' in
-    Log.info (fun m -> m "resolve returned zone %a query %a (%a), ip %a"
-                   Domain_name.pp zone Domain_name.pp name''
-                   Fmt.(list ~sep:(any ", ") Packet.Question.pp_qtype) types
-                   Ipaddr.pp ip);
+    Log.debug (fun m -> m "handle_query %a (%a) query %a, resolve zone %a query %a (%a), ip %a"
+                  Domain_name.pp qname Packet.Question.pp_qtype qtype
+                  Domain_name.pp name Domain_name.pp zone Domain_name.pp name''
+                  Fmt.(list ~sep:(any ", ") Packet.Question.pp_qtype) types
+                  Ipaddr.pp ip);
     `Query (zone, (name'', types), ip), t