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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-06-12 03:32:26 -05:00
parent 92a8084f0f 60a5c98883
commit d6307cdeda
3 changed files with 131 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/dns/misc/misc.factor
View File

@ -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 ;
: 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? ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

@ -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|| ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

12
extra/dns/util/util.factor
View File

@ -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 ;
! : 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@ > ;