Fix io.servers -- if it doesn't start up, don't throw an error when it's stopped. IPV6 must be enabled on windows with the command: ipv6 install (the build machines need this before we get clean windows builds). Fix up winsock error handling.
parent
fd502e2c85
commit
8aa22487da
|
@ -44,7 +44,7 @@ ERROR: server-not-running threaded-server ;
|
|||
running-servers get adjoin ;
|
||||
|
||||
: remove-running-server ( threaded-server -- )
|
||||
must-be-running
|
||||
! must-be-running
|
||||
running-servers get delete ;
|
||||
|
||||
PRIVATE>
|
||||
|
@ -72,6 +72,8 @@ GENERIC: handle-client* ( threaded-server -- )
|
|||
GENERIC: (>insecure) ( obj -- obj )
|
||||
|
||||
M: inet (>insecure) ;
|
||||
M: inet4 (>insecure) ;
|
||||
M: inet6 (>insecure) ;
|
||||
M: local (>insecure) ;
|
||||
M: integer (>insecure) internet-server ;
|
||||
M: string (>insecure) internet-server ;
|
||||
|
@ -224,6 +226,12 @@ PRIVATE>
|
|||
|
||||
: insecure-port ( -- n/f ) [ addr>> secure? not ] first-port ;
|
||||
|
||||
: secure-addr ( -- inet )
|
||||
threaded-server get servers>> [ addr>> secure? ] filter random ;
|
||||
|
||||
: insecure-addr ( -- inet )
|
||||
threaded-server get servers>> [ addr>> secure? not ] filter random addr>> ;
|
||||
|
||||
: server. ( threaded-server -- )
|
||||
[ [ "=== " write name>> ] [ ] bi write-object nl ]
|
||||
[ servers>> [ addr>> present print ] each ] bi ;
|
||||
|
@ -231,6 +239,9 @@ PRIVATE>
|
|||
: all-servers ( -- sequence )
|
||||
running-servers get-global members ;
|
||||
|
||||
: get-servers-named ( string -- sequence )
|
||||
[ all-servers ] dip '[ name>> _ = ] filter ;
|
||||
|
||||
: servers. ( -- )
|
||||
all-servers [ server. ] each ;
|
||||
|
||||
|
|
|
@ -100,7 +100,7 @@ M: winnt WSASocket-flags ( -- DWORD )
|
|||
f
|
||||
f
|
||||
WSAIoctl SOCKET_ERROR = [
|
||||
winsock-error-string throw
|
||||
maybe-winsock-exception throw
|
||||
] when
|
||||
] with-out-parameters ;
|
||||
|
||||
|
@ -134,7 +134,7 @@ TUPLE: ConnectEx-args port
|
|||
int
|
||||
{ SOCKET void* int PVOID DWORD LPDWORD void* }
|
||||
stdcall alien-indirect drop
|
||||
winsock-error-string [ throw ] when* ; inline
|
||||
winsock-error ; inline
|
||||
|
||||
M: object establish-connection ( client-out remote -- )
|
||||
make-sockaddr/size <ConnectEx-args>
|
||||
|
@ -164,6 +164,7 @@ TUPLE: AcceptEx-args port
|
|||
f >>lpdwBytesReceived
|
||||
(make-overlapped) >>lpOverlapped ; inline
|
||||
|
||||
! AcceptEx return value is useless
|
||||
: call-AcceptEx ( AcceptEx -- )
|
||||
{
|
||||
[ sListenSocket>> ]
|
||||
|
@ -174,8 +175,7 @@ TUPLE: AcceptEx-args port
|
|||
[ dwRemoteAddressLength>> ]
|
||||
[ lpdwBytesReceived>> ]
|
||||
[ lpOverlapped>> ]
|
||||
} cleave AcceptEx drop
|
||||
winsock-error-string [ throw ] when* ; inline
|
||||
} cleave AcceptEx drop winsock-error ; inline
|
||||
|
||||
: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
|
||||
f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
|
||||
|
|
|
@ -7,7 +7,7 @@ classes.struct windows.com.syntax init ;
|
|||
FROM: alien.c-types => short ;
|
||||
IN: windows.winsock
|
||||
|
||||
TYPEDEF: void* SOCKET
|
||||
TYPEDEF: int* SOCKET
|
||||
|
||||
: <wsadata> ( -- byte-array )
|
||||
HEX: 190 <byte-array> ;
|
||||
|
@ -394,35 +394,40 @@ CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
|
|||
|
||||
CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
|
||||
|
||||
ERROR: winsock-exception n string ;
|
||||
|
||||
: winsock-expected-error? ( n -- ? )
|
||||
${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
|
||||
|
||||
: (winsock-error-string) ( n -- str )
|
||||
: (maybe-winsock-exception) ( n -- winsock-exception/f )
|
||||
! #! WSAStartup returns the error code 'n' directly
|
||||
dup winsock-expected-error?
|
||||
[ drop f ] [ n>win32-error-string ] if ;
|
||||
[ drop f ] [ [ ] [ n>win32-error-string ] bi \ winsock-exception boa ] if ;
|
||||
|
||||
: winsock-error-string ( -- string/f )
|
||||
WSAGetLastError (winsock-error-string) ;
|
||||
: maybe-winsock-exception ( -- winsock-exception/f )
|
||||
WSAGetLastError (maybe-winsock-exception) ;
|
||||
|
||||
: winsock-error ( -- )
|
||||
winsock-error-string [ throw ] when* ;
|
||||
maybe-winsock-exception [ throw ] when* ;
|
||||
|
||||
: (throw-winsock-error) ( n -- * )
|
||||
[ ] [ n>win32-error-string ] bi winsock-exception ;
|
||||
|
||||
: throw-winsock-error ( -- * )
|
||||
WSAGetLastError (throw-winsock-error) ;
|
||||
|
||||
: winsock-error=0/f ( n/f -- )
|
||||
{ 0 f } member? [
|
||||
winsock-error-string throw
|
||||
] when ;
|
||||
{ 0 f } member? [ throw-winsock-error ] when ;
|
||||
|
||||
: winsock-error!=0/f ( n/f -- )
|
||||
{ 0 f } member? [
|
||||
winsock-error-string throw
|
||||
] unless ;
|
||||
{ 0 f } member? [ throw-winsock-error ] unless ;
|
||||
|
||||
! WSAStartup and WSACleanup return the error code directly
|
||||
: winsock-return-check ( n/f -- )
|
||||
dup { 0 f } member? [
|
||||
drop
|
||||
] [
|
||||
(winsock-error-string) throw
|
||||
[ ] [ n>win32-error-string ] bi winsock-exception
|
||||
] if ;
|
||||
|
||||
: socket-error* ( n -- )
|
||||
|
@ -431,7 +436,7 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
|
|||
dup WSA_IO_PENDING = [
|
||||
drop
|
||||
] [
|
||||
(winsock-error-string) throw
|
||||
(maybe-winsock-exception) throw
|
||||
] if
|
||||
] when ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue