From 73eff2b1900d90fb12e8eb869a9a830922d4aafc Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 12 Jun 2008 22:51:53 -0500
Subject: [PATCH] dns.server: Refine fill-authority and fill-additional

---
 extra/dns/server/server.factor | 44 +++++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 16 deletions(-)

diff --git a/extra/dns/server/server.factor b/extra/dns/server/server.factor
index 1e7d9cb622..de36d661aa 100644
--- a/extra/dns/server/server.factor
+++ b/extra/dns/server/server.factor
@@ -39,18 +39,13 @@ IN: dns.server
   zones sort-largest-first [ name-in-domain? ] with find nip ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! fill-authority
+! name->authority
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: fill-authority ( message -- message )
-  [ ]
-  [ message-query name>> name->zone NS IN query boa matching-rrs ]
-  [ answer-section>> ]
-  tri
-  diff >>authority-section ;
+: name->authority ( name -- rrs-ns ) name->zone NS IN query boa matching-rrs ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! fill-additional
+! extract-names
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : rr->rdata-names ( rr -- names/f )
@@ -61,12 +56,33 @@ IN: dns.server
     }
   cond ;
 
+: extract-rdata-names ( message -- names )
+  [ answer-section>> ] [ authority-section>> ] bi append
+  [ rr->rdata-names ] map concat ;
+
+: extract-names ( message -- names )
+  [ message-query name>> ] [ extract-rdata-names ] bi prefix-on ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! fill-authority
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: fill-authority ( message -- message )
+  dup
+    extract-names [ name->authority ] map concat prune
+    over answer-section>> diff
+  >>authority-section ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! fill-additional
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: name->rrs-a ( name -- rrs-a ) A IN query boa matching-rrs ;
+
 : fill-additional ( message -- message )
   dup
-  [ answer-section>> ] [ authority-section>> ] bi append
-  [ rr->rdata-names ] map concat
-  [ A IN query boa matching-rrs ] map concat prune
-  over answer-section>> diff
+    extract-rdata-names [ name->rrs-a ] map concat prune
+    over answer-section>> diff
   >>additional-section ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -90,10 +106,6 @@ DEFER: query->rrs
 ! have-answers
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! : have-answers ( message -- message/f )
-!   dup message-query query->rrs        ! message rrs/f
-!   [ empty? ] [ 2drop f ] [ >>answer-section ] 1if ;
-
 : have-answers ( message -- message/f )
   dup message-query query->rrs
   [ empty? ]