X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fwindows%2Fwinsock%2Fwinsock.factor;h=f0503114e378e6322efbc2e92cd9b502686c7241;hp=49a3d6e9faf861ce2fb98d31c6f905502b47a365;hb=10e78dde3637ed0adca1972c76e7f283096cdcdc;hpb=026499e64fd6718418310dfdbff41e3350efb900 diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 49a3d6e9fa..f0503114e3 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -1,16 +1,20 @@ ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.syntax arrays -byte-arrays kernel literals math sequences windows.types -windows.kernel32 windows.errors math.bitwise io.encodings.utf16n -classes.struct windows.com.syntax init literals ; -FROM: alien.c-types => short ; +USING: accessors alien alien.c-types alien.data alien.syntax +byte-arrays classes.struct grouping init kernel literals math +math.parser sequences system vocabs.parser windows.com.syntax +windows.errors windows.kernel32 windows.types ; IN: windows.winsock -TYPEDEF: void* SOCKET +<< +! Some differences between Win32 and Win64 +cpu x86.64? "windows.winsock.64" "windows.winsock.32" ? use-vocab +>> + +TYPEDEF: int* SOCKET : ( -- byte-array ) - HEX: 190 ; + 0x190 ; CONSTANT: SOCK_STREAM 1 CONSTANT: SOCK_DGRAM 2 @@ -18,27 +22,27 @@ CONSTANT: SOCK_RAW 3 CONSTANT: SOCK_RDM 4 CONSTANT: SOCK_SEQPACKET 5 -CONSTANT: SO_DEBUG HEX: 1 -CONSTANT: SO_ACCEPTCONN HEX: 2 -CONSTANT: SO_REUSEADDR HEX: 4 -CONSTANT: SO_KEEPALIVE HEX: 8 -CONSTANT: SO_DONTROUTE HEX: 10 -CONSTANT: SO_BROADCAST HEX: 20 -CONSTANT: SO_USELOOPBACK HEX: 40 -CONSTANT: SO_LINGER HEX: 80 -CONSTANT: SO_OOBINLINE HEX: 100 +CONSTANT: SO_DEBUG 0x1 +CONSTANT: SO_ACCEPTCONN 0x2 +CONSTANT: SO_REUSEADDR 0x4 +CONSTANT: SO_KEEPALIVE 0x8 +CONSTANT: SO_DONTROUTE 0x10 +CONSTANT: SO_BROADCAST 0x20 +CONSTANT: SO_USELOOPBACK 0x40 +CONSTANT: SO_LINGER 0x80 +CONSTANT: SO_OOBINLINE 0x100 : SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline -CONSTANT: SO_SNDBUF HEX: 1001 -CONSTANT: SO_RCVBUF HEX: 1002 -CONSTANT: SO_SNDLOWAT HEX: 1003 -CONSTANT: SO_RCVLOWAT HEX: 1004 -CONSTANT: SO_SNDTIMEO HEX: 1005 -CONSTANT: SO_RCVTIMEO HEX: 1006 -CONSTANT: SO_ERROR HEX: 1007 -CONSTANT: SO_TYPE HEX: 1008 +CONSTANT: SO_SNDBUF 0x1001 +CONSTANT: SO_RCVBUF 0x1002 +CONSTANT: SO_SNDLOWAT 0x1003 +CONSTANT: SO_RCVLOWAT 0x1004 +CONSTANT: SO_SNDTIMEO 0x1005 +CONSTANT: SO_RCVTIMEO 0x1006 +CONSTANT: SO_ERROR 0x1007 +CONSTANT: SO_TYPE 0x1008 -CONSTANT: TCP_NODELAY HEX: 1 +CONSTANT: TCP_NODELAY 0x1 CONSTANT: AF_UNSPEC 0 CONSTANT: AF_UNIX 1 @@ -69,18 +73,65 @@ CONSTANT: PF_LOCAL 1 CONSTANT: PF_INET 2 CONSTANT: PF_INET6 23 -CONSTANT: AI_PASSIVE 1 -CONSTANT: AI_CANONNAME 2 -CONSTANT: AI_NUMERICHOST 4 +CONSTANT: AI_PASSIVE 0x0001 +CONSTANT: AI_CANONNAME 0x0002 +CONSTANT: AI_NUMERICHOST 0x0004 +CONSTANT: AI_ALL 0x0100 +CONSTANT: AI_ADDRCONFIG 0x0400 CONSTANT: AI_MASK flags{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } CONSTANT: NI_NUMERICHOST 1 CONSTANT: NI_NUMERICSERV 2 -CONSTANT: IPPROTO_TCP 6 -CONSTANT: IPPROTO_UDP 17 -CONSTANT: IPPROTO_RM 113 +CONSTANT: IPPROTO_IP 0 ! Dummy protocol for TCP. +CONSTANT: IPPROTO_ICMP 1 ! Internet Control Message Protocol. +CONSTANT: IPPROTO_IGMP 2 ! Internet Group Management Protocol. */ +CONSTANT: IPPROTO_IPIP 4 ! IPIP tunnels (older KA9Q tunnels use 94). +CONSTANT: IPPROTO_TCP 6 ! Transmission Control Protocol. +CONSTANT: IPPROTO_EGP 8 ! Exterior Gateway Protocol. +CONSTANT: IPPROTO_PUP 12 ! PUP protocol. +CONSTANT: IPPROTO_UDP 17 ! User Datagram Protocol. +CONSTANT: IPPROTO_IDP 22 ! XNS IDP protocol. +CONSTANT: IPPROTO_TP 29 ! SO Transport Protocol Class 4. +CONSTANT: IPPROTO_DCCP 33 ! Datagram Congestion Control Protocol. +CONSTANT: IPPROTO_IPV6 41 ! IPv6 header. +CONSTANT: IPPROTO_RSVP 46 ! Reservation Protocol. +CONSTANT: IPPROTO_GRE 47 ! General Routing Encapsulation. +CONSTANT: IPPROTO_ESP 50 ! encapsulating security payload. +CONSTANT: IPPROTO_AH 51 ! authentication header. +CONSTANT: IPPROTO_MTP 92 ! Multicast Transport Protocol. +CONSTANT: IPPROTO_BEETPH 94 ! IP option pseudo header for BEET. +CONSTANT: IPPROTO_ENCAP 98 ! Encapsulation Header. +CONSTANT: IPPROTO_PIM 103 ! Protocol Independent Multicast. +CONSTANT: IPPROTO_COMP 108 ! Compression Header Protocol. +CONSTANT: IPPROTO_RM 113 ! Reliable Multicast aka PGM +CONSTANT: IPPROTO_SCTP 132 ! Stream Control Transmission Protocol. +CONSTANT: IPPROTO_UDPLITE 136 ! UDP-Lite protocol. +CONSTANT: IPPROTO_MPLS 137 ! MPLS in IP. +CONSTANT: IPPROTO_RAW 255 ! Raw IP packets. + +CONSTANT: FIOASYNC 0x8004667d +CONSTANT: FIONBIO 0x8004667e +CONSTANT: FIONREAD 0x4004667f + +CONSTANT: IP_OPTIONS 1 +CONSTANT: IP_HDRINCL 2 +CONSTANT: IP_TOS 3 +CONSTANT: IP_TTL 4 +CONSTANT: IP_MULTICAST_IF 9 +CONSTANT: IP_MULTICAST_TTL 10 +CONSTANT: IP_MULTICAST_LOOP 11 +CONSTANT: IP_ADD_MEMBERSHIP 12 +CONSTANT: IP_DROP_MEMBERSHIP 13 +CONSTANT: IP_DONTFRAGMENT 14 +CONSTANT: IP_ADD_SOURCE_MEMBERSHIP 15 +CONSTANT: IP_DROP_SOURCE_MEMBERSHIP 16 +CONSTANT: IP_BLOCK_SOURCE 17 +CONSTANT: IP_UNBLOCK_SOURCE 18 +CONSTANT: IP_PKTINFO 19 +CONSTANT: IP_RECEIVE_BROADCAST 22 + CONSTANT: WSA_FLAG_OVERLAPPED 1 ALIAS: WSA_WAIT_EVENT_0 WAIT_OBJECT_0 @@ -96,13 +147,13 @@ CONSTANT: INADDR_ANY 0 : INVALID_SOCKET ( -- n ) -1 ; inline -CONSTANT: SOCKET_ERROR -1 +: SOCKET_ERROR ( -- n ) -1 ; inline CONSTANT: SD_RECV 0 CONSTANT: SD_SEND 1 CONSTANT: SD_BOTH 2 -CONSTANT: SOL_SOCKET HEX: ffff +CONSTANT: SOL_SOCKET 0xffff C-TYPE: sockaddr @@ -126,6 +177,11 @@ STRUCT: hostent { length short } { addr-list void* } ; +STRUCT: protoent + { name c-string } + { aliases void* } + { proto short } ; + STRUCT: addrinfo { flags int } { family int } @@ -140,38 +196,56 @@ STRUCT: timeval { sec long } { usec long } ; -C-TYPE: fd_set +GENERIC: sockaddr>ip ( sockaddr -- string ) + +M: sockaddr-in sockaddr>ip + addr>> uint [ number>string ] { } map-as "." join ; + +M: sockaddr-in6 sockaddr>ip + addr>> [ >hex ] { } map-as 2 group [ concat ] map ":" join ; + +STRUCT: fd_set + { fd_count uint } + { fd_array SOCKET[64] } ; LIBRARY: winsock -FUNCTION: int setsockopt ( SOCKET s, int level, int optname, c-string optval, int optlen ) ; +FUNCTION: int setsockopt ( SOCKET s, int level, int optname, c-string optval, int optlen ) +FUNCTION: int ioctlsocket ( SOCKET s, long cmd, ulong* *argp ) -FUNCTION: ushort htons ( ushort n ) ; -FUNCTION: ushort ntohs ( ushort n ) ; -FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ; -FUNCTION: int listen ( void* socket, int backlog ) ; -FUNCTION: c-string inet_ntoa ( int in-addr ) ; +FUNCTION: ushort htons ( ushort n ) +FUNCTION: ushort ntohs ( ushort n ) +FUNCTION: int bind ( SOCKET socket, sockaddr-in* sockaddr, int len ) +FUNCTION: int listen ( SOCKET socket, int backlog ) +FUNCTION: c-string inet_ntoa ( int in-addr ) FUNCTION: int getaddrinfo ( c-string nodename, c-string servername, addrinfo* hints, - addrinfo** res ) ; + addrinfo** res ) + +FUNCTION: void freeaddrinfo ( addrinfo* ai ) + -FUNCTION: void freeaddrinfo ( addrinfo* ai ) ; +FUNCTION: hostent* gethostbyname ( c-string name ) +FUNCTION: int gethostname ( c-string name, int len ) +FUNCTION: SOCKET socket ( int domain, int type, int protocol ) +FUNCTION: int connect ( SOCKET socket, sockaddr-in* sockaddr, int addrlen ) +FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) +FUNCTION: int closesocket ( SOCKET s ) +FUNCTION: int shutdown ( SOCKET s, int how ) +FUNCTION: int send ( SOCKET s, c-string buf, int len, int flags ) +FUNCTION: int recv ( SOCKET s, c-string buf, int len, int flags ) +FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) +FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) -FUNCTION: hostent* gethostbyname ( c-string name ) ; -FUNCTION: int gethostname ( c-string name, int len ) ; -FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ; -FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ; -FUNCTION: int closesocket ( SOCKET s ) ; -FUNCTION: int shutdown ( SOCKET s, int how ) ; -FUNCTION: int send ( SOCKET s, c-string buf, int len, int flags ) ; -FUNCTION: int recv ( SOCKET s, c-string buf, int len, int flags ) ; +FUNCTION: protoent* getprotobyname ( c-string name ) -FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ; -FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ; +FUNCTION: servent* getservbyname ( c-string name, c-string prot ) +FUNCTION: servent* getservbyport ( int port, c-string prot ) TYPEDEF: uint SERVICETYPE +TYPEDEF: void* LPWSADATA TYPEDEF: OVERLAPPED WSAOVERLAPPED TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED TYPEDEF: uint GROUP @@ -275,12 +349,12 @@ FUNCTION: SOCKET WSAAccept ( SOCKET s, sockaddr* addr, LPINT addrlen, LPCONDITIONPROC lpfnCondition, - DWORD dwCallbackData ) ; + DWORD dwCallbackData ) ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ; -FUNCTION: int WSACleanup ( ) ; -FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) ; +FUNCTION: int WSACleanup ( ) +FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent ) FUNCTION: int WSAConnect ( SOCKET s, sockaddr* name, @@ -288,24 +362,25 @@ FUNCTION: int WSAConnect ( SOCKET s, LPWSABUF lpCallerData, LPWSABUF lpCalleeData, LPQOS lpSQOS, - LPQOS lpGQOS ) ; -FUNCTION: WSAEVENT WSACreateEvent ( ) ; + LPQOS lpGQOS ) +FUNCTION: WSAEVENT WSACreateEvent ( ) ! FUNCTION: INT WSAEnumNameSpaceProviders ( LPDWORD lpdwBufferLength, LPWSANAMESPACE_INFO lpnspBuffer ) ; FUNCTION: int WSAEnumNetworkEvents ( SOCKET s, WSAEVENT hEventObject, - LPWSANETWORKEVENTS lpNetworkEvents ) ; + LPWSANETWORKEVENTS lpNetworkEvents ) ! FUNCTION: int WSAEnumProtocols ( LPINT lpiProtocols, LPWSAPROTOCOL_INFO lpProtocolBuffer, LPDWORD lpwdBufferLength ) ; FUNCTION: int WSAEventSelect ( SOCKET s, WSAEVENT hEventObject, - long lNetworkEvents ) ; -FUNCTION: int WSAGetLastError ( ) ; + long lNetworkEvents ) +FUNCTION: int WSAGetLastError ( ) FUNCTION: BOOL WSAGetOverlappedResult ( SOCKET s, LPWSAOVERLAPPED lpOverlapped, LPDWORD lpcbTransfer, BOOL fWait, - LPDWORD lpdwFlags ) ; + LPDWORD lpdwFlags ) +TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE FUNCTION: int WSAIoctl ( SOCKET s, DWORD dwIoControlCode, LPVOID lpvInBuffer, @@ -313,36 +388,35 @@ FUNCTION: int WSAIoctl ( SOCKET s, LPVOID lpvOutBuffer, DWORD cbOutBuffer, LPDWORD lpcbBytesReturned, - void* lpOverlapped, - void* lpCompletionRoutine ) ; + LPWSAOVERLAPPED lpOverlapped, + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) -TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE FUNCTION: int WSARecv ( SOCKET s, LPWSABUF lpBuffers, DWORD dwBufferCount, LPDWORD lpNumberOfBytesRecvd, LPDWORD lpFlags, LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ; + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) FUNCTION: int WSARecvFrom ( SOCKET s, - LPWSABUF lpBuffers, - DWORD dwBufferCount, - LPDWORD lpNumberOfBytesRecvd, - LPDWORD lpFlags, - sockaddr* lpFrom, - LPINT lpFromlen, - LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ; - -FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) ; + LPWSABUF lpBuffers, + DWORD dwBufferCount, + LPDWORD lpNumberOfBytesRecvd, + LPDWORD lpFlags, + sockaddr* lpFrom, + LPINT lpFromlen, + LPWSAOVERLAPPED lpOverlapped, + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) + +FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent ) FUNCTION: int WSASend ( SOCKET s, LPWSABUF lpBuffers, DWORD dwBufferCount, LPDWORD lpNumberOfBytesSent, LPDWORD lpFlags, LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ; + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) FUNCTION: int WSASendTo ( SOCKET s, LPWSABUF lpBuffers, @@ -352,32 +426,35 @@ FUNCTION: int WSASendTo ( SOCKET s, sockaddr* lpTo, int iToLen, LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) ; - - -FUNCTION: int WSAStartup ( short version, void* out-data ) ; - + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine ) +FUNCTION: int WSAStartup ( WORD version, LPWSADATA out-data ) FUNCTION: SOCKET WSASocketW ( int af, int type, int protocol, LPWSAPROTOCOL_INFOW lpProtocolInfo, GROUP g, - DWORD flags ) ; + DWORD flags ) ALIAS: WSASocket WSASocketW FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents, WSAEVENT* lphEvents, BOOL fWaitAll, DWORD dwTimeout, - BOOL fAlertable ) ; + BOOL fAlertable ) LIBRARY: mswsock -! Not in Windows CE -FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ; +FUNCTION: int AcceptEx ( SOCKET listen, + SOCKET accept, + PVOID out-buf, + DWORD recv-len, + DWORD addr-len, + DWORD remote-len, + LPDWORD out-len, + LPOVERLAPPED overlapped ) FUNCTION: void GetAcceptExSockaddrs ( PVOID lpOutputBuffer, @@ -388,41 +465,46 @@ FUNCTION: void GetAcceptExSockaddrs ( LPINT LocalSockaddrLength, LPSOCKADDR* RemoteSockaddr, LPINT RemoteSockaddrLength -) ; +) CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090 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 ) - ! #! WSAStartup returns the error code 'n' directly +: (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* ; + +: (winsock-error) ( n -- * ) + [ ] [ n>win32-error-string ] bi winsock-exception ; + +: throw-winsock-error ( -- * ) + WSAGetLastError (winsock-error) ; : winsock-error=0/f ( n/f -- ) - { 0 f } member? [ - winsock-error-string throw - ] when ; + { 0 f } member? [ winsock-error ] when ; : winsock-error!=0/f ( n/f -- ) - { 0 f } member? [ - winsock-error-string throw - ] unless ; + { 0 f } member? [ 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 -- ) @@ -431,7 +513,7 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e} dup WSA_IO_PENDING = [ drop ] [ - (winsock-error-string) throw + (maybe-winsock-exception) throw ] if ] when ; @@ -439,9 +521,9 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e} SOCKET_ERROR = [ winsock-error ] when ; : init-winsock ( -- ) - HEX: 0202 WSAStartup winsock-return-check ; + 0x0202 WSAStartup winsock-return-check ; : shutdown-winsock ( -- ) WSACleanup winsock-return-check ; -[ init-winsock ] "windows.winsock" add-startup-hook -[ shutdown-winsock ] "windows.winsock" add-shutdown-hook +STARTUP-HOOK: init-winsock +SHUTDOWN-HOOK: shutdown-winsock