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-05-31 15:34:51 -05:00
parent ca9efa8b60 f59cc01d9a
commit b380e3ad35
4 changed files with 40 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/dns/cache/cache.factor vendored
View File

@ -80,7 +80,7 @@ SYMBOL: NX
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ERROR: name-error name ; ! ERROR: name-error name ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

13
extra/dns/dns.factor
View File

@ -476,3 +476,16 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
: message-query ( message -- query ) question-section>> 1st ; : message-query ( message -- query ) question-section>> 1st ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ERROR: name-error name ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fully-qualified ( name -- name )
{
{ [ dup empty? ] [ "." append ] }
{ [ dup peek CHAR: . = ] [ ] }
{ [ t ] [ "." append ] }
}
cond ;

59
extra/dns/resolver/resolver.factor
View File

@ -6,34 +6,6 @@ IN: dns.resolver
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Need to cache records even in the case of name error
: 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 ) : canonical/cache ( name -- name )
dup CNAME IN query boa cache-get dup vector? ! name result ? dup CNAME IN query boa cache-get dup vector? ! name result ?
[ nip 1st rdata>> ] [ nip 1st rdata>> ]
@ -43,26 +15,17 @@ IN: dns.resolver
: name->ip/cache ( name -- ip ) : name->ip/cache ( name -- ip )
canonical/cache canonical/cache
dup A IN query boa cache-get ! name result dup A IN query boa cache-get ! name result
{
{ {
[ dup NX = ] { [ dup NX = ] [ 2drop f ] }
[ 2drop f ] { [ dup f = ] [ 2drop f ] }
{ [ t ] [ nip random rdata>> ] }
} }
{ cond ;
[ dup f = ]
[ 2drop f ]
}
{
[ t ]
[ nip random rdata>> ]
}
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: canonical/server ( name -- name ) : canonical/server ( name -- name )
dup CNAME IN query boa query->message ask* answer-section>> dup CNAME IN query boa query->message ask cache-message answer-section>>
[ type>> CNAME = ] filter dup empty? not [ type>> CNAME = ] filter dup empty? not
[ nip 1st rdata>> ] [ nip 1st rdata>> ]
[ drop ] [ drop ]
@ -70,7 +33,7 @@ IN: dns.resolver
: name->ip/server ( name -- ip ) : name->ip/server ( name -- ip )
canonical/server canonical/server
dup A IN query boa query->message ask* answer-section>> dup A IN query boa query->message ask cache-message answer-section>>
[ type>> A = ] filter dup empty? not [ type>> A = ] filter dup empty? not
[ nip random rdata>> ] [ nip random rdata>> ]
[ 2drop f ] [ 2drop f ]
@ -78,16 +41,6 @@ IN: dns.resolver
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fully-qualified ( name -- name )
{
{ [ dup empty? ] [ "." append ] }
{ [ dup peek CHAR: . = ] [ ] }
{ [ t ] [ "." append ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: name->ip ( name -- ip ) : name->ip ( name -- ip )
fully-qualified fully-qualified
dup name->ip/cache dup dup name->ip/cache dup

20
extra/dns/stub/stub.factor Normal file
View File

@ -0,0 +1,20 @@
USING: kernel sequences random accessors dns ;
IN: dns.stub
! Stub resolver
!
! Generally useful, but particularly when running a forwarding,
! caching, nameserver on localhost with multiple Factor instances
! querying it.
: name->ip ( name -- ip )
A IN query boa
query->message
ask
dup rcode>> NAME-ERROR =
[ message-query name>> name-error ]
[ answer-section>> [ type>> A = ] filter random rdata>> ]
if ;