diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor old mode 100644 new mode 100755 index b4dd910004..c411e30ae6 --- a/extra/io/sockets/sockets-tests.factor +++ b/extra/io/sockets/sockets-tests.factor @@ -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 "datagram1" set ] unit-test +[ ] [ "datagram1" get addr>> "addr1" set ] unit-test +[ f ] [ "addr1" get port>> 0 = ] unit-test + +[ ] [ "127.0.0.1" 0 "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 diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 031343351e..ae2b7872b9 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -203,22 +203,26 @@ GENERIC: (server) ( addrspec -- handle ) [ drop server-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 ] [ get-remote-address ] 2bi - -rot + parse-sockaddr swap + dup ] keep encoding>> swap ; TUPLE: datagram-port < port addr ; HOOK: (datagram) io-backend ( addr -- datagram ) -: ( addrspec -- datagram ) - dup (datagram) datagram-port swap >>addr ; +: ( addr -- datagram ) + [ + [ (datagram) |dispose ] keep + [ drop datagram-port ] [ get-local-address ] 2bi + >>addr + ] with-destructors ; : check-datagram-port ( port -- port ) dup check-disposed diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 9e7676a509..d4059c102a 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -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 ] bi* accept ; inline +: do-accept ( server addrspec -- fd sockaddr ) + [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* + [ accept ] 2keep drop ; inline -M: object (accept) ( server addrspec -- fd ) +M: object (accept) ( server addrspec -- fd sockaddr ) 2dup do-accept { - { [ dup 0 >= ] [ 2nip ] } - { [ err_no EINTR = ] [ drop (accept) ] } + { [ over 0 >= ] [ >r 2nip r> ] } + { [ err_no EINTR = ] [ 2drop (accept) ] } { [ err_no EAGAIN = ] [ - drop + 2drop [ drop +input+ wait-for-port ] [ (accept) ] 2bi diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index fab50ecdd6..fcad915d94 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -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 + 0 + f + [ 0 GetAcceptExSockaddrs ] keep *void* ; + +M: object (accept) ( server addr -- handle sockaddr ) [ - [ - + + { [ call-AcceptEx ] [ wait-for-socket drop ] - [ sAcceptSocket*>> opened-socket ] - tri - ] curry with-timeout + [ sAcceptSocket*>> ] + [ 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 ) [ diff --git a/extra/io/windows/sockets/sockets.factor b/extra/io/windows/sockets/sockets.factor index 67d827aa95..359776d639 100755 --- a/extra/io/windows/sockets/sockets.factor +++ b/extra/io/windows/sockets/sockets.factor @@ -30,6 +30,10 @@ M: object (get-local-address) ( socket addrspec -- sockaddr ) >r handle>> r> empty-sockaddr/size [ getsockname socket-error ] 2keep drop ; +M: object (get-remote-address) ( socket addrspec -- sockaddr ) + >r handle>> r> empty-sockaddr/size + [ getpeername socket-error ] 2keep drop ; + : bind-socket ( win32-socket sockaddr len -- ) >r >r handle>> r> r> bind socket-error ; diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor index 0699afc682..57181d2704 100755 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -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