Fixing bugs in Windows sockets, add UDP tests

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,14 +203,14 @@ 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
+        parse-sockaddr swap
-        -rot
+        dup <ports>
     ] keep encoding>> <encoder-duplex> swap ;
 
 TUPLE: datagram-port < port addr ;
@@ -218,7 +218,11 @@ TUPLE: datagram-port < port addr ;
 HOOK: (datagram) io-backend ( addr -- datagram )
 
 : <datagram> ( addr -- datagram )
-    dup (datagram) datagram-port <port> swap >>addr ;
+    [
+        [ (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

@@ -73,16 +73,15 @@ M: object (server) ( addrspec -- handle )
 : do-accept ( server addrspec -- fd )
     [ handle>> handle-fd ] [ empty-sockaddr/size <int> ] bi* accept ; inline
 
-M: object (accept) ( server addrspec -- fd )
+M:: object (accept) ( server addrspec -- fd sockaddr )
-    2dup do-accept
+    server addrspec do-accept
     {
-        { [ dup 0 >= ] [ 2nip <fd> ] }
+        { [ dup 0 >= ] [ <fd> dup addrspec (get-remote-sockaddr) ] }
         { [ err_no EINTR = ] [ drop (accept) ] }
         { [ err_no EAGAIN = ] [
             drop
-            [ drop +input+ wait-for-port ]
+            server +input+ wait-for-port
-            [ (accept) ]
+            server addrspec (accept)
-            2bi
         ] }
         [ (io-error) ]
     } cond ;

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>
+        {
             [ call-AcceptEx ]
             [ wait-for-socket drop ]
-            [ sAcceptSocket*>> opened-socket ]
+            [ sAcceptSocket*>> <win32-socket> ]
-            tri
+            [ extract-remote-address ]
-        ] curry with-timeout
+        } cleave
     ] with-destructors ;
 
 TUPLE: WSARecvFrom-args port

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