running-servers get adjoin ;
: remove-running-server ( threaded-server -- )
- must-be-running
+ ! must-be-running
running-servers get delete ;
PRIVATE>
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 ;
: 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 ;
: all-servers ( -- sequence )
running-servers get-global members ;
+: get-servers-named ( string -- sequence )
+ [ all-servers ] dip '[ name>> _ = ] filter ;
+
: servers. ( -- )
all-servers [ server. ] each ;
f\r
f\r
WSAIoctl SOCKET_ERROR = [\r
- winsock-error-string throw\r
+ maybe-winsock-exception throw\r
] when\r
] with-out-parameters ;\r
\r
int\r
{ SOCKET void* int PVOID DWORD LPDWORD void* }\r
stdcall alien-indirect drop\r
- winsock-error-string [ throw ] when* ; inline\r
+ winsock-error ; inline\r
\r
M: object establish-connection ( client-out remote -- )\r
make-sockaddr/size <ConnectEx-args>\r
f >>lpdwBytesReceived\r
(make-overlapped) >>lpOverlapped ; inline\r
\r
+! AcceptEx return value is useless\r
: call-AcceptEx ( AcceptEx -- )\r
{\r
[ sListenSocket>> ]\r
[ dwRemoteAddressLength>> ]\r
[ lpdwBytesReceived>> ]\r
[ lpOverlapped>> ]\r
- } cleave AcceptEx drop\r
- winsock-error-string [ throw ] when* ; inline\r
+ } cleave AcceptEx drop winsock-error ; inline\r
\r
: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )\r
f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;\r
FROM: alien.c-types => short ;
IN: windows.winsock
-TYPEDEF: void* SOCKET
+TYPEDEF: int* SOCKET
: <wsadata> ( -- byte-array )
HEX: 190 <byte-array> ;
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 -- )
dup WSA_IO_PENDING = [
drop
] [
- (winsock-error-string) throw
+ (maybe-winsock-exception) throw
] if
] when ;