From 4787dc914d4a320d6d3ae4cbafffca8a1b436fb1 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Thu, 15 May 2008 20:08:32 -0500
Subject: [PATCH 1/2] Fixing bugs in Windows sockets, add UDP tests
---
extra/io/sockets/sockets-tests.factor | 20 +++++++++++++++++-
extra/io/sockets/sockets.factor | 12 +++++++----
extra/io/unix/sockets/sockets.factor | 11 +++++-----
extra/io/windows/nt/sockets/sockets.factor | 24 ++++++++++++++++------
extra/io/windows/sockets/sockets.factor | 4 ++++
extra/windows/winsock/winsock.factor | 1 +
6 files changed, 55 insertions(+), 17 deletions(-)
mode change 100644 => 100755 extra/io/sockets/sockets-tests.factor
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 <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
diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor
index da10354261..0f07c8f1f1 100755
--- a/extra/io/sockets/sockets.factor
+++ b/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
- -rot
+ parse-sockaddr swap
+ 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
diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor
index 9e7676a509..0cfead0483 100755
--- a/extra/io/unix/sockets/sockets.factor
+++ b/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 )
- 2dup do-accept
+M:: object (accept) ( server addrspec -- fd sockaddr )
+ 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 ]
- [ (accept) ]
- 2bi
+ server +input+ wait-for-port
+ server addrspec (accept)
] }
[ (io-error) ]
} cond ;
diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor
index fab50ecdd6..c680d18077 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 <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
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 <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 ;
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
From 95aaf32373dab3bfa89e9ed2f4eec53d5dd5d53f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 16 May 2008 00:57:52 -0500
Subject: [PATCH 2/2] Fix conflict
---
extra/io/unix/sockets/sockets.factor | 20 +++++++++++---------
1 file changed, 11 insertions(+), 9 deletions(-)
diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor
index 0cfead0483..d4059c102a 100755
--- a/extra/io/unix/sockets/sockets.factor
+++ b/extra/io/unix/sockets/sockets.factor
@@ -70,18 +70,20 @@ 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 sockaddr )
- server addrspec do-accept
+M: object (accept) ( server addrspec -- fd sockaddr )
+ 2dup do-accept
{
- { [ dup 0 >= ] [ <fd> dup addrspec (get-remote-sockaddr) ] }
- { [ err_no EINTR = ] [ drop (accept) ] }
+ { [ over 0 >= ] [ >r 2nip <fd> r> ] }
+ { [ err_no EINTR = ] [ 2drop (accept) ] }
{ [ err_no EAGAIN = ] [
- drop
- server +input+ wait-for-port
- server addrspec (accept)
+ 2drop
+ [ drop +input+ wait-for-port ]
+ [ (accept) ]
+ 2bi
] }
[ (io-error) ]
} cond ;