From fbfd2e2114632e5fa45cc57c0d3147b4077fbc30 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 12 Jun 2008 01:49:41 -0500 Subject: [PATCH] dns.server: Zone words. fill-authority. fill-additional. --- extra/dns/misc/misc.factor | 26 +++++++- extra/dns/server/server.factor | 116 +++++++++++++++++++++++++++------ extra/dns/util/util.factor | 12 +++- 3 files changed, 131 insertions(+), 23 deletions(-) diff --git a/extra/dns/misc/misc.factor b/extra/dns/misc/misc.factor index 90731cec43..6e62513a80 100644 --- a/extra/dns/misc/misc.factor +++ b/extra/dns/misc/misc.factor @@ -1,12 +1,34 @@ -USING: kernel sequences splitting io.files io.encodings.utf8 random newfx ; +USING: kernel combinators sequences splitting math + io.files io.encodings.utf8 random newfx dns.util ; IN: dns.misc +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : resolv-conf-servers ( -- seq ) "/etc/resolv.conf" utf8 file-lines [ " " split ] map [ 1st "nameserver" = ] filter [ 2nd ] map ; -: resolv-conf-server ( -- ip ) resolv-conf-servers random ; \ No newline at end of file +: resolv-conf-server ( -- ip ) resolv-conf-servers random ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cdr-name ( name -- name ) dup CHAR: . index 1+ tail ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: domain-has-name? ( domain name -- ? ) + { + { [ 2dup = ] [ 2drop t ] } + { [ 2dup longer? ] [ 2drop f ] } + { [ t ] [ cdr-name domain-has-name? ] } + } + cond ; + +: name-in-domain? ( name domain -- ? ) swap domain-has-name? ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/extra/dns/server/server.factor b/extra/dns/server/server.factor index e1c32af970..1e7d9cb622 100644 --- a/extra/dns/server/server.factor +++ b/extra/dns/server/server.factor @@ -1,14 +1,9 @@ -USING: kernel - combinators - sequences - math - io.sockets - unicode.case - accessors +USING: kernel combinators sequences sets math + io.sockets unicode.case accessors combinators.cleave combinators.lib newfx - dns dns.util ; + dns dns.util dns.misc ; IN: dns.server @@ -27,6 +22,53 @@ IN: dns.server : matching-rrs ( query -- rrs ) records [ rr=query? ] with filter ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! zones +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: zones ( -- names ) records [ type>> NS = ] filter [ name>> ] map prune ; +: my-zones ( -- names ) records [ type>> SOA = ] filter [ name>> ] map ; + +: delegated-zones ( -- names ) zones my-zones diff ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! name->zone +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name->zone ( name -- zone/f ) + zones sort-largest-first [ name-in-domain? ] with find nip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! fill-authority +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fill-authority ( message -- message ) + [ ] + [ message-query name>> name->zone NS IN query boa matching-rrs ] + [ answer-section>> ] + tri + diff >>authority-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! fill-additional +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rr->rdata-names ( rr -- names/f ) + { + { [ dup type>> NS = ] [ rdata>> {1} ] } + { [ dup type>> MX = ] [ rdata>> exchange>> {1} ] } + { [ t ] [ drop f ] } + } + cond ; + +: 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 + >>additional-section ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! query->rrs ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -48,9 +90,16 @@ 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 ! message rrs/f - [ empty? ] [ 2drop f ] [ >>answer-section ] 1if ; + dup message-query query->rrs + [ empty? ] + [ 2drop f ] + [ >>answer-section fill-authority fill-additional ] + 1if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! have-delegates? @@ -64,13 +113,13 @@ DEFER: query->rrs NS IN query boa matching-rrs [ empty? ] [ drop f ] [ ] 1if ; : name->delegates ( name -- rrs-ns ) - { - [ "" = { } and ] - [ is-soa? { } and ] - [ have-ns? ] - [ cdr-name name->delegates ] - } - 1|| ; + { + [ "" = { } and ] + [ is-soa? { } and ] + [ have-ns? ] + [ cdr-name name->delegates ] + } + 1|| ; : have-delegates ( message -- message/f ) dup message-query name>> name->delegates ! message rrs-ns @@ -85,20 +134,49 @@ DEFER: query->rrs ] 1if ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! outsize-zones +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: outside-zones ( message -- message/f ) + dup message-query name>> name->zone f = + [ ] + [ drop f ] + if ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! is-nx ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : is-nx ( message -- message/f ) [ message-query name>> records [ name>> = ] with filter empty? ] - [ NAME-ERROR >>rcode ] + [ + NAME-ERROR >>rcode + dup + message-query name>> name->zone SOA IN query boa matching-rrs + >>authority-section + ] [ drop f ] 1if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: none-of-type ( message -- message ) + dup + message-query name>> name->zone SOA IN query boa matching-rrs + >>authority-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : find-answer ( message -- message ) - { [ have-answers ] [ have-delegates ] [ is-nx ] [ ] } 1|| ; + { + [ have-answers ] + [ have-delegates ] + [ outside-zones ] + [ is-nx ] + [ none-of-type ] + } + 1|| ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/dns/util/util.factor b/extra/dns/util/util.factor index bee1cc111e..5933216a3c 100644 --- a/extra/dns/util/util.factor +++ b/extra/dns/util/util.factor @@ -1,5 +1,5 @@ -USING: kernel macros fry ; +USING: kernel sequences sorting math math.order macros fry ; IN: dns.util @@ -8,4 +8,12 @@ IN: dns.util MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ; -! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ; \ No newline at end of file +! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: sort-largest-first ( seq -- seq ) [ [ length ] compare ] sort reverse ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: longer? ( seq seq -- ? ) [ length ] bi@ > ; \ No newline at end of file