Merge branch 'master' of git://factorcode.org/git/factor
commit
68e7f229f4
|
@ -424,6 +424,10 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
}
|
}
|
||||||
2cleave message boa ;
|
2cleave message boa ;
|
||||||
|
|
||||||
|
: ba->message ( ba -- message ) parse-message ;
|
||||||
|
|
||||||
|
: with-message-bytes ( ba quot -- ) >r ba->message r> call message->ba ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: send-receive-udp ( ba server -- ba )
|
: send-receive-udp ( ba server -- ba )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel combinators sequences sets math threads
|
USING: kernel combinators sequences sets math threads namespaces continuations
|
||||||
io.sockets unicode.case accessors
|
debugger io io.sockets unicode.case accessors destructors
|
||||||
combinators.cleave combinators.lib
|
combinators.cleave combinators.lib
|
||||||
newfx fry
|
newfx fry
|
||||||
dns dns.util dns.misc ;
|
dns dns.util dns.misc ;
|
||||||
|
@ -9,7 +9,9 @@ IN: dns.server
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: records ( -- vector ) V{ } ;
|
SYMBOL: records-var
|
||||||
|
|
||||||
|
: records ( -- records ) records-var get ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -193,34 +195,14 @@ DEFER: query->rrs
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: (socket) ( -- vec ) V{ f } ;
|
: (handle-request) ( packet -- )
|
||||||
|
[ [ find-answer ] with-message-bytes ] change-data respond ;
|
||||||
|
|
||||||
: socket ( -- socket ) (socket) 1st ;
|
: handle-request ( packet -- ) [ (handle-request) ] curry in-thread ;
|
||||||
|
|
||||||
: init-socket-on-port ( port -- )
|
: receive-loop ( socket -- )
|
||||||
f swap <inet4> <datagram> 0 (socket) as-mutate ;
|
[ receive-packet handle-request ] [ receive-loop ] bi ;
|
||||||
|
|
||||||
: init-socket ( -- ) 53 init-socket-on-port ;
|
: loop ( addr-spec -- )
|
||||||
|
[ <datagram> '[ , [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: (handle-request) ( byte-array addr-spec -- )
|
|
||||||
>r
|
|
||||||
parse-message
|
|
||||||
find-answer
|
|
||||||
message->ba
|
|
||||||
r>
|
|
||||||
socket send ;
|
|
||||||
|
|
||||||
: handle-request ( byte-array addr-spec -- )
|
|
||||||
'[ , , (handle-request) ] in-thread ;
|
|
||||||
|
|
||||||
: loop ( -- ) socket receive handle-request loop ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: start ( -- ) init-socket loop ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
MAIN: start
|
|
||||||
|
|
|
@ -17,3 +17,14 @@ MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: longer? ( seq seq -- ? ) [ length ] bi@ > ;
|
: longer? ( seq seq -- ? ) [ length ] bi@ > ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
USING: io.sockets accessors ;
|
||||||
|
|
||||||
|
TUPLE: packet data addr socket ;
|
||||||
|
|
||||||
|
: receive-packet ( socket -- packet ) [ receive ] keep packet boa ;
|
||||||
|
|
||||||
|
: respond ( packet -- ) [ data>> ] [ addr>> ] [ socket>> ] tri send ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue