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-29 18:36:06 -05:00
parent 4ef0ff1ca1 a8cdb2226d
commit 753edf7c4c
5 changed files with 76 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -119,3 +119,31 @@ ERROR: name-error name ;
: cache-add-rr ( rr -- ) [ rr->query ] [ ] bi cache-add ;
: cache-add-rrs ( rrs -- ) [ cache-add-rr ] each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! cache-name-error
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: message-soa ( message -- rr/soa )
authority-section>> [ type>> SOA = ] filter 1st ;
: cache-name-error ( message -- message )
dup
[ message-query ] [ message-soa ttl>> ] bi
cache-nx ;
: cache-message-records ( message -- message )
dup
{
[ answer-section>> cache-add-rrs ]
[ authority-section>> cache-add-rrs ]
[ additional-section>> cache-add-rrs ]
}
cleave ;
: cache-message ( message -- message )
dup rcode>> NAME-ERROR = [ cache-name-error ] when
cache-message-records ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

7
extra/dns/dns.factor
View File

@ -470,4 +470,9 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
: ask ( message -- message ) dns-server ask-server ;
: <query-message> ( query -- message ) <message> swap {1} >>question-section ;
: query->message ( query -- message ) <message> swap {1} >>question-section ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: message-query ( message -- query ) question-section>> 1st ;

67
extra/dns/recursive/recursive.factor
View File

@ -2,6 +2,7 @@
USING: kernel continuations
combinators
sequences
math
random
unicode.case
accessors symbols
@ -28,30 +29,6 @@ IN: dns.recursive
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: query->message ( query -- message ) <query-message> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: {name-type-class} ( obj -- seq )
[ name>> >lower ] [ type>> ] [ class>> ] tri {3} ;
@ -61,10 +38,6 @@ IN: dns.recursive
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: message-query ( message -- query ) question-section>> 1st ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: answer-hits ( message -- rrs )
[ answer-section>> ] [ message-query ] bi rr-filter ;
@ -110,7 +83,7 @@ DEFER: name->ip
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: recursive-query ( query servers -- message )
: (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
@ -128,20 +101,39 @@ DEFER: name->ip
remove ! message query servers
dup empty?
[ 2drop ]
[ rot drop recursive-query ]
[ rot drop (recursive-query) ]
if
]
}
[ ! query servers server message sym
drop nip nip ! query message
extract-ns-ips ! query ips
recursive-query
(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 ;
@ -154,8 +146,19 @@ DEFER: name->ip
: 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 root-dns-servers recursive-query ! message
A IN query boa recursive-query ! message
{
{ [ name-hits? ] [ name-hits random rdata>> ] }
{ [ cname-hits? ] [ cname-hits random rdata>> name->ip ] }

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

@ -62,7 +62,7 @@ IN: dns.resolver
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: canonical/server ( name -- name )
dup CNAME IN query boa <query-message> ask* answer-section>>
dup CNAME IN query boa query->message ask* answer-section>>
[ type>> CNAME = ] filter dup empty? not
[ nip 1st rdata>> ]
[ drop ]
@ -70,7 +70,7 @@ IN: dns.resolver
: name->ip/server ( name -- ip )
canonical/server
dup A IN query boa <query-message> ask* answer-section>>
dup A IN query boa query->message ask* answer-section>>
[ type>> A = ] filter dup empty? not
[ nip random rdata>> ]
[ 2drop f ]

5
extra/newfx/newfx.factor
View File

@ -170,6 +170,11 @@ METHOD: as-mutate { object object assoc } set-at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: index ( seq obj -- i ) swap sequences:index ;
: index-of ( obj seq -- i ) sequences:index ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 1st 0 at ;
: 2nd 1 at ;
: 3rd 2 at ;