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-06-15 03:45:40 -05:00
parent 10a87fc0af 3e6a6c2195
commit 52f5701f6c
2 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/dns/server/server.factor
View File

@ -1,8 +1,8 @@
USING: kernel combinators sequences sets math
USING: kernel combinators sequences sets math threads
io.sockets unicode.case accessors
combinators.cleave combinators.lib
newfx
newfx fry
dns dns.util dns.misc ;
IN: dns.server
@ -50,9 +50,10 @@ IN: dns.server
: rr->rdata-names ( rr -- names/f )
{
{ [ dup type>> NS = ] [ rdata>> {1} ] }
{ [ dup type>> MX = ] [ rdata>> exchange>> {1} ] }
{ [ t ] [ drop f ] }
{ [ dup type>> NS = ] [ rdata>> {1} ] }
{ [ dup type>> MX = ] [ rdata>> exchange>> {1} ] }
{ [ dup type>> CNAME = ] [ rdata>> {1} ] }
{ [ t ] [ drop f ] }
}
cond ;
@ -203,15 +204,18 @@ DEFER: query->rrs
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: loop ( -- )
socket receive
swap
: (handle-request) ( byte-array addr-spec -- )
>r
parse-message
find-answer
message->ba
swap
socket send
loop ;
r>
socket send ;
: handle-request ( byte-array addr-spec -- )
'[ , , (handle-request) ] in-thread ;
: loop ( -- ) socket receive handle-request loop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

8
extra/newfx/newfx.factor
View File

@ -1,11 +1,12 @@
USING: kernel sequences assocs qualified circular ;
USING: kernel sequences assocs qualified circular sets ;
USING: math multi-methods ;
QUALIFIED: sequences
QUALIFIED: assocs
QUALIFIED: circular
QUALIFIED: sets
IN: newfx
@ -190,3 +191,8 @@ METHOD: as-mutate { object object assoc } set-at ;
! A note about the 'mutate' qualifier. Other words also technically mutate
! their primary object. However, the 'mutate' qualifier is supposed to
! indicate that this is the main objective of the word, as a side effect.
: adjoin ( seq elt -- seq ) over sets:adjoin ;
: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ;
: adjoined ( set elt -- ) swap sets:adjoin ;
: adjoined-on ( elt set -- ) sets:adjoin ;