Merge branch 'master' of git://factorcode.org/git/factor

db4
slava 2008-05-16 01:45:11 -05:00
commit ab35ca70be
6 changed files with 61 additions and 19 deletions

20
extra/io/sockets/sockets-tests.factor Normal file → Executable file
View File

@ -1,5 +1,6 @@
IN: io.sockets.tests
USING: io.sockets sequences math tools.test ;
USING: io.sockets sequences math tools.test namespaces accessors
kernel destructors ;
[ B{ 1 2 3 4 } ]
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
@ -44,3 +45,20 @@ USING: io.sockets sequences math tools.test ;
[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
[ t ] [ "localhost" 80 f resolve-host length 1 >= ] unit-test
! Smoke-test UDP
[ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram1" set ] unit-test
[ ] [ "datagram1" get addr>> "addr1" set ] unit-test
[ f ] [ "addr1" get port>> 0 = ] unit-test
[ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram2" set ] unit-test
[ ] [ "datagram2" get addr>> "addr2" set ] unit-test
[ f ] [ "addr2" get port>> 0 = ] unit-test
[ ] [ B{ 1 2 3 4 } "addr2" get "datagram1" get send ] unit-test
[ B{ 1 2 3 4 } ] [ "datagram2" get receive "from" set ] unit-test
[ ] [ B{ 4 3 2 1 } "from" get "datagram2" get send ] unit-test
[ B{ 4 3 2 1 } t ] [ "datagram1" get receive "addr2" get = ] unit-test
[ ] [ "datagram1" get dispose ] unit-test
[ ] [ "datagram2" get dispose ] unit-test

View File

@ -203,22 +203,26 @@ GENERIC: (server) ( addrspec -- handle )
[ drop server-port <port> ] [ get-local-address ] 2bi
>>addr r> >>encoding ;
GENERIC: (accept) ( server addrspec -- handle )
GENERIC: (accept) ( server addrspec -- handle sockaddr )
: accept ( server -- client remote )
[
dup addr>>
[ (accept) ] keep
[ drop dup <ports> ] [ get-remote-address ] 2bi
-rot
parse-sockaddr swap
dup <ports>
] keep encoding>> <encoder-duplex> swap ;
TUPLE: datagram-port < port addr ;
HOOK: (datagram) io-backend ( addr -- datagram )
: <datagram> ( addrspec -- datagram )
dup (datagram) datagram-port <port> swap >>addr ;
: <datagram> ( addr -- datagram )
[
[ (datagram) |dispose ] keep
[ drop datagram-port <port> ] [ get-local-address ] 2bi
>>addr
] with-destructors ;
: check-datagram-port ( port -- port )
dup check-disposed

View File

@ -70,16 +70,17 @@ M: object (server) ( addrspec -- handle )
dup handle-fd 10 listen io-error
] with-destructors ;
: do-accept ( server addrspec -- fd )
[ handle>> handle-fd ] [ empty-sockaddr/size <int> ] bi* accept ; inline
: do-accept ( server addrspec -- fd sockaddr )
[ handle>> handle-fd ] [ empty-sockaddr/size <int> ] bi*
[ accept ] 2keep drop ; inline
M: object (accept) ( server addrspec -- fd )
M: object (accept) ( server addrspec -- fd sockaddr )
2dup do-accept
{
{ [ dup 0 >= ] [ 2nip <fd> ] }
{ [ err_no EINTR = ] [ drop (accept) ] }
{ [ over 0 >= ] [ >r 2nip <fd> r> ] }
{ [ err_no EINTR = ] [ 2drop (accept) ] }
{ [ err_no EAGAIN = ] [
drop
2drop
[ drop +input+ wait-for-port ]
[ (accept) ]
2bi

View File

@ -82,15 +82,27 @@ TUPLE: AcceptEx-args port
AcceptEx-args >tuple*< AcceptEx drop
winsock-error-string [ throw ] when* ;
M: object (accept) ( server addr -- handle )
: extract-remote-address ( AcceptEx -- sockaddr )
{
[ lpOutputBuffer*>> ]
[ dwReceiveDataLength*>> ]
[ dwLocalAddressLength*>> ]
[ dwRemoteAddressLength*>> ]
} cleave
f <void*>
0 <int>
f <void*>
[ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
M: object (accept) ( server addr -- handle sockaddr )
[
[
<AcceptEx-args>
<AcceptEx-args>
{
[ call-AcceptEx ]
[ wait-for-socket drop ]
[ sAcceptSocket*>> opened-socket ]
tri
] curry with-timeout
[ sAcceptSocket*>> <win32-socket> ]
[ extract-remote-address ]
} cleave
] with-destructors ;
TUPLE: WSARecvFrom-args port
@ -119,7 +131,9 @@ TUPLE: WSARecvFrom-args port
WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ;
: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
[ lpBuffers*>> WSABUF-buf swap memory>byte-array ] [ lpFrom*>> ] bi ;
[ lpBuffers*>> WSABUF-buf swap memory>byte-array ]
[ lpFromLen*>> *int . ]
[ lpFrom*>> ] tri ;
M: winnt (receive) ( datagram -- packet addrspec )
[

View File

@ -30,6 +30,10 @@ M: object (get-local-address) ( socket addrspec -- sockaddr )
>r handle>> r> empty-sockaddr/size <int>
[ getsockname socket-error ] 2keep drop ;
M: object (get-remote-address) ( socket addrspec -- sockaddr )
>r handle>> r> empty-sockaddr/size <int>
[ getpeername socket-error ] 2keep drop ;
: bind-socket ( win32-socket sockaddr len -- )
>r >r handle>> r> r> bind socket-error ;

View File

@ -168,6 +168,7 @@ FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
TYPEDEF: uint SERVICETYPE
TYPEDEF: OVERLAPPED WSAOVERLAPPED