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

dns.server: Refine fill-authority and fill-additional

db4
Eduardo Cavazos 2008-06-12 22:51:53 -05:00
parent 60a5c98883
commit 73eff2b190
1 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
extra/dns/server/server.factor
View File

@ -39,18 +39,13 @@ IN: dns.server
zones sort-largest-first [ name-in-domain? ] with find nip ; zones sort-largest-first [ name-in-domain? ] with find nip ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! fill-authority ! name->authority
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fill-authority ( message -- message ) : name->authority ( name -- rrs-ns ) name->zone NS IN query boa matching-rrs ;
[ ]
[ message-query name>> name->zone NS IN query boa matching-rrs ]
[ answer-section>> ]
tri
diff >>authority-section ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! fill-additional ! extract-names
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rr->rdata-names ( rr -- names/f ) : rr->rdata-names ( rr -- names/f )
@ -61,12 +56,33 @@ IN: dns.server
} }
cond ; 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 ) : fill-additional ( message -- message )
dup dup
[ answer-section>> ] [ authority-section>> ] bi append extract-rdata-names [ name->rrs-a ] map concat prune
[ rr->rdata-names ] map concat over answer-section>> diff
[ A IN query boa matching-rrs ] map concat prune
over answer-section>> diff
>>additional-section ; >>additional-section ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -90,10 +106,6 @@ DEFER: query->rrs
! have-answers ! 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 ) : have-answers ( message -- message/f )
dup message-query query->rrs dup message-query query->rrs
[ empty? ] [ empty? ]