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

db4
Doug Coleman 2008-10-18 21:46:48 -05:00
commit 941939a7a9
2 changed files with 0 additions and 234 deletions

View File

@ -1,185 +0,0 @@
USING: kernel continuations
combinators
sequences
math
random
unicode.case
accessors symbols
combinators.lib combinators.cleave
newfx
dns dns.cache ;
IN: dns.recursive
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: root-dns-servers ( -- servers )
{
"192.5.5.241"
"192.112.36.4"
"128.63.2.53"
"192.36.148.17"
"192.58.128.30"
"193.0.14.129"
"199.7.83.42"
"202.12.27.33"
"198.41.0.4"
} ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: {name-type-class} ( obj -- seq )
[ name>> >lower ] [ type>> ] [ class>> ] tri {3} ;
: rr=query? ( rr query -- ? ) [ {name-type-class} ] bi@ = ;
: rr-filter ( rrs query -- rrs ) [ rr=query? ] curry filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: answer-hits ( message -- rrs )
[ answer-section>> ] [ message-query ] bi rr-filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: name-hits ( message -- rrs )
[ answer-section>> ] [ message-query clone A >>type ] bi rr-filter ;
: cname-hits ( message -- rrs )
[ answer-section>> ] [ message-query clone CNAME >>type ] bi rr-filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: authority-hits ( message -- rrs )
authority-section>> [ type>> NS = ] filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOLS: ANSWERED NO-NAME-SERVERS UNCLASSIFIED ;
: classify-message ( message -- symbol )
{
{ [ dup rcode>> NAME-ERROR = ] [ drop NAME-ERROR ] }
{ [ dup rcode>> SERVER-FAILURE = ] [ drop SERVER-FAILURE ] }
{ [ dup answer-hits empty? not ] [ drop ANSWERED ] }
{ [ dup cname-hits empty? not ] [ drop CNAME ] }
{ [ dup authority-hits empty? ] [ drop NO-NAME-SERVERS ] }
{ [ t ] [ drop UNCLASSIFIED ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
DEFER: name->ip
! : name->ip/f ( name -- ip/f ) [ name->ip ] [ drop f ] recover ;
! : extract-ns-ips ( message -- ips )
! authority-hits [ rdata>> name->ip/f ] map [ ] filter ;
: extract-ns-ips ( message -- ips )
authority-hits [ rdata>> name->ip ] map [ ] filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: (recursive-query) ( query servers -- message )
dup random ! query servers server
pick query->message 0 >>rd ! query servers server message
over ask-server ! query servers server message
cache-message ! query servers server message
dup classify-message ! query servers server message sym
{
{ NAME-ERROR [ -roll 3drop ] }
{ ANSWERED [ -roll 3drop ] }
{ CNAME [ -roll 3drop ] }
{ NO-NAME-SERVERS [ -roll 3drop ] }
{
SERVER-FAILURE
[
-roll ! message query servers server
remove ! message query servers
dup empty?
[ 2drop ]
[ rot drop (recursive-query) ]
if
]
}
[ ! query servers server message sym
drop nip nip ! query message
extract-ns-ips ! query ips
(recursive-query)
]
}
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 )
dup CNAME IN query boa cache-get dup [ nip 1st rdata>> ] [ drop ] if ;
: name->ip/cache ( name -- ip/f )
canonical/cache
A IN query boa cache-get dup [ random rdata>> ] [ ] if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: name-hits? ( message -- message ? ) dup name-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 )
A IN query boa recursive-query ! message
{
{ [ name-hits? ] [ name-hits random rdata>> ] }
{ [ cname-hits? ] [ cname-hits random rdata>> name->ip ] }
{ [ t ] [ drop f ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : name->ip ( name -- ip )
! { [ name->ip/cache ] [ name->ip/server ] [ name-error ] } 1|| ;
: name->ip ( name -- ip )
dup name->ip/cache dup
[ nip ]
[
drop dup name->ip/server dup
[ nip ]
[ drop name-error ]
if
]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -1,49 +0,0 @@
USING: kernel vectors sequences combinators random
accessors newfx dns dns.cache ;
IN: dns.resolver
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: canonical/cache ( name -- name )
dup CNAME IN query boa cache-get dup vector? ! name result ?
[ nip 1st rdata>> ]
[ drop ]
if ;
: name->ip/cache ( name -- ip )
canonical/cache
dup A IN query boa cache-get ! name result
{
{ [ dup NX = ] [ 2drop f ] }
{ [ dup f = ] [ 2drop f ] }
{ [ t ] [ nip random rdata>> ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: canonical/server ( name -- name )
dup CNAME IN query boa query->message ask cache-message answer-section>>
[ type>> CNAME = ] filter dup empty? not
[ nip 1st rdata>> ]
[ drop ]
if ;
: name->ip/server ( name -- ip )
canonical/server
dup A IN query boa query->message ask cache-message answer-section>>
[ type>> A = ] filter dup empty? not
[ nip random rdata>> ]
[ 2drop f ]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: name->ip ( name -- ip )
fully-qualified
dup name->ip/cache dup
[ nip ]
[ drop name->ip/server ]
if ;