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

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 <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

extra/io/sockets/sockets.factor

@@ -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

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 <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

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 <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 )
     [

extra/io/windows/sockets/sockets.factor

@@ -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 ;
 

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