steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix sockets on Windows, and re-organize things so that windows.winsock doesn't get loaded by default

db4
Slava Pestov 2009-09-04 05:02:33 -05:00
parent 742db564f3
commit 223b907219
8 changed files with 105 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/io/backend/windows/nt/nt.factor
View File

@ -4,7 +4,6 @@ io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
io.streams.c io.streams.null libc kernel math namespaces sequences io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting threads windows windows.errors windows.kernel32 strings splitting
ascii system accessors locals classes.struct combinators.short-circuit ; ascii system accessors locals classes.struct combinators.short-circuit ;
QUALIFIED: windows.winsock
IN: io.backend.windows.nt IN: io.backend.windows.nt
! Global variable with assoc mapping overlapped to threads ! Global variable with assoc mapping overlapped to threads
@ -79,8 +78,7 @@ M: winnt io-multiplex ( us -- )
M: winnt init-io ( -- ) M: winnt init-io ( -- )
<master-completion-port> master-completion-port set-global <master-completion-port> master-completion-port set-global
H{ } clone pending-overlapped set-global H{ } clone pending-overlapped set-global ;
windows.winsock:init-winsock ;
ERROR: invalid-file-size n ; ERROR: invalid-file-size n ;

4
basis/io/backend/windows/windows.factor
View File

@ -3,8 +3,8 @@
USING: alien alien.c-types arrays destructors io io.backend USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.ports io.binary io.timeouts system io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock windows.kernel32 windows.shell32 windows.types splitting
splitting continuations math.bitwise accessors init sets assocs continuations math.bitwise accessors init sets assocs
classes.struct classes ; classes.struct classes ;
IN: io.backend.windows IN: io.backend.windows

7
basis/io/sockets/sockets-tests.factor Normal file → Executable file
View File

@ -1,7 +1,8 @@
IN: io.sockets.tests IN: io.sockets.tests
USING: io.sockets sequences math tools.test namespaces accessors USING: io.sockets io.sockets.private sequences math tools.test
kernel destructors calendar io.timeouts io.encodings.utf8 io namespaces accessors kernel destructors calendar io.timeouts
concurrency.promises threads io.streams.string ; io.encodings.utf8 io concurrency.promises threads
io.streams.string ;
[ B{ 1 2 3 4 } ] [ B{ 1 2 3 4 } ]
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test

18
basis/io/sockets/sockets.factor Normal file → Executable file
View File

@ -39,13 +39,9 @@ GENERIC: inet-pton ( str addrspec -- data )
GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
: sockaddr-of-family ( alien af -- addrspec ) HOOK: sockaddr-of-family os ( alien af -- sockaddr )
{
{ AF_INET [ sockaddr-in memory>struct ] } HOOK: addrspec-of-family os ( af -- addrspec )
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
{ AF_UNIX [ sockaddr-un memory>struct ] }
[ 2drop f ]
} case ;
PRIVATE> PRIVATE>
@ -223,14 +219,6 @@ HOOK: (receive) io-backend ( datagram -- packet addrspec )
HOOK: (send) io-backend ( packet addrspec datagram -- ) HOOK: (send) io-backend ( packet addrspec datagram -- )
: addrspec-of-family ( af -- addrspec )
{
{ AF_INET [ T{ inet4 } ] }
{ AF_INET6 [ T{ inet6 } ] }
{ AF_UNIX [ T{ local } ] }
[ drop f ]
} case ;
: addrinfo>addrspec ( addrinfo -- addrspec ) : addrinfo>addrspec ( addrinfo -- addrspec )
[ [ addr>> ] [ family>> ] bi sockaddr-of-family ] [ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
[ family>> addrspec-of-family ] bi [ family>> addrspec-of-family ] bi

40
basis/io/sockets/unix/unix.factor Normal file → Executable file
View File

@ -22,6 +22,22 @@ IN: io.sockets.unix
M: unix addrinfo-error ( n -- ) M: unix addrinfo-error ( n -- )
[ gai_strerror throw ] unless-zero ; [ gai_strerror throw ] unless-zero ;
M: unix sockaddr-of-family ( alien af -- addrspec )
{
{ AF_INET [ sockaddr-in memory>struct ] }
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
{ AF_UNIX [ sockaddr-un memory>struct ] }
[ 2drop f ]
} case ;
M: unix addrspec-of-family ( af -- addrspec )
{
{ AF_INET [ T{ inet4 } ] }
{ AF_INET6 [ T{ inet6 } ] }
{ AF_UNIX [ T{ local } ] }
[ drop f ]
} case ;
! Client sockets - TCP and Unix domain ! Client sockets - TCP and Unix domain
M: object (get-local-address) ( handle remote -- sockaddr ) M: object (get-local-address) ( handle remote -- sockaddr )
[ handle-fd ] dip empty-sockaddr/size <int> [ handle-fd ] dip empty-sockaddr/size <int>
@ -100,19 +116,17 @@ CONSTANT: packet-size 65536
[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook [ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
:: do-receive ( port -- packet sockaddr ) :: do-receive ( port -- packet sockaddr )
port addr>> empty-sockaddr/size [| sockaddr len | port addr>> empty-sockaddr/size :> len :> sockaddr
port handle>> handle-fd ! s port handle>> handle-fd ! s
receive-buffer get-global ! buf receive-buffer get-global ! buf
packet-size ! nbytes packet-size ! nbytes
0 ! flags 0 ! flags
sockaddr ! from sockaddr ! from
len <int> ! fromlen len <int> ! fromlen
recvfrom dup 0 >= [ recvfrom dup 0 >=
receive-buffer get-global swap memory>byte-array sockaddr [ receive-buffer get-global swap memory>byte-array sockaddr ]
] [ [ drop f f ]
drop f f if ;
] if
] call ;
M: unix (receive) ( datagram -- packet sockaddr ) M: unix (receive) ( datagram -- packet sockaddr )
dup do-receive dup [ [ drop ] 2dip ] [ dup do-receive dup [ [ drop ] 2dip ] [

42
basis/io/sockets/windows/nt/nt.factor
View File

@ -1,13 +1,13 @@
USING: alien alien.accessors alien.c-types byte-arrays USING: alien alien.accessors alien.c-types byte-arrays
continuations destructors io.ports io.timeouts io.sockets continuations destructors io.ports io.timeouts io.sockets
io namespaces io.streams.duplex io.backend.windows io.sockets.private io namespaces io.streams.duplex
io.sockets.windows io.backend.windows.nt windows.winsock kernel io.backend.windows io.sockets.windows io.backend.windows.nt
libc math sequences threads system combinators accessors windows.winsock kernel libc math sequences threads system
classes.struct windows.kernel32 ; combinators accessors classes.struct windows.kernel32 ;
IN: io.sockets.windows.nt IN: io.sockets.windows.nt
: malloc-int ( object -- object ) : malloc-int ( n -- alien )
"int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline <int> malloc-byte-array ; inline
M: winnt WSASocket-flags ( -- DWORD ) M: winnt WSASocket-flags ( -- DWORD )
WSA_FLAG_OVERLAPPED ; WSA_FLAG_OVERLAPPED ;
@ -100,17 +100,20 @@ TUPLE: AcceptEx-args port
} cleave AcceptEx drop } cleave AcceptEx drop
winsock-error-string [ throw ] when* ; inline winsock-error-string [ throw ] when* ; inline
: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
: extract-remote-address ( AcceptEx -- sockaddr ) : extract-remote-address ( AcceptEx -- sockaddr )
{ [
[ lpOutputBuffer>> ] {
[ dwReceiveDataLength>> ] [ lpOutputBuffer>> ]
[ dwLocalAddressLength>> ] [ dwReceiveDataLength>> ]
[ dwRemoteAddressLength>> ] [ dwLocalAddressLength>> ]
} cleave [ dwRemoteAddressLength>> ]
f <void*> } cleave
0 <int> (extract-remote-address)
f <void*> ] [ port>> addr>> protocol-family ] bi
[ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline sockaddr-of-family ; inline
M: object (accept) ( server addr -- handle sockaddr ) M: object (accept) ( server addr -- handle sockaddr )
[ [
@ -160,7 +163,12 @@ TUPLE: WSARecvFrom-args port
: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
[ lpBuffers>> buf>> swap memory>byte-array ] [ lpBuffers>> buf>> swap memory>byte-array ]
[ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline [
[ port>> addr>> empty-sockaddr dup ]
[ lpFrom>> ]
[ lpFromLen>> *int ]
tri memcpy
] bi ; inline
M: winnt (receive) ( datagram -- packet addrspec ) M: winnt (receive) ( datagram -- packet addrspec )
[ [

28
basis/io/sockets/windows/windows.factor Normal file → Executable file
View File

@ -1,7 +1,25 @@
USING: kernel accessors io.sockets io.backend.windows io.backend USING: kernel accessors io.sockets io.sockets.private
windows.winsock system destructors alien.c-types ; io.backend.windows io.backend windows.winsock system destructors
alien.c-types classes.struct combinators ;
IN: io.sockets.windows IN: io.sockets.windows
M: windows addrinfo-error ( n -- )
winsock-return-check ;
M: windows sockaddr-of-family ( alien af -- addrspec )
{
{ AF_INET [ sockaddr-in memory>struct ] }
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
[ 2drop f ]
} case ;
M: windows addrspec-of-family ( af -- addrspec )
{
{ AF_INET [ T{ inet4 } ] }
{ AF_INET6 [ T{ inet6 } ] }
[ drop f ]
} case ;
HOOK: WSASocket-flags io-backend ( -- DWORD ) HOOK: WSASocket-flags io-backend ( -- DWORD )
TUPLE: win32-socket < win32-file ; TUPLE: win32-socket < win32-file ;
@ -13,8 +31,7 @@ M: win32-socket dispose ( stream -- )
handle>> closesocket drop ; handle>> closesocket drop ;
: unspecific-sockaddr/size ( addrspec -- sockaddr len ) : unspecific-sockaddr/size ( addrspec -- sockaddr len )
[ empty-sockaddr/size ] [ protocol-family ] bi [ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;
pick set-sockaddr-in-family ;
: opened-socket ( handle -- win32-socket ) : opened-socket ( handle -- win32-socket )
<win32-socket> |dispose dup add-completion ; <win32-socket> |dispose dup add-completion ;
@ -56,6 +73,3 @@ M: object (server) ( addrspec -- handle )
M: windows (datagram) ( addrspec -- handle ) M: windows (datagram) ( addrspec -- handle )
[ SOCK_DGRAM server-socket ] with-destructors ; [ SOCK_DGRAM server-socket ] with-destructors ;
M: windows addrinfo-error ( n -- )
winsock-return-check ;

37
basis/windows/winsock/winsock.factor
View File

@ -1,15 +1,11 @@
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel math sequences windows.types windows.kernel32 byte-arrays kernel literals math sequences windows.types
windows.errors math.bitwise io.encodings.utf16n classes.struct windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
literals windows.com.syntax ; classes.struct windows.com.syntax init ;
IN: windows.winsock IN: windows.winsock
USE: libc
: alien>byte-array ( alien str -- byte-array )
heap-size dup <byte-array> [ -rot memcpy ] keep ;
TYPEDEF: void* SOCKET TYPEDEF: void* SOCKET
: <wsadata> ( -- byte-array ) : <wsadata> ( -- byte-array )
@ -30,7 +26,7 @@ CONSTANT: SO_BROADCAST HEX: 20
CONSTANT: SO_USELOOPBACK HEX: 40 CONSTANT: SO_USELOOPBACK HEX: 40
CONSTANT: SO_LINGER HEX: 80 CONSTANT: SO_LINGER HEX: 80
CONSTANT: SO_OOBINLINE HEX: 100 CONSTANT: SO_OOBINLINE HEX: 100
CONSTANT: SO_DONTLINGER $[ SO_LINGER bitnot ] : SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
CONSTANT: SO_SNDBUF HEX: 1001 CONSTANT: SO_SNDBUF HEX: 1001
CONSTANT: SO_RCVBUF HEX: 1002 CONSTANT: SO_RCVBUF HEX: 1002
@ -75,7 +71,9 @@ CONSTANT: PF_INET6 23
CONSTANT: AI_PASSIVE 1 CONSTANT: AI_PASSIVE 1
CONSTANT: AI_CANONNAME 2 CONSTANT: AI_CANONNAME 2
CONSTANT: AI_NUMERICHOST 4 CONSTANT: AI_NUMERICHOST 4
CONSTANT: AI_MASK $[ { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ]
: AI_MASK ( -- n )
{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
CONSTANT: NI_NUMERICHOST 1 CONSTANT: NI_NUMERICHOST 1
CONSTANT: NI_NUMERICSERV 2 CONSTANT: NI_NUMERICSERV 2
@ -96,7 +94,8 @@ ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
CONSTANT: INADDR_ANY 0 CONSTANT: INADDR_ANY 0
CONSTANT: INVALID_SOCKET $[ -1 <alien> ] : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
CONSTANT: SOCKET_ERROR -1 CONSTANT: SOCKET_ERROR -1
CONSTANT: SD_RECV 0 CONSTANT: SD_RECV 0
@ -105,10 +104,6 @@ CONSTANT: SD_BOTH 2
CONSTANT: SOL_SOCKET HEX: ffff CONSTANT: SOL_SOCKET HEX: ffff
! TYPEDEF: uint in_addr_t
! C-STRUCT: in_addr
! { "in_addr_t" "s_addr" } ;
STRUCT: sockaddr-in STRUCT: sockaddr-in
{ family short } { family short }
{ port ushort } { port ushort }
@ -379,7 +374,17 @@ LIBRARY: mswsock
! Not in Windows CE ! Not in Windows CE
FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ; FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, void* f, void* g, void* h ) ;
FUNCTION: void GetAcceptExSockaddrs (
PVOID lpOutputBuffer,
DWORD dwReceiveDataLength,
DWORD dwLocalAddressLength,
DWORD dwRemoteAddressLength,
LPSOCKADDR* LocalSockaddr,
LPINT LocalSockaddrLength,
LPSOCKADDR* RemoteSockaddr,
LPINT RemoteSockaddrLength
) ;
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
@ -431,3 +436,5 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
: init-winsock ( -- ) : init-winsock ( -- )
HEX: 0202 <wsadata> WSAStartup winsock-return-check ; HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
[ init-winsock ] "windows.winsock" add-init-hook