From a109d10b3df78961f596f9f1c68b199ffda473e0 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 29 May 2008 05:17:55 -0500
Subject: [PATCH] dns.recursive: Try out an optimized name->ip/server

---
 extra/dns/recursive/recursive.factor | 67 +++++++++++++++-------------
 1 file changed, 35 insertions(+), 32 deletions(-)

diff --git a/extra/dns/recursive/recursive.factor b/extra/dns/recursive/recursive.factor
index 6fe8ec96da..3a74667845 100644
--- a/extra/dns/recursive/recursive.factor
+++ b/extra/dns/recursive/recursive.factor
@@ -2,6 +2,7 @@
 USING: kernel continuations
        combinators
        sequences
+       math
        random
        unicode.case
        accessors symbols
@@ -28,30 +29,6 @@ IN: dns.recursive
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: cache-message ( message -- message )
-  dup dup rcode>> NAME-ERROR =
-    [
-      [ question-section>> 1st ]
-      [ authority-section>> [ type>> SOA = ] filter random ttl>> ]
-      bi
-      cache-nx
-    ]
-    [
-        {
-          [ answer-section>>     cache-add-rrs ]
-          [ authority-section>>  cache-add-rrs ]
-          [ additional-section>> cache-add-rrs ]
-        }
-      cleave
-    ]
-  if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: query->message ( query -- message ) <query-message> ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : {name-type-class} ( obj -- seq )
   [ name>> >lower ] [ type>> ] [ class>> ] tri {3} ;
 
@@ -61,10 +38,6 @@ IN: dns.recursive
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: message-query ( message -- query ) question-section>> 1st ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : answer-hits ( message -- rrs )
   [ answer-section>> ] [ message-query ] bi rr-filter ;
 
@@ -110,7 +83,7 @@ DEFER: name->ip
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: recursive-query ( query servers -- message )
+: (recursive-query) ( query servers -- message )
   dup random                                 ! query servers server
   pick query->message 0 >>rd                 ! query servers server message
   over ask-server                            ! query servers server message
@@ -128,20 +101,39 @@ DEFER: name->ip
           remove                             ! message query servers
           dup empty?
             [ 2drop ]
-            [ rot drop recursive-query ]
+            [ rot drop (recursive-query) ]
           if
         ]
       }
       [                                      ! query servers server message sym
         drop nip nip                         ! query message
         extract-ns-ips                       ! query ips
-        recursive-query
+        (recursive-query)
       ]
     }
   case ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: cdr-name ( name -- name ) dup CHAR: . index 1+ tail ;
+
+: cache-get-ns ( name -- seq/f ) NS IN query boa cache-get ;
+
+: name->servers ( name -- servers )
+    {
+      { [ dup "" = ]         [ drop root-dns-servers ] }
+      { [ dup cache-get-ns ] [ cache-get-ns [ rdata>> name->ip ] map ] }
+      { [ t ]                [ cdr-name name->servers ] }
+    }
+  cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: recursive-query ( query -- message )
+  dup name>> name->servers (recursive-query) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : canonical/cache ( name -- name )
   dup CNAME IN query boa cache-get dup [ nip 1st rdata>> ] [ drop ] if ;
 
@@ -154,8 +146,19 @@ DEFER: name->ip
 :  name-hits? ( message -- message ? ) dup  name-hits empty? not ;
 : cname-hits? ( message -- message ? ) dup cname-hits empty? not ;
 
+! : name->ip/server ( name -- ip-or-f )
+!   A IN query boa root-dns-servers recursive-query ! message
+!     {
+!       { [ name-hits? ]  [ name-hits  random rdata>>          ] }
+!       { [ cname-hits? ] [ cname-hits random rdata>> name->ip ] }
+!       { [ t           ] [ drop f ] }
+!     }
+!   cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : name->ip/server ( name -- ip-or-f )
-  A IN query boa root-dns-servers recursive-query ! message
+  A IN query boa recursive-query ! message
     {
       { [ name-hits? ]  [ name-hits  random rdata>>          ] }
       { [ cname-hits? ] [ cname-hits random rdata>> name->ip ] }