basis/windows/winsock/winsock.factor

   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 IN: windows.winsock
   8
   9 TYPEDEF: void* SOCKET
  10
  11 : <wsadata> ( -- byte-array )
  12     HEX: 190 <byte-array> ;
  13
  14 CONSTANT: SOCK_STREAM    1
  15 CONSTANT: SOCK_DGRAM     2
  16 CONSTANT: SOCK_RAW       3
  17 CONSTANT: SOCK_RDM       4
  18 CONSTANT: SOCK_SEQPACKET 5
  19
  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
  30
  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
  39
  40 CONSTANT: TCP_NODELAY   HEX:    1
  41
  42 CONSTANT: AF_UNSPEC      0
  43 CONSTANT: AF_UNIX        1
  44 CONSTANT: AF_INET        2
  45 CONSTANT: AF_IMPLINK     3
  46 CONSTANT: AF_PUP         4
  47 CONSTANT: AF_CHAOS       5
  48 CONSTANT: AF_NS          6
  49 CONSTANT: AF_ISO         7
  50 ALIAS: AF_OSI    AF_ISO
  51 CONSTANT: AF_ECMA        8
  52 CONSTANT: AF_DATAKIT     9
  53 CONSTANT: AF_CCITT      10
  54 CONSTANT: AF_SNA        11
  55 CONSTANT: AF_DECnet     12
  56 CONSTANT: AF_DLI        13
  57 CONSTANT: AF_LAT        14
  58 CONSTANT: AF_HYLINK     15
  59 CONSTANT: AF_APPLETALK  16
  60 CONSTANT: AF_NETBIOS    17
  61 CONSTANT: AF_MAX        18
  62 CONSTANT: AF_INET6      23
  63 CONSTANT: AF_IRDA       26
  64 CONSTANT: AF_BTM        32
  65
  66 CONSTANT: PF_UNSPEC      0
  67 CONSTANT: PF_LOCAL       1
  68 CONSTANT: PF_INET        2
  69 CONSTANT: PF_INET6      23
  70
  71 CONSTANT: AI_PASSIVE     1
  72 CONSTANT: AI_CANONNAME   2
  73 CONSTANT: AI_NUMERICHOST 4
  74
  75 : AI_MASK ( -- n )
  76     { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
  77
  78 CONSTANT: NI_NUMERICHOST 1
  79 CONSTANT: NI_NUMERICSERV 2
  80
  81 CONSTANT: IPPROTO_TCP    6
  82 CONSTANT: IPPROTO_UDP   17
  83 CONSTANT: IPPROTO_RM   113
  84
  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
  94
  95 CONSTANT: INADDR_ANY 0
  96
  97 : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
  98
  99 CONSTANT: SOCKET_ERROR -1
 100
 101 CONSTANT: SD_RECV 0
 102 CONSTANT: SD_SEND 1
 103 CONSTANT: SD_BOTH 2
 104
 105 CONSTANT: SOL_SOCKET HEX: ffff
 106
 107 STRUCT: sockaddr-in
 108     { family short }
 109     { port ushort }
 110     { addr uint }
 111     { pad char[8] } ;
 112
 113 STRUCT: sockaddr-in6
 114     { family uchar }
 115     { port ushort }
 116     { flowinfo uint }
 117     { addr uchar[16] }
 118     { scopeid uint } ;
 119
 120 STRUCT: hostent
 121     { name char* }
 122     { aliases void* }
 123     { addrtype short }
 124     { length short }
 125     { addr-list void* } ;
 126
 127 STRUCT: addrinfo
 128     { flags int }
 129     { family int }
 130     { socktype int }
 131     { protocol int }
 132     { addrlen size_t }
 133     { canonname char* }
 134     { addr sockaddr* }
 135     { next addrinfo* } ;
 136
 137 C-STRUCT: timeval
 138     { "long" "sec" }
 139     { "long" "usec" } ;
 140
 141 LIBRARY: winsock
 142
 143 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
 144
 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,
 151                             char* servername,
 152                             addrinfo* hints,
 153                             addrinfo** res ) ;
 154
 155 FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 156
 157
 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 ) ;
 166
 167 FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
 168 FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
 169
 170 TYPEDEF: uint SERVICETYPE
 171 TYPEDEF: OVERLAPPED WSAOVERLAPPED
 172 TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
 173 TYPEDEF: uint GROUP
 174 TYPEDEF: void* LPCONDITIONPROC
 175 TYPEDEF: HANDLE WSAEVENT
 176 TYPEDEF: LPHANDLE LPWSAEVENT
 177 TYPEDEF: sockaddr* LPSOCKADDR
 178
 179 C-STRUCT: FLOWSPEC
 180     { "uint"        "TokenRate" }
 181     { "uint"        "TokenBucketSize" }
 182     { "uint"        "PeakBandwidth" }
 183     { "uint"        "Latency" }
 184     { "uint"        "DelayVariation" }
 185     { "SERVICETYPE" "ServiceType" }
 186     { "uint"        "MaxSduSize" }
 187     { "uint"        "MinimumPolicedSize" } ;
 188 TYPEDEF: FLOWSPEC* PFLOWSPEC
 189 TYPEDEF: FLOWSPEC* LPFLOWSPEC
 190
 191 STRUCT: WSABUF
 192     { len ulong }
 193     { buf void* } ;
 194 TYPEDEF: WSABUF* LPWSABUF
 195
 196 C-STRUCT: QOS
 197     { "FLOWSPEC" "SendingFlowspec" }
 198     { "FLOWSPEC" "ReceivingFlowspec" }
 199     { "WSABUF" "ProviderSpecific" } ;
 200 TYPEDEF: QOS* LPQOS
 201
 202 CONSTANT: MAX_PROTOCOL_CHAIN 7
 203
 204 C-STRUCT: WSAPROTOCOLCHAIN
 205     { "int" "ChainLen" }
 206     ! { { "DWORD" MAX_PROTOCOL_CHAIN } "ChainEntries" } ;
 207     { { "DWORD" 7 } "ChainEntries" } ;
 208 TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
 209
 210 CONSTANT: WSAPROTOCOL_LEN 255
 211
 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" }
 221     { "int" "iVersion" }
 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
 239
 240
 241 C-STRUCT: WSANAMESPACE_INFOW
 242     { "GUID"    "NSProviderId" }
 243     { "DWORD"   "dwNameSpace" }
 244     { "BOOL"    "fActive" }
 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
 252
 253 CONSTANT: FD_MAX_EVENTS 10
 254
 255 C-STRUCT: WSANETWORKEVENTS
 256     { "long" "lNetworkEvents" }
 257     { { "int" FD_MAX_EVENTS } "iErrorCode" } ;
 258 TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
 259 TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
 260
 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
 269
 270 FUNCTION: SOCKET WSAAccept ( SOCKET s,
 271                              sockaddr* addr,
 272                              LPINT addrlen,
 273                              LPCONDITIONPROC lpfnCondition,
 274                              DWORD dwCallbackData ) ;
 275
 276 ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ;
 277
 278 FUNCTION: int WSACleanup ( ) ;
 279 FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) ;
 280
 281 FUNCTION: int WSAConnect ( SOCKET s,
 282                            sockaddr* name,
 283                            int namelen,
 284                            LPWSABUF lpCallerData,
 285                            LPWSABUF lpCalleeData,
 286                            LPQOS lpSQOS,
 287                            LPQOS lpGQOS ) ;
 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 ) ;
 294
 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,
 302                                         BOOL fWait,
 303                                         LPDWORD lpdwFlags ) ;
 304
 305 FUNCTION: int WSAIoctl ( SOCKET s,
 306                          DWORD dwIoControlCode,
 307                          LPVOID lpvInBuffer,
 308                          DWORD cbInBuffer,
 309                          LPVOID lpvOutBuffer,
 310                          DWORD cbOutBuffer,
 311                          LPDWORD lpcbBytesReturned,
 312                          void* lpOverlapped,
 313                          void* lpCompletionRoutine ) ;
 314
 315 TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE
 316 FUNCTION: int WSARecv ( SOCKET s,
 317                         LPWSABUF lpBuffers,
 318                         DWORD dwBufferCount,
 319                         LPDWORD lpNumberOfBytesRecvd,
 320                         LPDWORD lpFlags,
 321                         LPWSAOVERLAPPED lpOverlapped,
 322                     LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 323
 324 FUNCTION: int WSARecvFrom ( SOCKET s,
 325                     LPWSABUF lpBuffers,
 326                     DWORD dwBufferCount,
 327                     LPDWORD lpNumberOfBytesRecvd,
 328                     LPDWORD lpFlags,
 329                     sockaddr* lpFrom,
 330                     LPINT lpFromlen,
 331                     LPWSAOVERLAPPED lpOverlapped,
 332                     LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 333
 334 FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) ;
 335 FUNCTION: int WSASend ( SOCKET s,
 336                         LPWSABUF lpBuffers,
 337                         DWORD dwBufferCount,
 338                         LPDWORD lpNumberOfBytesSent,
 339                         LPDWORD lpFlags,
 340                         LPWSAOVERLAPPED lpOverlapped,
 341                  LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 342
 343 FUNCTION: int WSASendTo ( SOCKET s,
 344                           LPWSABUF lpBuffers,
 345                           DWORD dwBufferCount,
 346                           LPDWORD lpNumberOfBytesSent,
 347                           DWORD dwFlags,
 348                           sockaddr* lpTo,
 349                           int iToLen,
 350                           LPWSAOVERLAPPED lpOverlapped,
 351   LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 352
 353
 354 FUNCTION: int WSAStartup ( short version, void* out-data ) ;
 355
 356
 357
 358 FUNCTION: SOCKET WSASocketW ( int af,
 359                              int type,
 360                              int protocol,
 361                              LPWSAPROTOCOL_INFOW lpProtocolInfo,
 362                              GROUP g,
 363                              DWORD flags ) ;
 364 ALIAS: WSASocket WSASocketW
 365
 366 FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
 367                                            WSAEVENT* lphEvents,
 368                                            BOOL fWaitAll,
 369                                            DWORD dwTimeout,
 370                                            BOOL fAlertable ) ;
 371
 372
 373 LIBRARY: mswsock
 374
 375 ! Not in Windows CE
 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 ) ;
 377
 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
 387 ) ;
 388
 389 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 390
 391 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 392
 393 : winsock-expected-error? ( n -- ? )
 394     ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
 395
 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 ;
 400
 401 : winsock-error-string ( -- string/f )
 402     WSAGetLastError (winsock-error-string) ;
 403
 404 : winsock-error ( -- )
 405     winsock-error-string [ throw ] when* ;
 406
 407 : winsock-error=0/f ( n/f -- )
 408     { 0 f } member? [
 409         winsock-error-string throw
 410     ] when ;
 411
 412 : winsock-error!=0/f ( n/f -- )
 413     { 0 f } member? [
 414         winsock-error-string throw
 415     ] unless ;
 416
 417 : winsock-return-check ( n/f -- )
 418     dup { 0 f } member? [
 419         drop
 420     ] [
 421         (winsock-error-string) throw
 422     ] if ;
 423
 424 : socket-error* ( n -- )
 425     SOCKET_ERROR = [
 426         WSAGetLastError
 427         dup WSA_IO_PENDING = [
 428             drop
 429         ] [
 430             (winsock-error-string) throw
 431         ] if
 432     ] when ;
 433
 434 : socket-error ( n -- )
 435     SOCKET_ERROR = [ winsock-error ] when ;
 436
 437 : init-winsock ( -- )
 438     HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
 439
 440 [ init-winsock ] "windows.winsock" add-init-hook