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

db4
Doug Coleman 2008-05-24 20:06:40 -05:00
commit 2d89fee927
1 changed files with 94 additions and 0 deletions

View File

@ -0,0 +1,94 @@
USING: kernel vectors sequences combinators random
accessors newfx dns dns.cache ;
IN: dns.resolver
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: cache-message ( message -- message )
dup dup rcode>> NAME-ERROR =
[
[ question-section>> 1st ]
[ authority-section>> [ type>> SOA = ] filter random ttl>> ]
bi
cache-nx
]
[
{
[ answer-section>> cache-add-rrs ]
[ authority-section>> cache-add-rrs ]
[ additional-section>> cache-add-rrs ]
}
cleave
]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Ask and cache the records
: ask* ( message -- message ) ask cache-message ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 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* 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* answer-section>>
[ type>> A = ] filter dup empty? not
[ nip random rdata>> ]
[ 2drop f ]
if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fully-qualified ( name -- name )
{
{ [ dup empty? ] [ "." append ] }
{ [ dup peek CHAR: . = ] [ ] }
{ [ t ] [ "." append ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: name->ip ( name -- ip )
fully-qualified
dup name->ip/cache dup
[ nip ]
[ drop name->ip/server ]
if ;