From: Slava Pestov Date: Fri, 4 Sep 2009 10:02:33 +0000 (-0500) Subject: Fix sockets on Windows, and re-organize things so that windows.winsock doesn't get... X-Git-Tag: 0.97~5613^2~5 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=223b9072193b3a0eaeadaa57613c618dd3173b1a Fix sockets on Windows, and re-organize things so that windows.winsock doesn't get loaded by default --- diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index aa113c0efe..46d4d28cfc 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -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 set-global - H{ } clone pending-overlapped set-global - windows.winsock:init-winsock ; + H{ } clone pending-overlapped set-global ; ERROR: invalid-file-size n ; diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor index c7be2229cc..940633c70e 100755 --- a/basis/io/backend/windows/windows.factor +++ b/basis/io/backend/windows/windows.factor @@ -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 diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor old mode 100644 new mode 100755 index a4a3f0702b..0964cdc148 --- a/basis/io/sockets/sockets-tests.factor +++ b/basis/io/sockets/sockets-tests.factor @@ -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 diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor old mode 100644 new mode 100755 index be132b78ac..601d269d5c --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -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 diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor old mode 100644 new mode 100755 index 27abffc20f..e892c6a7ef --- a/basis/io/sockets/unix/unix.factor +++ b/basis/io/sockets/unix/unix.factor @@ -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 @@ -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 handle>> handle-fd ! s - receive-buffer get-global ! buf - packet-size ! nbytes - 0 ! flags - sockaddr ! from - len ! fromlen - recvfrom dup 0 >= [ - receive-buffer get-global swap memory>byte-array sockaddr - ] [ - drop f f - ] if - ] call ; + 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 ! fromlen + 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 ] [ diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index 1bb5e0d102..f423a42b65 100755 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -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 ) + 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 0 f [ 0 GetAcceptExSockaddrs ] keep *void* ; + : extract-remote-address ( AcceptEx -- sockaddr ) - { - [ lpOutputBuffer>> ] - [ dwReceiveDataLength>> ] - [ dwLocalAddressLength>> ] - [ dwRemoteAddressLength>> ] - } cleave - f - 0 - f - [ 0 GetAcceptExSockaddrs ] keep *void* ; inline + [ + { + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + } cleave + (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 ) [ diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor old mode 100644 new mode 100755 index 29009403fc..ccf86ca308 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -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 ) |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 ; diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 6b99824cb7..87b8970b02 100755 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -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 [ -rot memcpy ] keep ; - TYPEDEF: void* SOCKET : ( -- 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 ] +: INVALID_SOCKET ( -- n ) -1 ; 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 WSAStartup winsock-return-check ; + +[ init-winsock ] "windows.winsock" add-init-hook