1 ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings alien.syntax arrays
4 byte-arrays kernel literals math sequences windows.types
5 windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
6 classes.struct windows.com.syntax init ;
7 FROM: alien.c-types => short ;
12 : <wsadata> ( -- byte-array )
13 HEX: 190 <byte-array> ;
15 CONSTANT: SOCK_STREAM 1
16 CONSTANT: SOCK_DGRAM 2
19 CONSTANT: SOCK_SEQPACKET 5
21 CONSTANT: SO_DEBUG HEX: 1
22 CONSTANT: SO_ACCEPTCONN HEX: 2
23 CONSTANT: SO_REUSEADDR HEX: 4
24 CONSTANT: SO_KEEPALIVE HEX: 8
25 CONSTANT: SO_DONTROUTE HEX: 10
26 CONSTANT: SO_BROADCAST HEX: 20
27 CONSTANT: SO_USELOOPBACK HEX: 40
28 CONSTANT: SO_LINGER HEX: 80
29 CONSTANT: SO_OOBINLINE HEX: 100
30 : SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
32 CONSTANT: SO_SNDBUF HEX: 1001
33 CONSTANT: SO_RCVBUF HEX: 1002
34 CONSTANT: SO_SNDLOWAT HEX: 1003
35 CONSTANT: SO_RCVLOWAT HEX: 1004
36 CONSTANT: SO_SNDTIMEO HEX: 1005
37 CONSTANT: SO_RCVTIMEO HEX: 1006
38 CONSTANT: SO_ERROR HEX: 1007
39 CONSTANT: SO_TYPE HEX: 1008
41 CONSTANT: TCP_NODELAY HEX: 1
46 CONSTANT: AF_IMPLINK 3
53 CONSTANT: AF_DATAKIT 9
56 CONSTANT: AF_DECnet 12
59 CONSTANT: AF_HYLINK 15
60 CONSTANT: AF_APPLETALK 16
61 CONSTANT: AF_NETBIOS 17
72 CONSTANT: AI_PASSIVE 1
73 CONSTANT: AI_CANONNAME 2
74 CONSTANT: AI_NUMERICHOST 4
77 { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
79 CONSTANT: NI_NUMERICHOST 1
80 CONSTANT: NI_NUMERICSERV 2
82 CONSTANT: IPPROTO_TCP 6
83 CONSTANT: IPPROTO_UDP 17
84 CONSTANT: IPPROTO_RM 113
86 CONSTANT: WSA_FLAG_OVERLAPPED 1
87 ALIAS: WSA_WAIT_EVENT_0 WAIT_OBJECT_0
88 ALIAS: WSA_MAXIMUM_WAIT_EVENTS MAXIMUM_WAIT_OBJECTS
89 CONSTANT: WSA_INVALID_EVENT f
90 CONSTANT: WSA_WAIT_FAILED -1
91 ALIAS: WSA_WAIT_IO_COMPLETION WAIT_IO_COMPLETION
92 ALIAS: WSA_WAIT_TIMEOUT WAIT_TIMEOUT
93 ALIAS: WSA_INFINITE INFINITE
94 ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
96 CONSTANT: INADDR_ANY 0
98 : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
100 CONSTANT: SOCKET_ERROR -1
106 CONSTANT: SOL_SOCKET HEX: ffff
128 { addr-list void* } ;
148 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
150 FUNCTION: ushort htons ( ushort n ) ;
151 FUNCTION: ushort ntohs ( ushort n ) ;
152 FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ;
153 FUNCTION: int listen ( void* socket, int backlog ) ;
154 FUNCTION: char* inet_ntoa ( int in-addr ) ;
155 FUNCTION: int getaddrinfo ( char* nodename,
160 FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
163 FUNCTION: hostent* gethostbyname ( char* name ) ;
164 FUNCTION: int gethostname ( char* name, int len ) ;
165 FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ;
166 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
167 FUNCTION: int closesocket ( SOCKET s ) ;
168 FUNCTION: int shutdown ( SOCKET s, int how ) ;
169 FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
170 FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
172 FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
173 FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
175 TYPEDEF: uint SERVICETYPE
176 TYPEDEF: OVERLAPPED WSAOVERLAPPED
177 TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
179 TYPEDEF: void* LPCONDITIONPROC
180 TYPEDEF: HANDLE WSAEVENT
181 TYPEDEF: LPHANDLE LPWSAEVENT
182 TYPEDEF: sockaddr* LPSOCKADDR
186 { TokenBucketSize uint }
187 { PeakBandwidth uint }
189 { DelayVariation uint }
190 { ServiceType SERVICETYPE }
192 { MinimumPolicedSize uint } ;
193 TYPEDEF: FLOWSPEC* PFLOWSPEC
194 TYPEDEF: FLOWSPEC* LPFLOWSPEC
199 TYPEDEF: WSABUF* LPWSABUF
202 { SendingFlowspec FLOWSPEC }
203 { ReceivingFlowspec FLOWSPEC }
204 { ProviderSpecific WSABUF } ;
207 CONSTANT: MAX_PROTOCOL_CHAIN 7
209 STRUCT: WSAPROTOCOLCHAIN
211 { ChainEntries { DWORD 7 } } ;
212 ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
213 TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
215 CONSTANT: WSAPROTOCOL_LEN 255
217 STRUCT: WSAPROTOCOL_INFOW
218 { dwServiceFlags1 DWORD }
219 { dwServiceFlags2 DWORD }
220 { dwServiceFlags3 DWORD }
221 { dwServiceFlags4 DWORD }
222 { dwProviderFlags DWORD }
224 { dwCatalogEntryId DWORD }
225 { ProtocolChain WSAPROTOCOLCHAIN }
227 { iAddressFamily int }
232 { iProtocolMaxOffset int }
233 { iNetworkByteOrder int }
234 { iSecurityScheme int }
235 { dwMessageSize DWORD }
236 { dwProviderReserved DWORD }
237 { szProtocol { WCHAR 256 } } ;
238 ! { szProtocol[WSAPROTOCOL_LEN+1] { WCHAR 256 } } ;
239 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
240 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
241 TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
242 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFO
243 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
246 STRUCT: WSANAMESPACE_INFOW
247 { NSProviderId GUID }
248 { dwNameSpace DWORD }
251 { lpszIdentifier LPWSTR } ;
252 TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
253 TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
254 TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
255 TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO
256 TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
258 CONSTANT: FD_MAX_EVENTS 10
260 STRUCT: WSANETWORKEVENTS
261 { lNetworkEvents long }
262 { iErrorCode { int FD_MAX_EVENTS } } ;
263 TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
264 TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
266 ! STRUCT: WSAOVERLAPPED
268 ! { InternalHigh DWORD }
270 ! { OffsetHigh DWORD }
271 ! { hEvent WSAEVENT }
272 ! { bytesTransferred DWORD } ;
273 ! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
275 FUNCTION: SOCKET WSAAccept ( SOCKET s,
278 LPCONDITIONPROC lpfnCondition,
279 DWORD dwCallbackData ) ;
281 ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ;
283 FUNCTION: int WSACleanup ( ) ;
284 FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) ;
286 FUNCTION: int WSAConnect ( SOCKET s,
289 LPWSABUF lpCallerData,
290 LPWSABUF lpCalleeData,
293 FUNCTION: WSAEVENT WSACreateEvent ( ) ;
294 ! FUNCTION: INT WSAEnumNameSpaceProviders ( LPDWORD lpdwBufferLength, LPWSANAMESPACE_INFO lpnspBuffer ) ;
295 FUNCTION: int WSAEnumNetworkEvents ( SOCKET s,
296 WSAEVENT hEventObject,
297 LPWSANETWORKEVENTS lpNetworkEvents ) ;
298 ! FUNCTION: int WSAEnumProtocols ( LPINT lpiProtocols, LPWSAPROTOCOL_INFO lpProtocolBuffer, LPDWORD lpwdBufferLength ) ;
300 FUNCTION: int WSAEventSelect ( SOCKET s,
301 WSAEVENT hEventObject,
302 long lNetworkEvents ) ;
303 FUNCTION: int WSAGetLastError ( ) ;
304 FUNCTION: BOOL WSAGetOverlappedResult ( SOCKET s,
305 LPWSAOVERLAPPED lpOverlapped,
306 LPDWORD lpcbTransfer,
308 LPDWORD lpdwFlags ) ;
310 FUNCTION: int WSAIoctl ( SOCKET s,
311 DWORD dwIoControlCode,
316 LPDWORD lpcbBytesReturned,
318 void* lpCompletionRoutine ) ;
320 TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE
321 FUNCTION: int WSARecv ( SOCKET s,
324 LPDWORD lpNumberOfBytesRecvd,
326 LPWSAOVERLAPPED lpOverlapped,
327 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
329 FUNCTION: int WSARecvFrom ( SOCKET s,
332 LPDWORD lpNumberOfBytesRecvd,
336 LPWSAOVERLAPPED lpOverlapped,
337 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
339 FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) ;
340 FUNCTION: int WSASend ( SOCKET s,
343 LPDWORD lpNumberOfBytesSent,
345 LPWSAOVERLAPPED lpOverlapped,
346 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
348 FUNCTION: int WSASendTo ( SOCKET s,
351 LPDWORD lpNumberOfBytesSent,
355 LPWSAOVERLAPPED lpOverlapped,
356 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
359 FUNCTION: int WSAStartup ( short version, void* out-data ) ;
363 FUNCTION: SOCKET WSASocketW ( int af,
366 LPWSAPROTOCOL_INFOW lpProtocolInfo,
369 ALIAS: WSASocket WSASocketW
371 FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
381 FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
383 FUNCTION: void GetAcceptExSockaddrs (
384 PVOID lpOutputBuffer,
385 DWORD dwReceiveDataLength,
386 DWORD dwLocalAddressLength,
387 DWORD dwRemoteAddressLength,
388 LPSOCKADDR* LocalSockaddr,
389 LPINT LocalSockaddrLength,
390 LPSOCKADDR* RemoteSockaddr,
391 LPINT RemoteSockaddrLength
394 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
396 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
398 : winsock-expected-error? ( n -- ? )
399 ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
401 : (winsock-error-string) ( n -- str )
402 ! #! WSAStartup returns the error code 'n' directly
403 dup winsock-expected-error?
404 [ drop f ] [ n>win32-error-string ] if ;
406 : winsock-error-string ( -- string/f )
407 WSAGetLastError (winsock-error-string) ;
409 : winsock-error ( -- )
410 winsock-error-string [ throw ] when* ;
412 : winsock-error=0/f ( n/f -- )
414 winsock-error-string throw
417 : winsock-error!=0/f ( n/f -- )
419 winsock-error-string throw
422 : winsock-return-check ( n/f -- )
423 dup { 0 f } member? [
426 (winsock-error-string) throw
429 : socket-error* ( n -- )
432 dup WSA_IO_PENDING = [
435 (winsock-error-string) throw
439 : socket-error ( n -- )
440 SOCKET_ERROR = [ winsock-error ] when ;
442 : init-winsock ( -- )
443 HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
445 : shutdown-winsock ( -- ) WSACleanup winsock-return-check ;
447 [ init-winsock ] "windows.winsock" add-startup-hook
448 [ shutdown-winsock ] "windows.winsock" add-shutdown-hook