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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 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? ]