| `Drop -> "drops"

| `Insert -> "insertions"

in

let empty = LRU.empty

if updated_ttl < 0l then Error `Cache_drop else Ok (with_ttl typ updated_ttl entry)

let get cache ts name query_type =

match snd (find cache name query_type) with

| Ok ((created, rank), entry) ->

match update_ttl query_type entry ~created ~now:ts with

let find_any cache name =

match LRU.find name cache with

| Some Rr_map rrs -> Ok (`Entries rrs)

let get_any cache ts name =

match find_any cache name with

| Ok r ->

let ttl created curr =

let ttl = compute_updated_ttl ~created ~now:ts curr in

match r with

| `No_domain ((created, rank), name, soa) ->

begin match ttl created soa.Soa.minimum with

| Ok minimum ->

Ok (`No_domain (name, { soa with Soa.minimum }), rank)

end

| `Entries rrs ->

| _ -> acc, r) rrs (Rr_map.empty, Additional)

in

match Rr_map.is_empty rrs with

let get_or_cname : type a . t -> int64 -> [`raw] Domain_name.t -> a Rr_map.key ->

t * ([ a entry | `Alias of int32 * [`raw] Domain_name.t] * rank,

[ `Cache_drop | `Cache_miss ]) result =

fun cache ts name query_type ->

let map_result : _ -> t * ([ a entry | `Alias of int32 * [`raw] Domain_name.t] * rank, [ `Cache_drop | `Cache_miss ]) result = function

| Ok ((created, rank), entry) ->

match update_ttl query_type entry ~created ~now:ts with

in

match find cache name query_type with

| Some map, r ->

if ttl < 0l then

map_result r

else begin

LRU.promote name cache, Ok (`Alias (ttl, name), rank)

end

| _ -> map_result r

end

| _, e -> map_result e

let get_nsec3 cache ts name =

let zone_labels = Domain_name.count_labels name in

let nsec3_rrs =

LRU.fold (fun ename entry acc ->

in

match nsec3_rrs with

| [] ->

cache, Error `Cache_miss

| xs ->

List.fold_right LRU.promote (List.map (fun (a, _, _, _) -> a) xs) cache,

Ok xs

| map, Error _ ->

Log.debug (fun m -> m "set: %a nothing found, adding: %a"

pp_query (name, `K (K query_type)) (pp_entry query_type) entry');

| map, Ok ((created, rank'), entry) ->

Log.debug (fun m -> m "set: %a found rank %a insert rank %a: %d"

pp_query (name, `K (K query_type)) pp_rank rank' pp_rank rank (compare_rank rank' rank));

match update_ttl query_type entry ~created ~now:ts, compare_rank rank' rank with

| Ok _, 1 -> cache

let remove cache name =

LRU.remove name cache

"ipaddr" {>= "4.0.0"}

"lwt" {>= "4.0.0"}

"randomconv" {>= "0.2.0"}

"alcotest" {with-test}

]

let src = Dns.counter_metrics ~f "dns-resolver" in

(fun r -> Metrics.add src (fun x -> x) (fun d -> d r))

type key = [ `raw ] Domain_name.t * Packet.Question.qtype

let pp_key = Dns_resolver_cache.pp_question

Log.debug (fun m -> m "answering %a after %a %d out packets: %a"

pp_key awaiting.question Duration.pp time awaiting.retry

Packet.pp packet) ;

let cs, _ = Packet.encode ?max_size awaiting.proto packet in

let ttl = Packet.minimum_ttl (answer :> Packet.data) in

`Answer (ttl, cs), t

let packet = Packet.create ?edns ?additional (fst req.header, flags) req.question (reply :> Packet.data) in

let ttl = Packet.minimum_ttl (reply :> Packet.data) in

let pkt, _ = Packet.encode ?max_size proto packet in

t, [ proto, sender, sport, ttl, pkt ], []

(* send it out! we've a cache hit here! *)

end

begin

match handle_primary t.primary now ts proto sender sport res req buf with

| `Reply (primary, ttl, pkt) ->

Log.debug (fun m -> m "handled primary %a:%d" Ipaddr.pp sender sport) ;

{ t with primary }, [ proto, sender, sport, ttl, pkt ], []

| `Delegation dele ->

let no_sign ?mac:_ ?max_size:_ _ _ ~key:_ _ _ = None

let data : (string, int) Hashtbl.t = Hashtbl.create 7 in

(fun x ->

let key = f x in

let counter_metrics ~f name =

let open Metrics in

let doc = "Counter metrics" in

let data thing = incr thing; Data.v (get ()) in

Src.v ~doc ~tags:Metrics.Tags.[] ~data name

val counter_metrics : f:('a -> string) ->

string -> (Metrics.field list, 'a -> Metrics.Data.t) Metrics.src