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 FROM: alien.c-types => short ;
   8 IN: windows.winsock
   9
  10 TYPEDEF: void* SOCKET
  11
  12 : <wsadata> ( -- byte-array )
  13     HEX: 190 <byte-array> ;
  14
  15 CONSTANT: SOCK_STREAM    1
  16 CONSTANT: SOCK_DGRAM     2
  17 CONSTANT: SOCK_RAW       3
  18 CONSTANT: SOCK_RDM       4
  19 CONSTANT: SOCK_SEQPACKET 5
  20
  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
  31
  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
  40
  41 CONSTANT: TCP_NODELAY   HEX:    1
  42
  43 CONSTANT: AF_UNSPEC      0
  44 CONSTANT: AF_UNIX        1
  45 CONSTANT: AF_INET        2
  46 CONSTANT: AF_IMPLINK     3
  47 CONSTANT: AF_PUP         4
  48 CONSTANT: AF_CHAOS       5
  49 CONSTANT: AF_NS          6
  50 CONSTANT: AF_ISO         7
  51 ALIAS: AF_OSI    AF_ISO
  52 CONSTANT: AF_ECMA        8
  53 CONSTANT: AF_DATAKIT     9
  54 CONSTANT: AF_CCITT      10
  55 CONSTANT: AF_SNA        11
  56 CONSTANT: AF_DECnet     12
  57 CONSTANT: AF_DLI        13
  58 CONSTANT: AF_LAT        14
  59 CONSTANT: AF_HYLINK     15
  60 CONSTANT: AF_APPLETALK  16
  61 CONSTANT: AF_NETBIOS    17
  62 CONSTANT: AF_MAX        18
  63 CONSTANT: AF_INET6      23
  64 CONSTANT: AF_IRDA       26
  65 CONSTANT: AF_BTM        32
  66
  67 CONSTANT: PF_UNSPEC      0
  68 CONSTANT: PF_LOCAL       1
  69 CONSTANT: PF_INET        2
  70 CONSTANT: PF_INET6      23
  71
  72 CONSTANT: AI_PASSIVE     1
  73 CONSTANT: AI_CANONNAME   2
  74 CONSTANT: AI_NUMERICHOST 4
  75
  76 : AI_MASK ( -- n )
  77     { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
  78
  79 CONSTANT: NI_NUMERICHOST 1
  80 CONSTANT: NI_NUMERICSERV 2
  81
  82 CONSTANT: IPPROTO_TCP    6
  83 CONSTANT: IPPROTO_UDP   17
  84 CONSTANT: IPPROTO_RM   113
  85
  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
  95
  96 CONSTANT: INADDR_ANY 0
  97
  98 : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
  99
 100 CONSTANT: SOCKET_ERROR -1
 101
 102 CONSTANT: SD_RECV 0
 103 CONSTANT: SD_SEND 1
 104 CONSTANT: SD_BOTH 2
 105
 106 CONSTANT: SOL_SOCKET HEX: ffff
 107
 108 STRUCT: sockaddr-in
 109     { family short }
 110     { port ushort }
 111     { addr uint }
 112     { pad char[8] } ;
 113
 114 STRUCT: sockaddr-in6
 115     { family uchar }
 116     { port ushort }
 117     { flowinfo uint }
 118     { addr uchar[16] }
 119     { scopeid uint } ;
 120
 121 STRUCT: hostent
 122     { name char* }
 123     { aliases void* }
 124     { addrtype short }
 125     { length short }
 126     { addr-list void* } ;
 127
 128 STRUCT: addrinfo
 129     { flags int }
 130     { family int }
 131     { socktype int }
 132     { protocol int }
 133     { addrlen size_t }
 134     { canonname char* }
 135     { addr sockaddr* }
 136     { next addrinfo* } ;
 137
 138 C-STRUCT: timeval
 139     { "long" "sec" }
 140     { "long" "usec" } ;
 141
 142 LIBRARY: winsock
 143
 144 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
 145
 146 FUNCTION: ushort htons ( ushort n ) ;
 147 FUNCTION: ushort ntohs ( ushort n ) ;
 148 FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
 149 FUNCTION: int listen ( void* socket, int backlog ) ;
 150 FUNCTION: char* inet_ntoa ( int in-addr ) ;
 151 FUNCTION: int getaddrinfo ( char* nodename,
 152                             char* servername,
 153                             addrinfo* hints,
 154                             addrinfo** res ) ;
 155
 156 FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 157
 158
 159 FUNCTION: hostent* gethostbyname ( char* name ) ;
 160 FUNCTION: int gethostname ( char* name, int len ) ;
 161 FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
 162 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
 163 FUNCTION: int closesocket ( SOCKET s ) ;
 164 FUNCTION: int shutdown ( SOCKET s, int how ) ;
 165 FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
 166 FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
 167
 168 FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
 169 FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
 170
 171 TYPEDEF: uint SERVICETYPE
 172 TYPEDEF: OVERLAPPED WSAOVERLAPPED
 173 TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
 174 TYPEDEF: uint GROUP
 175 TYPEDEF: void* LPCONDITIONPROC
 176 TYPEDEF: HANDLE WSAEVENT
 177 TYPEDEF: LPHANDLE LPWSAEVENT
 178 TYPEDEF: sockaddr* LPSOCKADDR
 179
 180 C-STRUCT: FLOWSPEC
 181     { "uint"        "TokenRate" }
 182     { "uint"        "TokenBucketSize" }
 183     { "uint"        "PeakBandwidth" }
 184     { "uint"        "Latency" }
 185     { "uint"        "DelayVariation" }
 186     { "SERVICETYPE" "ServiceType" }
 187     { "uint"        "MaxSduSize" }
 188     { "uint"        "MinimumPolicedSize" } ;
 189 TYPEDEF: FLOWSPEC* PFLOWSPEC
 190 TYPEDEF: FLOWSPEC* LPFLOWSPEC
 191
 192 STRUCT: WSABUF
 193     { len ulong }
 194     { buf void* } ;
 195 TYPEDEF: WSABUF* LPWSABUF
 196
 197 C-STRUCT: QOS
 198     { "FLOWSPEC" "SendingFlowspec" }
 199     { "FLOWSPEC" "ReceivingFlowspec" }
 200     { "WSABUF" "ProviderSpecific" } ;
 201 TYPEDEF: QOS* LPQOS
 202
 203 CONSTANT: MAX_PROTOCOL_CHAIN 7
 204
 205 C-STRUCT: WSAPROTOCOLCHAIN
 206     { "int" "ChainLen" }
 207     ! { { "DWORD" MAX_PROTOCOL_CHAIN } "ChainEntries" } ;
 208     { { "DWORD" 7 } "ChainEntries" } ;
 209 TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
 210
 211 CONSTANT: WSAPROTOCOL_LEN 255
 212
 213 C-STRUCT: WSAPROTOCOL_INFOW
 214     { "DWORD" "dwServiceFlags1" }
 215     { "DWORD" "dwServiceFlags2" }
 216     { "DWORD" "dwServiceFlags3" }
 217     { "DWORD" "dwServiceFlags4" }
 218     { "DWORD" "dwProviderFlags" }
 219     { "GUID" "ProviderId" }
 220     { "DWORD" "dwCatalogEntryId" }
 221     { "WSAPROTOCOLCHAIN" "ProtocolChain" }
 222     { "int" "iVersion" }
 223     { "int" "iAddressFamily" }
 224     { "int" "iMaxSockAddr" }
 225     { "int" "iMinSockAddr" }
 226     { "int" "iSocketType" }
 227     { "int" "iProtocol" }
 228     { "int" "iProtocolMaxOffset" }
 229     { "int" "iNetworkByteOrder" }
 230     { "int" "iSecurityScheme" }
 231     { "DWORD" "dwMessageSize" }
 232     { "DWORD" "dwProviderReserved" }
 233     { { "WCHAR" 256 } "szProtocol" } ;
 234     ! { { "WCHAR" 256 } "szProtocol"[WSAPROTOCOL_LEN+1] } ;
 235 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
 236 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
 237 TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
 238 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFO
 239 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
 240
 241
 242 C-STRUCT: WSANAMESPACE_INFOW
 243     { "GUID"    "NSProviderId" }
 244     { "DWORD"   "dwNameSpace" }
 245     { "BOOL"    "fActive" }
 246     { "DWORD"   "dwVersion" }
 247     { "LPWSTR"  "lpszIdentifier" } ;
 248 TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
 249 TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
 250 TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
 251 TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO
 252 TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
 253
 254 CONSTANT: FD_MAX_EVENTS 10
 255
 256 C-STRUCT: WSANETWORKEVENTS
 257     { "long" "lNetworkEvents" }
 258     { { "int" FD_MAX_EVENTS } "iErrorCode" } ;
 259 TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
 260 TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
 261
 262 ! C-STRUCT: WSAOVERLAPPED
 263     ! { "DWORD" "Internal" }
 264     ! { "DWORD" "InternalHigh" }
 265     ! { "DWORD" "Offset" }
 266     ! { "DWORD" "OffsetHigh" }
 267     ! { "WSAEVENT" "hEvent" }
 268     ! { "DWORD" "bytesTransferred" } ;
 269 ! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
 270
 271 FUNCTION: SOCKET WSAAccept ( SOCKET s,
 272                              sockaddr* addr,
 273                              LPINT addrlen,
 274                              LPCONDITIONPROC lpfnCondition,
 275                              DWORD dwCallbackData ) ;
 276
 277 ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ;
 278
 279 FUNCTION: int WSACleanup ( ) ;
 280 FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) ;
 281
 282 FUNCTION: int WSAConnect ( SOCKET s,
 283                            sockaddr* name,
 284                            int namelen,
 285                            LPWSABUF lpCallerData,
 286                            LPWSABUF lpCalleeData,
 287                            LPQOS lpSQOS,
 288                            LPQOS lpGQOS ) ;
 289 FUNCTION: WSAEVENT WSACreateEvent ( ) ;
 290 ! FUNCTION: INT WSAEnumNameSpaceProviders ( LPDWORD lpdwBufferLength, LPWSANAMESPACE_INFO lpnspBuffer ) ;
 291 FUNCTION: int WSAEnumNetworkEvents ( SOCKET s,
 292                                      WSAEVENT hEventObject,
 293                                      LPWSANETWORKEVENTS lpNetworkEvents ) ;
 294 ! FUNCTION: int WSAEnumProtocols ( LPINT lpiProtocols, LPWSAPROTOCOL_INFO lpProtocolBuffer, LPDWORD lpwdBufferLength ) ;
 295
 296 FUNCTION: int WSAEventSelect ( SOCKET s,
 297                                WSAEVENT hEventObject,
 298                                long lNetworkEvents ) ;
 299 FUNCTION: int WSAGetLastError ( ) ;
 300 FUNCTION: BOOL WSAGetOverlappedResult ( SOCKET s,
 301                                         LPWSAOVERLAPPED lpOverlapped,
 302                                         LPDWORD lpcbTransfer,
 303                                         BOOL fWait,
 304                                         LPDWORD lpdwFlags ) ;
 305
 306 FUNCTION: int WSAIoctl ( SOCKET s,
 307                          DWORD dwIoControlCode,
 308                          LPVOID lpvInBuffer,
 309                          DWORD cbInBuffer,
 310                          LPVOID lpvOutBuffer,
 311                          DWORD cbOutBuffer,
 312                          LPDWORD lpcbBytesReturned,
 313                          void* lpOverlapped,
 314                          void* lpCompletionRoutine ) ;
 315
 316 TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE
 317 FUNCTION: int WSARecv ( SOCKET s,
 318                         LPWSABUF lpBuffers,
 319                         DWORD dwBufferCount,
 320                         LPDWORD lpNumberOfBytesRecvd,
 321                         LPDWORD lpFlags,
 322                         LPWSAOVERLAPPED lpOverlapped,
 323                     LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 324
 325 FUNCTION: int WSARecvFrom ( SOCKET s,
 326                     LPWSABUF lpBuffers,
 327                     DWORD dwBufferCount,
 328                     LPDWORD lpNumberOfBytesRecvd,
 329                     LPDWORD lpFlags,
 330                     sockaddr* lpFrom,
 331                     LPINT lpFromlen,
 332                     LPWSAOVERLAPPED lpOverlapped,
 333                     LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 334
 335 FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) ;
 336 FUNCTION: int WSASend ( SOCKET s,
 337                         LPWSABUF lpBuffers,
 338                         DWORD dwBufferCount,
 339                         LPDWORD lpNumberOfBytesSent,
 340                         LPDWORD lpFlags,
 341                         LPWSAOVERLAPPED lpOverlapped,
 342                  LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 343
 344 FUNCTION: int WSASendTo ( SOCKET s,
 345                           LPWSABUF lpBuffers,
 346                           DWORD dwBufferCount,
 347                           LPDWORD lpNumberOfBytesSent,
 348                           DWORD dwFlags,
 349                           sockaddr* lpTo,
 350                           int iToLen,
 351                           LPWSAOVERLAPPED lpOverlapped,
 352   LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ;
 353
 354
 355 FUNCTION: int WSAStartup ( short version, void* out-data ) ;
 356
 357
 358
 359 FUNCTION: SOCKET WSASocketW ( int af,
 360                              int type,
 361                              int protocol,
 362                              LPWSAPROTOCOL_INFOW lpProtocolInfo,
 363                              GROUP g,
 364                              DWORD flags ) ;
 365 ALIAS: WSASocket WSASocketW
 366
 367 FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
 368                                            WSAEVENT* lphEvents,
 369                                            BOOL fWaitAll,
 370                                            DWORD dwTimeout,
 371                                            BOOL fAlertable ) ;
 372
 373
 374 LIBRARY: mswsock
 375
 376 ! Not in Windows CE
 377 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
 379 FUNCTION: void GetAcceptExSockaddrs (
 380   PVOID lpOutputBuffer,
 381   DWORD dwReceiveDataLength,
 382   DWORD dwLocalAddressLength,
 383   DWORD dwRemoteAddressLength,
 384   LPSOCKADDR* LocalSockaddr,
 385   LPINT LocalSockaddrLength,
 386   LPSOCKADDR* RemoteSockaddr,
 387   LPINT RemoteSockaddrLength
 388 ) ;
 389
 390 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 391
 392 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 393
 394 : winsock-expected-error? ( n -- ? )
 395     ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
 396
 397 : (winsock-error-string) ( n -- str )
 398     ! #! WSAStartup returns the error code 'n' directly
 399     dup winsock-expected-error?
 400     [ drop f ] [ n>win32-error-string ] if ;
 401
 402 : winsock-error-string ( -- string/f )
 403     WSAGetLastError (winsock-error-string) ;
 404
 405 : winsock-error ( -- )
 406     winsock-error-string [ throw ] when* ;
 407
 408 : winsock-error=0/f ( n/f -- )
 409     { 0 f } member? [
 410         winsock-error-string throw
 411     ] when ;
 412
 413 : winsock-error!=0/f ( n/f -- )
 414     { 0 f } member? [
 415         winsock-error-string throw
 416     ] unless ;
 417
 418 : winsock-return-check ( n/f -- )
 419     dup { 0 f } member? [
 420         drop
 421     ] [
 422         (winsock-error-string) throw
 423     ] if ;
 424
 425 : socket-error* ( n -- )
 426     SOCKET_ERROR = [
 427         WSAGetLastError
 428         dup WSA_IO_PENDING = [
 429             drop
 430         ] [
 431             (winsock-error-string) throw
 432         ] if
 433     ] when ;
 434
 435 : socket-error ( n -- )
 436     SOCKET_ERROR = [ winsock-error ] when ;
 437
 438 : init-winsock ( -- )
 439     HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
 440
 441 [ init-winsock ] "windows.winsock" add-init-hook