steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

dns.recursive: Try out an optimized name->ip/server

db4
Eduardo Cavazos 2008-05-29 05:17:55 -05:00
parent 188fab8f00
commit a109d10b3d
1 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
extra/dns/recursive/recursive.factor
View File

@ -2,6 +2,7 @@
USING: kernel continuations USING: kernel continuations
combinators combinators
sequences sequences
math
random random
unicode.case unicode.case
accessors symbols 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-type-class} ( obj -- seq )
[ name>> >lower ] [ type>> ] [ class>> ] tri {3} ; [ 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-hits ( message -- rrs )
[ answer-section>> ] [ message-query ] bi rr-filter ; [ 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 dup random ! query servers server
pick query->message 0 >>rd ! query servers server message pick query->message 0 >>rd ! query servers server message
over ask-server ! query servers server message over ask-server ! query servers server message
@ -128,20 +101,39 @@ DEFER: name->ip
remove ! message query servers remove ! message query servers
dup empty? dup empty?
[ 2drop ] [ 2drop ]
[ rot drop recursive-query ] [ rot drop (recursive-query) ]
if if
] ]
} }
[ ! query servers server message sym [ ! query servers server message sym
drop nip nip ! query message drop nip nip ! query message
extract-ns-ips ! query ips extract-ns-ips ! query ips
recursive-query (recursive-query)
] ]
} }
case ; 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 ) : canonical/cache ( name -- name )
dup CNAME IN query boa cache-get dup [ nip 1st rdata>> ] [ drop ] if ; 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 ; : name-hits? ( message -- message ? ) dup name-hits empty? not ;
: cname-hits? ( message -- message ? ) dup cname-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 ) : 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>> ] } { [ name-hits? ] [ name-hits random rdata>> ] }
{ [ cname-hits? ] [ cname-hits random rdata>> name->ip ] } { [ cname-hits? ] [ cname-hits random rdata>> name->ip ] }