Merge branch 'master' of git://factorcode.org/git/factor
commit
394b14d501
|
@ -5,10 +5,6 @@ HELP: frame-required
|
|||
{ $values { "n" "a non-negative integer" } }
|
||||
{ $description "Notify the code generator that the currently compiling code block needs a stack frame with room for at least " { $snippet "n" } " parameters." } ;
|
||||
|
||||
HELP: (rel-fixup)
|
||||
{ $values { "arg" integer } { "class" "a relocation class" } { "type" "a relocation type" } { "offset" integer } { "byte-array" byte-array } }
|
||||
{ $description "Creates a relocation instruction for the VM's runtime compiled code linker." } ;
|
||||
|
||||
HELP: add-literal
|
||||
{ $values { "obj" object } { "n" integer } }
|
||||
{ $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
|
||||
|
|
|
@ -0,0 +1,91 @@
|
|||
|
||||
USING: kernel
|
||||
combinators
|
||||
vectors
|
||||
io.sockets
|
||||
accessors
|
||||
newfx
|
||||
dns dns.cache ;
|
||||
|
||||
IN: dns.forwarding
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! DNS server - caching, forwarding
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (socket) ( -- vec ) V{ f } ;
|
||||
|
||||
: socket ( -- socket ) (socket) 1st ;
|
||||
|
||||
: init-socket ( -- ) f 5353 <inet4> <datagram> 0 (socket) as-mutate ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (upstream-server) ( -- vec ) V{ f } ;
|
||||
|
||||
: upstream-server ( -- ip ) (upstream-server) 1st ;
|
||||
|
||||
: set-upstream-server ( ip -- ) 0 (upstream-server) as-mutate ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: query->answer/cache ( query -- rrs/NX/f )
|
||||
{
|
||||
{ [ dup type>> CNAME = ] [ cache-get* ] }
|
||||
{
|
||||
[ dup clone CNAME >>type cache-get* vector? ]
|
||||
[
|
||||
dup clone CNAME >>type cache-get* 1st ! query rr/cname
|
||||
dup rdata>> ! query rr/cname cname
|
||||
>r swap clone r> ! rr/cname query cname
|
||||
>>name ! rr/cname query
|
||||
query->answer/cache ! rr/cname rrs/NX/f
|
||||
{
|
||||
{ [ dup vector? ] [ clone push-on ] }
|
||||
{ [ dup NX = ] [ nip ] }
|
||||
{ [ dup f = ] [ nip ] }
|
||||
}
|
||||
cond
|
||||
]
|
||||
}
|
||||
{ [ t ] [ cache-get* ] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: answer-from-cache ( message -- message/f )
|
||||
dup message-query ! message query
|
||||
dup query->answer/cache ! message query rrs/NX/f
|
||||
{
|
||||
{ [ dup f = ] [ 3drop f ] }
|
||||
{ [ dup NX = ] [ 2drop NAME-ERROR >>rcode ] }
|
||||
{ [ t ] [ nip >>answer-section ] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: answer-from-server ( message -- message )
|
||||
upstream-server ask-server
|
||||
cache-message ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: find-answer ( message -- message )
|
||||
dup answer-from-cache dup
|
||||
[ nip ]
|
||||
[ drop answer-from-server ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: loop ( -- )
|
||||
socket receive ! byte-array addr-spec
|
||||
swap ! addr-spec byte-array
|
||||
parse-message ! addr-spec message
|
||||
find-answer ! addr-spec message
|
||||
message->ba ! addr-spec byte-array
|
||||
swap ! byte-array addr-spec
|
||||
socket send
|
||||
loop ;
|
Loading…
Reference in New Issue