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 ;
11 : <wsadata> ( -- byte-array )
12 HEX: 190 <byte-array> ;
14 CONSTANT: SOCK_STREAM 1
15 CONSTANT: SOCK_DGRAM 2
18 CONSTANT: SOCK_SEQPACKET 5
20 CONSTANT: SO_DEBUG HEX: 1
21 CONSTANT: SO_ACCEPTCONN HEX: 2
22 CONSTANT: SO_REUSEADDR HEX: 4
23 CONSTANT: SO_KEEPALIVE HEX: 8
24 CONSTANT: SO_DONTROUTE HEX: 10
25 CONSTANT: SO_BROADCAST HEX: 20
26 CONSTANT: SO_USELOOPBACK HEX: 40
27 CONSTANT: SO_LINGER HEX: 80
28 CONSTANT: SO_OOBINLINE HEX: 100
29 : SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
31 CONSTANT: SO_SNDBUF HEX: 1001
32 CONSTANT: SO_RCVBUF HEX: 1002
33 CONSTANT: SO_SNDLOWAT HEX: 1003
34 CONSTANT: SO_RCVLOWAT HEX: 1004
35 CONSTANT: SO_SNDTIMEO HEX: 1005
36 CONSTANT: SO_RCVTIMEO HEX: 1006
37 CONSTANT: SO_ERROR HEX: 1007
38 CONSTANT: SO_TYPE HEX: 1008
40 CONSTANT: TCP_NODELAY HEX: 1
45 CONSTANT: AF_IMPLINK 3
52 CONSTANT: AF_DATAKIT 9
55 CONSTANT: AF_DECnet 12
58 CONSTANT: AF_HYLINK 15
59 CONSTANT: AF_APPLETALK 16
60 CONSTANT: AF_NETBIOS 17
71 CONSTANT: AI_PASSIVE 1
72 CONSTANT: AI_CANONNAME 2
73 CONSTANT: AI_NUMERICHOST 4
76 { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
78 CONSTANT: NI_NUMERICHOST 1
79 CONSTANT: NI_NUMERICSERV 2
81 CONSTANT: IPPROTO_TCP 6
82 CONSTANT: IPPROTO_UDP 17
83 CONSTANT: IPPROTO_RM 113
85 CONSTANT: WSA_FLAG_OVERLAPPED 1
86 ALIAS: WSA_WAIT_EVENT_0 WAIT_OBJECT_0
87 ALIAS: WSA_MAXIMUM_WAIT_EVENTS MAXIMUM_WAIT_OBJECTS
88 CONSTANT: WSA_INVALID_EVENT f
89 CONSTANT: WSA_WAIT_FAILED -1
90 ALIAS: WSA_WAIT_IO_COMPLETION WAIT_IO_COMPLETION
91 ALIAS: WSA_WAIT_TIMEOUT WAIT_TIMEOUT
92 ALIAS: WSA_INFINITE INFINITE
93 ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
95 CONSTANT: INADDR_ANY 0
97 : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
99 CONSTANT: SOCKET_ERROR -1
105 CONSTANT: SOL_SOCKET HEX: ffff
125 { addr-list void* } ;
143 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
145 FUNCTION: ushort htons ( ushort n ) ;
146 FUNCTION: ushort ntohs ( ushort n ) ;
147 FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
148 FUNCTION: int listen ( void* socket, int backlog ) ;
149 FUNCTION: char* inet_ntoa ( int in-addr ) ;
150 FUNCTION: int getaddrinfo ( char* nodename,
155 FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
158 FUNCTION: hostent* gethostbyname ( char* name ) ;
159 FUNCTION: int gethostname ( char* name, int len ) ;
160 FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
161 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
162 FUNCTION: int closesocket ( SOCKET s ) ;
163 FUNCTION: int shutdown ( SOCKET s, int how ) ;
164 FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
165 FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
167 FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
168 FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
170 TYPEDEF: uint SERVICETYPE
171 TYPEDEF: OVERLAPPED WSAOVERLAPPED
172 TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
174 TYPEDEF: void* LPCONDITIONPROC
175 TYPEDEF: HANDLE WSAEVENT
176 TYPEDEF: LPHANDLE LPWSAEVENT
177 TYPEDEF: sockaddr* LPSOCKADDR
180 { "uint" "TokenRate" }
181 { "uint" "TokenBucketSize" }
182 { "uint" "PeakBandwidth" }
184 { "uint" "DelayVariation" }
185 { "SERVICETYPE" "ServiceType" }
186 { "uint" "MaxSduSize" }
187 { "uint" "MinimumPolicedSize" } ;
188 TYPEDEF: FLOWSPEC* PFLOWSPEC
189 TYPEDEF: FLOWSPEC* LPFLOWSPEC
194 TYPEDEF: WSABUF* LPWSABUF
197 { "FLOWSPEC" "SendingFlowspec" }
198 { "FLOWSPEC" "ReceivingFlowspec" }
199 { "WSABUF" "ProviderSpecific" } ;
202 CONSTANT: MAX_PROTOCOL_CHAIN 7
204 C-STRUCT: WSAPROTOCOLCHAIN
206 ! { { "DWORD" MAX_PROTOCOL_CHAIN } "ChainEntries" } ;
207 { { "DWORD" 7 } "ChainEntries" } ;
208 TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
210 CONSTANT: WSAPROTOCOL_LEN 255
212 C-STRUCT: WSAPROTOCOL_INFOW
213 { "DWORD" "dwServiceFlags1" }
214 { "DWORD" "dwServiceFlags2" }
215 { "DWORD" "dwServiceFlags3" }
216 { "DWORD" "dwServiceFlags4" }
217 { "DWORD" "dwProviderFlags" }
218 { "GUID" "ProviderId" }
219 { "DWORD" "dwCatalogEntryId" }
220 { "WSAPROTOCOLCHAIN" "ProtocolChain" }
222 { "int" "iAddressFamily" }
223 { "int" "iMaxSockAddr" }
224 { "int" "iMinSockAddr" }
225 { "int" "iSocketType" }
226 { "int" "iProtocol" }
227 { "int" "iProtocolMaxOffset" }
228 { "int" "iNetworkByteOrder" }
229 { "int" "iSecurityScheme" }
230 { "DWORD" "dwMessageSize" }
231 { "DWORD" "dwProviderReserved" }
232 { { "WCHAR" 256 } "szProtocol" } ;
233 ! { { "WCHAR" 256 } "szProtocol"[WSAPROTOCOL_LEN+1] } ;
234 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
235 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
236 TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
237 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFO
238 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
241 C-STRUCT: WSANAMESPACE_INFOW
242 { "GUID" "NSProviderId" }
243 { "DWORD" "dwNameSpace" }
245 { "DWORD" "dwVersion" }
246 { "LPWSTR" "lpszIdentifier" } ;
247 TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
248 TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
249 TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
250 TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO
251 TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
253 CONSTANT: FD_MAX_EVENTS 10
255 C-STRUCT: WSANETWORKEVENTS
256 { "long" "lNetworkEvents" }
257 { { "int" FD_MAX_EVENTS } "iErrorCode" } ;
258 TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
259 TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
261 ! C-STRUCT: WSAOVERLAPPED
262 ! { "DWORD" "Internal" }
263 ! { "DWORD" "InternalHigh" }
264 ! { "DWORD" "Offset" }
265 ! { "DWORD" "OffsetHigh" }
266 ! { "WSAEVENT" "hEvent" }
267 ! { "DWORD" "bytesTransferred" } ;
268 ! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
270 FUNCTION: SOCKET WSAAccept ( SOCKET s,
273 LPCONDITIONPROC lpfnCondition,
274 DWORD dwCallbackData ) ;
276 ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ;
278 FUNCTION: int WSACleanup ( ) ;
279 FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) ;
281 FUNCTION: int WSAConnect ( SOCKET s,
284 LPWSABUF lpCallerData,
285 LPWSABUF lpCalleeData,
288 FUNCTION: WSAEVENT WSACreateEvent ( ) ;
289 ! FUNCTION: INT WSAEnumNameSpaceProviders ( LPDWORD lpdwBufferLength, LPWSANAMESPACE_INFO lpnspBuffer ) ;
290 FUNCTION: int WSAEnumNetworkEvents ( SOCKET s,
291 WSAEVENT hEventObject,
292 LPWSANETWORKEVENTS lpNetworkEvents ) ;
293 ! FUNCTION: int WSAEnumProtocols ( LPINT lpiProtocols, LPWSAPROTOCOL_INFO lpProtocolBuffer, LPDWORD lpwdBufferLength ) ;
295 FUNCTION: int WSAEventSelect ( SOCKET s,
296 WSAEVENT hEventObject,
297 long lNetworkEvents ) ;
298 FUNCTION: int WSAGetLastError ( ) ;
299 FUNCTION: BOOL WSAGetOverlappedResult ( SOCKET s,
300 LPWSAOVERLAPPED lpOverlapped,
301 LPDWORD lpcbTransfer,
303 LPDWORD lpdwFlags ) ;
305 FUNCTION: int WSAIoctl ( SOCKET s,
306 DWORD dwIoControlCode,
311 LPDWORD lpcbBytesReturned,
313 void* lpCompletionRoutine ) ;
315 TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE
316 FUNCTION: int WSARecv ( SOCKET s,
319 LPDWORD lpNumberOfBytesRecvd,
321 LPWSAOVERLAPPED lpOverlapped,
322 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
324 FUNCTION: int WSARecvFrom ( SOCKET s,
327 LPDWORD lpNumberOfBytesRecvd,
331 LPWSAOVERLAPPED lpOverlapped,
332 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
334 FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) ;
335 FUNCTION: int WSASend ( SOCKET s,
338 LPDWORD lpNumberOfBytesSent,
340 LPWSAOVERLAPPED lpOverlapped,
341 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
343 FUNCTION: int WSASendTo ( SOCKET s,
346 LPDWORD lpNumberOfBytesSent,
350 LPWSAOVERLAPPED lpOverlapped,
351 LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
354 FUNCTION: int WSAStartup ( short version, void* out-data ) ;
358 FUNCTION: SOCKET WSASocketW ( int af,
361 LPWSAPROTOCOL_INFOW lpProtocolInfo,
364 ALIAS: WSASocket WSASocketW
366 FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
376 FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
378 FUNCTION: void GetAcceptExSockaddrs (
379 PVOID lpOutputBuffer,
380 DWORD dwReceiveDataLength,
381 DWORD dwLocalAddressLength,
382 DWORD dwRemoteAddressLength,
383 LPSOCKADDR* LocalSockaddr,
384 LPINT LocalSockaddrLength,
385 LPSOCKADDR* RemoteSockaddr,
386 LPINT RemoteSockaddrLength
389 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
391 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
393 : winsock-expected-error? ( n -- ? )
394 ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
396 : (winsock-error-string) ( n -- str )
397 ! #! WSAStartup returns the error code 'n' directly
398 dup winsock-expected-error?
399 [ drop f ] [ n>win32-error-string ] if ;
401 : winsock-error-string ( -- string/f )
402 WSAGetLastError (winsock-error-string) ;
404 : winsock-error ( -- )
405 winsock-error-string [ throw ] when* ;
407 : winsock-error=0/f ( n/f -- )
409 winsock-error-string throw
412 : winsock-error!=0/f ( n/f -- )
414 winsock-error-string throw
417 : winsock-return-check ( n/f -- )
418 dup { 0 f } member? [
421 (winsock-error-string) throw
424 : socket-error* ( n -- )
427 dup WSA_IO_PENDING = [
430 (winsock-error-string) throw
434 : socket-error ( n -- )
435 SOCKET_ERROR = [ winsock-error ] when ;
437 : init-winsock ( -- )
438 HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
440 [ init-winsock ] "windows.winsock" add-init-hook