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
threads windows windows.errors windows.kernel32 strings splitting
ascii system accessors locals classes.struct combinators.short-circuit ;
QUALIFIED: windows.winsock
IN: io.backend.windows.nt
! Global variable with assoc mapping overlapped to threads
@ -79,8 +78,7 @@ M: winnt io-multiplex ( us -- )
M: winnt init-io ( -- )
<master-completion-port> master-completion-port set-global
H{ } clone pending-overlapped set-global
windows.winsock:init-winsock ;
H{ } clone pending-overlapped set-global ;
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
io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise accessors init sets assocs
windows.kernel32 windows.shell32 windows.types splitting
continuations math.bitwise accessors init sets assocs
classes.struct classes ;
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
USING: io.sockets sequences math tools.test namespaces accessors
kernel destructors calendar io.timeouts io.encodings.utf8 io
concurrency.promises threads io.streams.string ;
USING: io.sockets io.sockets.private sequences math tools.test
namespaces accessors kernel destructors calendar io.timeouts
io.encodings.utf8 io concurrency.promises threads
io.streams.string ;
[ B{ 1 2 3 4 } ]
[ "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 )
: 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 ;
HOOK: sockaddr-of-family os ( alien af -- sockaddr )
HOOK: addrspec-of-family os ( af -- addrspec )
PRIVATE>
@ -223,14 +219,6 @@ HOOK: (receive) io-backend ( datagram -- packet addrspec )
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 )
[ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
[ family>> addrspec-of-family ] bi

28
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 -- )
[ 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
M: object (get-local-address) ( handle remote -- sockaddr )
[ 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
:: do-receive ( port -- packet sockaddr )
port addr>> empty-sockaddr/size [| sockaddr len |
port addr>> empty-sockaddr/size :> len :> sockaddr
port handle>> handle-fd ! s
receive-buffer get-global ! buf
packet-size ! nbytes
0 ! flags
sockaddr ! from
len <int> ! fromlen
recvfrom dup 0 >= [
receive-buffer get-global swap memory>byte-array sockaddr
] [
drop f f
] if
] call ;
recvfrom dup 0 >=
[ receive-buffer get-global swap memory>byte-array sockaddr ]
[ drop f f ]
if ;
M: unix (receive) ( datagram -- packet sockaddr )
dup do-receive dup [ [ drop ] 2dip ] [

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

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

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
windows.winsock system destructors alien.c-types ;
USING: kernel accessors io.sockets io.sockets.private
io.backend.windows io.backend windows.winsock system destructors
alien.c-types classes.struct combinators ;
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 )
TUPLE: win32-socket < win32-file ;
@ -13,8 +31,7 @@ M: win32-socket dispose ( stream -- )
handle>> closesocket drop ;
: unspecific-sockaddr/size ( addrspec -- sockaddr len )
[ empty-sockaddr/size ] [ protocol-family ] bi
pick set-sockaddr-in-family ;
[ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;
: opened-socket ( handle -- win32-socket )
<win32-socket> |dispose dup add-completion ;
@ -56,6 +73,3 @@ M: object (server) ( addrspec -- handle )
M: windows (datagram) ( addrspec -- handle )
[ 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.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays
byte-arrays kernel math sequences windows.types windows.kernel32
windows.errors math.bitwise io.encodings.utf16n classes.struct
literals windows.com.syntax ;
byte-arrays kernel literals math sequences windows.types
windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
classes.struct windows.com.syntax init ;
IN: windows.winsock
USE: libc
: alien>byte-array ( alien str -- byte-array )
heap-size dup <byte-array> [ -rot memcpy ] keep ;
TYPEDEF: void* SOCKET
: <wsadata> ( -- byte-array )
@ -30,7 +26,7 @@ CONSTANT: SO_BROADCAST HEX: 20
CONSTANT: SO_USELOOPBACK HEX: 40
CONSTANT: SO_LINGER HEX: 80
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_RCVBUF HEX: 1002
@ -75,7 +71,9 @@ CONSTANT: PF_INET6 23
CONSTANT: AI_PASSIVE 1
CONSTANT: AI_CANONNAME 2
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_NUMERICSERV 2
@ -96,7 +94,8 @@ ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
CONSTANT: INADDR_ANY 0
CONSTANT: INVALID_SOCKET $[ -1 <alien> ]
: INVALID_SOCKET ( -- n ) -1 <alien> ; inline
CONSTANT: SOCKET_ERROR -1
CONSTANT: SD_RECV 0
@ -105,10 +104,6 @@ CONSTANT: SD_BOTH 2
CONSTANT: SOL_SOCKET HEX: ffff
! TYPEDEF: uint in_addr_t
! C-STRUCT: in_addr
! { "in_addr_t" "s_addr" } ;
STRUCT: sockaddr-in
{ family short }
{ port ushort }
@ -379,7 +374,17 @@ LIBRARY: mswsock
! 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: 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
@ -431,3 +436,5 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
: init-winsock ( -- )
HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
[ init-winsock ] "windows.winsock" add-init-hook