\ wsa.f Howerd Oakford 2008 Jul 16 \ Windows Sockets API ( Berkeley-like interface ) \ Also a simple TCP/IP client terminal, and an HTTP interface. \ Written in ANS Forth using the SwiftForth, VFX and Win32Forth V6.12 Windows interfaces. \ A short overview \ ================ \ The Windows Sockets API defines the way in which an application program \ ( like the client below ) can use Windows Sockets. \ Sockets are an abstract concept analagous to a telephone exchange \ jack socket, originally used to connect telephone lines together. \ API is an ancronym for Application Progam Interface. \ A "client" is a program running on your PC that connects to a "server" \ A "server" is a program running on a remote PC that responds to the \ client's requests. \ The protocol ( TCP/IP or UDP/IP in this case ) defines an interface between \ the client and server programs - this is handled for you by the Windows \ Sockets API. \ A "host name" is a string which defines the "host" - the PC running the server \ program. \ An IP (Internet Protocol) address is a 32 bit number (for IP version 4) \ which allows the IP packet to be routed to a given PC. \ A POP3 email server acts on ASCII text commands such a "LIST" \ (sent using TCP/IP), as defined by POP3 (Post Office Protocol version 3). \ HTTP is a text-based protocol that uses TCP/IP to read files, and more. \ To compile this file, run the Forth program and type include wsa.f \ The type help to see the available options decimal : WSAver cr ." WSA V1.0 2008 Jul 16 " ; \ ***************************************************************************** \ The Windows Sockets API functions - MPE VFX dialect \ http://www.mpeforth.com/arena.htm#trial \ ***************************************************************************** [defined] VFXFORTH [if] \ Library: WSOCK32.DLL init-libs EXTERN: int PASCAL WSAStartup ( wVersionRequired, lpWSAData ); EXTERN: int PASCAL WSACleanup ( ); EXTERN: int PASCAL WSASetLastError ( iError ); EXTERN: int PASCAL WSAGetLastError ( ); EXTERN: int PASCAL WSAIsBlocking ( ); EXTERN: int PASCAL WSAUnhookBlockingHook ( ); EXTERN: int PASCAL WSASetBlockingHook ( lpBlockFunc ); EXTERN: int PASCAL WSACancelBlockingCall ( ); EXTERN: int PASCAL WSAAsyncGetServByName ( hWnd, wMsg, *name, *proto, *buf, buflen ); EXTERN: int PASCAL WSAAsyncGetServByPort ( hWnd, wMsg, port, *proto, *buf, buflen ); EXTERN: int PASCAL WSAAsyncGetProtoByName ( hWnd, wMsg, *name, *buf, buflen ); EXTERN: int PASCAL WSAAsyncGetProtoByNumber ( hWnd, wMsg, number, *buf, buflen ); EXTERN: int PASCAL WSAAsyncGetHostByName ( hWnd, wMsg, *name, *buf, buflen ); EXTERN: int PASCAL WSAAsyncGetHostByAddr ( hWnd, wMsg, *addr, len, type, *buf, buflen ); EXTERN: int PASCAL WSACancelAsyncRequest ( hAsyncTaskHandle ); EXTERN: int PASCAL WSAAsyncSelect ( s, hWnd, wMsg, lEvent ); EXTERN: int PASCAL WSARecvEx ( s, *buf, len, *flags ); EXTERN: int PASCAL accept ( s, 'sock, len ); EXTERN: int PASCAL bind ( s, 'sock, namelen ); EXTERN: int PASCAL closesocket ( s ); EXTERN: int PASCAL connect ( s, 'sock, len ); EXTERN: int PASCAL ioctlsocket ( s, cmd, *argp ); EXTERN: int PASCAL getpeername ( s, sockaddr, *namelen ); EXTERN: int PASCAL getsockname ( s, sockaddr, *namelen ); EXTERN: int PASCAL getsockopt ( s, level, optname, *optval, *optlen ); EXTERN: int PASCAL htonl ( hostlong ); EXTERN: int PASCAL htons ( hostshort ); EXTERN: int PASCAL inet_addr ( *cp ); EXTERN: int PASCAL inet_ntoa ( in_addr ); EXTERN: int PASCAL listen ( s, backlog ); EXTERN: int PASCAL ntohl ( netlong ); EXTERN: int PASCAL ntohs ( netshort ); EXTERN: int PASCAL recv ( s, *buf, len, flags ); EXTERN: int PASCAL recvfrom ( s, *buf, len, flags, *from, *fromlen ); EXTERN: int PASCAL select ( nfds, *readfds, *writefds, *exceptfds, *timeout ); EXTERN: int PASCAL send ( s, *buf, len, flags ); EXTERN: int PASCAL sendto ( s, *buf, len, flags, *to, tolen ); EXTERN: int PASCAL setsockopt ( s, level, optname, *optval, optlen ); EXTERN: int PASCAL shutdown ( s, how ); EXTERN: int PASCAL socket ( af, type, protocol ); EXTERN: int PASCAL gethostbyaddr ( *addr, len, type ); EXTERN: int PASCAL gethostbyname ( *name ); EXTERN: int PASCAL gethostname ( *name, namelen ); EXTERN: int PASCAL getservbyport ( port, *proto ); EXTERN: int PASCAL getservbyname ( *name, *proto); EXTERN: int PASCAL getprotobynumber ( proto ); EXTERN: int PASCAL getprotobyname ( *name ); : attribute ( c) drop ; \ change text colour - see help : counter ( -- ms ) gettickcount ; : expired ( ms -- t) counter - -86400000 1 within ; : ms ( n -- ) ?dup if counter + begin pause 1 sleep dup expired until drop then ; \ counted string to single integer : number ( a n - n) >r 0 0 rot r> >number 2drop drop ; : append ( from len to -- ) 2dup 2>r count + swap move 2r> c+! ; create CRLF$ 02 c, $0D c, $0A c, 0 c, [then] \ ***************************************************************************** \ The Windows Sockets API functions - SwiftForth dialect \ http://www.forth.com/swiftforth/trial-system.html \ ***************************************************************************** [defined] LIBRARY [if] \ SwiftForth LIBRARY WSOCK32.DLL OPENDLLS create CRLF$ 02 c, $0D c, $0A c, 0 c, [then] \ ***************************************************************************** \ The Windows Sockets API functions - Win32Forth V6.12 dialect \ ***************************************************************************** [defined] winlibrary [if] \ WIN32FORTH winlibrary wsock32.dll \ Import WinSock2 Dll : import: ( c - ) \ \in-system-ok >IN @ >r dup proc r> >IN ! \ make sure proc exists before doing create create winproc-last @ proc>cfa , , \ cfa then number of arguments for this proceedure does> dup>r cell+ @ S-REVERSE \ reverse the stack arguments r> perform ; : buffer: dup create here swap allot swap erase ; warning off \ counted string to single integer : number ( a n - n) >r 0 0 rot r> >number 2drop drop ; warning on : attribute ( n) drop ; : pause WINPAUSE ; : counter ( - n) ms@ ; : expired ( ms -- t) counter - -86400000 1 within ; : append ( a n a) +place ; [then] [defined] LIBRARY [defined] winlibrary or [if] \ SwiftForth or Win32Forth 2 import: WSAStartup ( wVersionRequired, lpWSAData -- int ) 0 import: WSACleanup ( -- int ) 1 import: WSASetLastError ( iError -- void ) 0 import: WSAGetLastError ( -- int ) 0 import: WSAIsBlocking ( -- BOOL ) 0 import: WSAUnhookBlockingHook ( -- int ) 1 import: WSASetBlockingHook ( lpBlockFunc -- FARPROC ) 0 import: WSACancelBlockingCall ( -- int ) 6 import: WSAAsyncGetServByName ( hWnd, wMsg, *name, *proto, *buf, buflen -- HANDLE ) 6 import: WSAAsyncGetServByPort ( hWnd, wMsg, port, *proto, *buf, buflen -- HANDLE ) 5 import: WSAAsyncGetProtoByName ( hWnd, wMsg, *name, *buf, buflen -- HANDLE ) 5 import: WSAAsyncGetProtoByNumber ( hWnd, wMsg, number, *buf, buflen -- HANDLE ) 5 import: WSAAsyncGetHostByName ( hWnd, wMsg, *name, *buf, buflen -- HANDLE ) 7 import: WSAAsyncGetHostByAddr ( hWnd, wMsg, *addr, len, type, *buf, buflen -- HANDLE ) 1 import: WSACancelAsyncRequest ( hAsyncTaskHandle -- int ) 4 import: WSAAsyncSelect ( s, hWnd, wMsg, lEvent -- int ) 4 import: WSARecvEx ( s, *buf, len, *flags -- int ) \ 3 import: accept ( s 'sock 'len -- SOCKET ) 3 import: bind ( s 'sock namelen -- int ) 1 import: closesocket ( s -- int ) 3 import: connect ( s 'sock len -- int ) 3 import: ioctlsocket ( s cmd, *argp -- int ) 3 import: getpeername ( s sockaddr, *namelen -- int ) 3 import: getsockname ( s sockaddr, *namelen -- int ) 5 import: getsockopt ( s level, optname, *optval, *optlen -- int ) 1 import: htonl ( hostlong -- u_long ) 1 import: htons ( hostshort -- u_short ) 1 import: inet_addr ( *cp -- in_addr ) 1 import: inet_ntoa ( in_addr -- *char ) 2 import: listen ( s backlog -- int ) 1 import: ntohl ( netlong -- u_long ) 1 import: ntohs ( netshort -- u_short ) 4 import: recv ( s *buf, len, flags -- int ) 6 import: recvfrom ( s *buf, len, flags, *from, *fromlen -- int ) 5 import: select ( nfds, *readfds, *writefds, *exceptfds, *timeout -- int ) 4 import: send ( s *buf, len, flags -- int ) 6 import: sendto ( s *buf, len, flags, *to, tolen -- int ) 5 import: setsockopt ( s level, optname, *optval, optlen -- int ) 2 import: shutdown ( s how -- int ) 3 import: socket ( af, type, protocol -- SOCKET ) 3 import: gethostbyaddr ( *addr, len, type -- hostent ) 1 import: gethostbyname ( *name -- hostent ) 2 import: gethostname ( *name, namelen -- int ) 2 import: getservbyport ( port, *proto -- servent ) 2 import: getservbyname ( *name, *proto -- servent ) 1 import: getprotobynumber ( proto -- servent ) 1 import: getprotobyname ( *name -- servent ) [then] \ ***************************************************************************** \ Some Windows Sockets API constants \ ***************************************************************************** $4004667F constant FIONREAD $8004667E constant FIONBIO $8004667D constant FIOASYNC $8905 constant SIOCATMARK decimal \ well-known ports. Note : htons adjusts Big/Little Endianness 13 htons constant DAYTIME_PORT 17 htons constant QOTD_PORT 23 htons constant TELNET_PORT 43 htons constant WHOIS_PORT 25 htons constant SMTP_PORT 80 htons constant HTTP_PORT 110 htons constant POP3_PORT 119 htons constant NNTP_PORT 123 htons constant NTP_PORT \ socket types 1 constant SOCK_STREAM \ Provides sequenced, reliable, two-way, connection-based byte streams with an OOB data transmission mechanism. Uses the Transmission Control Protocol (TCP) for the Internet address family (AF_INET or AF_INET6). 2 constant SOCK_DGRAM \ Supports datagrams, which are connectionless, unreliable buffers of a fixed (typically small) maximum length. Uses the User Datagram Protocol (UDP) for the Internet address family (AF_INET or AF_INET6). 3 constant SOCK_RAW \ Provides a raw socket that allows an application to manipulate the next upper-layer protocol header. To manipulate the IPv4 header, the IP_HDRINCL socket option must be set on the socket. 4 constant SOCK_RDM \ Provides a reliable message datagram. An example of this type is the Pragmatic General Multicast (PGM) multicast protocol implementation in Windows, often referred to as reliable multicast programming. 5 constant SOCK_SEQPACKET \ Provides a pseudo-stream packet based on datagrams. \ protocol types 06 constant IPPROTO_TCP \ The Transmission Control Protocol (TCP). \ This is a possible value when the ai_family member is AF_INET or AF_INET6 and the \ ai_socktype member is SOCK_STREAM. 17 constant IPPROTO_UDP \ The User Datagram Protocol (UDP). \ This is a possible value when the ai_family member is AF_INET or AF_INET6 and the \ type parameter is SOCK_DGRAM. 113 constant IPPROTO_RM \ The PGM protocol for reliable multicast. \ This is a possible value when the ai_family member is AF_INET and the \ ai_socktype member is SOCK_RDM. \ Internet family 2 constant AF_INET \ IP version 4 ( 32 bit IP addresses ) 2 constant PF_INET \ returned error codes -1 constant INVALID_SOCKET -1 constant SOCKET_ERROR \ ***************************************************************************** \ Display the Windows Sockets API data structure and error codes \ ***************************************************************************** 8 256 1+ + 128 1+ + 8 + constant |WSAdata| \ size of the WSA data structure |WSAdata| buffer: WSAdata \ the WSA data structure 0 WSAdata ! \ erase the versions to mark WSA as not yet started : .WinVer ( w) 256 /mod 2 u.r ." ." . ; : .WSAdata cr ." WSA startup information " cr ." Versions lo,hi : " WSAdata w@ .WinVer ." ," WSAdata 2 + w@ .WinVer cr ." Description : " WSAdata 4 + zcount 3 spaces 256 min type cr ." System status : " WSAdata 4 + 257 + zcount 128 min type cr ; \ display the WSA error value \ see http://msdn2.microsoft.com/en-us/library/ms740668.aspx : .WSAerror ( u) dup . case 10014 of ." WSAEFAULT : Invalid pointer address" endof 10022 of ." WSAEINVAL : Invalid argument" endof 10035 of ." WSAEWOULDBLOCK : Waiting for data ( not an error at all )" endof 10036 of ." WSAEINPROGRESS : A blocking operation is currently executing" endof 10038 of ." WSAENOTSOCK : Not a socket" endof 10045 of ." WSAEOPNOTSUPP : Not supported (can't connect to a UDP socket)" endof 10047 of ." WSAEAFNOSUPPORT : Incompatible address" endof 10048 of ." WSAEADDRINUSE : Socket already in use" endof 10049 of ." WSAEADDRNOTAVAIL : Invalid IP address" endof 10050 of ." WSAENETDOWN : Network is down" endof 10051 of ." WSAENETUNREACH : Network is unreachable" endof 10052 of ." WSAENETRESET : Network dropped connection on reset" endof 10053 of ." WSAECONNABORTED : Software caused connection abort (maybe timed out)" endof 10054 of ." WSAECONNRESET : Connection reset by server" endof 10055 of ." WSAENOBUFS : Insufficient buffer space" endof 10056 of ." WSAEISCONN : Already connected" endof 10057 of ." WSAENOTCONN : Not connected" endof 10060 of ." WSAETIMEDOUT : Connection attempt timed out" endof 10061 of ." WSAECONNREFUSED : Connection refused (server not running on given port)" endof 10067 of ." WSAEPROCLIM : Too many tasks running" endof 10091 of ." WSASYSNOTREADY : Network subsystem is unavailable" endof 10092 of ." WSAVERNOTSUPPORTED : Winsock.dll version out of range" endof 10093 of ." WSANOTINITIALISED : WSA not initialised " endof 11001 of ." WSAHOST_NOT_FOUND : Host not found" endof 11004 of ." WSANO_DATA : Valid name, no data record of requested type (DNS can't find name)" endof ." Unknown WSA error = " dup . endcase space ; \ display the WSA error if there is one \ note the special case for WSAEWOULDBLOCK - see Windows Sockets API docs ... : WSAerror ( u) SOCKET_ERROR = if WSAGetLastError dup 10035 = \ this is not an error, so don't 'throw' if drop \ we are just waiting for data... else 2 attribute cr dup .WSAerror 0 attribute throw then then ; \ ***************************************************************************** \ The socket address structure \ 1. The Windows socket function returns a socket handle \ 2. The socket_addr structure holds port and IP address info etc \ I have combined these by adding the socket handle to the end of the \ socket_addr structure. \ A number of sockets are defined here, the current one is selected by >Socket \ ***************************************************************************** 16 constant |socket_addr| \ size of the socket_addr structure used by Windows 20 constant |socket| \ the size of our socket structure \ #USER |socket| +USER socket_addr to #USER |socket| buffer: socket_addr \ the Windows Sockets API socket address structure, plus our extra field : sin_family ( - a) socket_addr ; : sin_port ( - a) socket_addr 2 + ; : sin_address ( - a) socket_addr 4 + ; : sin_zero ( - a) socket_addr 8 + ; : socket_handle ( - a) socket_addr 16 + ; : InitSocket socket_addr |socket| erase ; \ ***************************************************************************** \ Startup and close down the Windows Sockets API \ ***************************************************************************** \ Close down the Windows Sockets API : SktCleanup WSAdata @ if 0 WSAdata ! WSACleanup WSAerror then ; \ WSAstartup must be called first. Note that it returns 0 if OK, not an ior. : (SktStartup) ( -- ) ( Windows requires this version : ) $101 WSAdata WSAStartup ?dup if cr ." WSAStartup failed!" SktCleanup abort then \ .WSAdata \ enable this if you want to see the socket structure info InitSocket \ initialise the socket data structures ; \ Startup WSA if not already started : SktStartup WSAdata @ 0= if (SktStartup) then ; \ ***************************************************************************** \ IP address display \ ***************************************************************************** \ convert an 8 bit value into a string in the "hold" buffer : #ip ( du -- 0 ) #s [char] . hold 2drop 0 ; \ convert a network order IP address into its www.xxx.yyy.zzz form : (.ip) ( ip -- addr u ) base @ >r decimal 0 256 um/mod 0 256 um/mod 0 256 um/mod 0 <# #ip #ip #ip #s #> r> base ! ; \ display an IP address : .ip ( u) (.ip) type ; : .Socket ( -- ) cr ." sin_family = " sin_family w@ htons . cr ." sin_port = " sin_port w@ htons . cr ." sin_address = " sin_address @ .ip \ cr ." sin_zero = " r@ sin_zero 8 dump cr ." socket_handle = " socket_handle @ . ; \ convert an IP address string into its 32 bit network order value : ip= ( -- ip) \ "aaa.bbb.ccc.ddd " -- u [char] . word count evaluate 255 and [char] . word count evaluate 255 and 8 lshift or [char] . word count evaluate 255 and 16 lshift or bl word count evaluate 255 and 24 lshift or ; variable ip_default ip= 192.168.1.101 ip_default ! : tt. .Socket ; \ ***************************************************************************** \ Create a socket, and write to it \ ***************************************************************************** \ close the socket ( ask Windows to discard the socket structure ) : SktClose ( -- ) socket_handle @ if socket_handle @ 0 socket_handle ! closesocket WSAerror then ; \ Ask Windows to create a socket structure with the given protocol : SktCreate ( protocol) SktStartup \ make sure we have already started the WSA SktClose \ close the socket if it has been opened IPPROTO_TCP = if \ TCP AF_INET SOCK_STREAM IPPROTO_TCP else \ UDP AF_INET SOCK_DGRAM IPPROTO_UDP then socket dup WSAerror socket_handle ! ; \ create a socket if needed and setup the IP address and port : SktSetup ( IP port protocol) SktCreate socket_addr |socket_addr| erase \ clean it up AF_INET sin_family w! sin_port w! sin_address ! 0 0 sin_zero 2! ; \ connect to an IP address and port, creating a socket if needed : SktConnect ( IP port) IPPROTO_TCP SktSetup socket_handle @ socket_addr |socket_addr| connect WSAerror ; : +emit ( c) dup 10 = over 13 = or if 10 = if 4 emit cr else 5 emit then else emit then ; : +type ( a n) over + swap ?do i c@ +emit loop ; : ++type ( a n) 4 attribute over + swap ?do i c@ +emit loop 0 attribute ; \ send u bytes from address a to the socket : SktWrite ( addr u) socket_handle @ rot rot 0 send WSAerror ; \ send u bytes from address a to the socket, followed by CRLF : SktCR CRLF$ count SktWrite ; \ send u bytes from address a to the socket, followed by CRLF : SktWriteCR ( addr u) SktWrite SktCR ; \ ***************************************************************************** \ Display what we receive \ ***************************************************************************** $100 constant |MyRecv| \ the size of our receive buffer |MyRecv| Buffer: MyRecv \ our receive buffer variable #MyRecv \ stores the number of bytes available from the socket \ returns the number of bytes available from the socket : NumBytes ( -- u) 0 #MyRecv ! socket_handle @ FIONREAD #MyRecv ioctlsocket WSAerror #MyRecv @ ; \ read from the socket into the MyRecv buffer, u is the number of bytes read : SktRead ( -- u) NumBytes 0= if 0 exit then \ blocking socket, so check first socket_handle @ MyRecv |MyRecv| 0 recv dup WSAerror \ dup if cr ." SktRead >>> " cr then ; \ Socket Read buffer 1024 constant |SktReadBuffer| \ must be a power of 2 |SktReadBuffer| buffer: SktReadBuffer variable >SktReadIn variable >SktReadOut : SktKey# ( - n) >SktReadIn @ >SktReadOut @ - |SktReadBuffer| 1- and ; : SktPutKey ( c) SktReadBuffer >SktReadIn @ + c! >SktReadIn @ 1+ |SktReadBuffer| 1- and >SktReadIn ! ; : SktGetKey ( - c) SktReadBuffer >SktReadOut @ + c@ >SktReadOut @ 1+ |SktReadBuffer| 1- and >SktReadOut ! ; : SktRefill SktRead ?dup if MyRecv + MyRecv do i c@ SktPutKey loop then ; \ Get a character from the input circular buffer, or if empty from the socket. \ If neither, wait for data to come in \ Use this one for raw content data : SktKey ( - c) begin pause SktKey# 0= while SktRefill repeat SktGetKey ; \ Convert all control characters except LF to spaces \ Only use this one for header data : SktKey+ ( - c) SktKey dup 10 = if exit \ return a LF then 32 max ; \ This is only required when the connection has been closed by the server \ without telling us how many bytes to expect. : ms-ShowRemaining ( n) \ from socket for n ms 5 attribute counter + cr begin pause SktKey# if SktKey +emit else SktRefill then dup EXPIRED until drop 0 attribute ; $100 constant |SktLineBuffer| \ must be a power of 2 |SktLineBuffer| buffer: SktLineBuffer variable >SktLineBuffer : \SktLineBuffer 0 >SktLineBuffer ! ; : SktLinePutKey ( c) SktLineBuffer >SktLineBuffer @ + c! >SktLineBuffer @ 1+ |SktLineBuffer| 1- min >SktLineBuffer ! ; : SkipToEndOfLine begin SktKey 10 = until ; \ Get a complete line of printable ASCII from the socket \ The line is terminated by a LF : SktLine ( - a n) 0 >SktLineBuffer ! begin SktKey+ dup 10 = not while SktLinePutKey repeat drop SktLineBuffer >SktLineBuffer @ ; \ ***************************************************************************** \ Response header \ ***************************************************************************** \ a ';' character indicates a comment, so ignore to the end of the line : RemoveComments ( a n - a n') 2dup 0 do dup c@ [char] ; = if swap drop i swap \ adjust the count leave then 1+ loop drop ; \ : ttrc s" hello;world" RemoveComments cr type ; \ types 'hello' \ : ttrc2 s" hello;" RemoveComments cr type ; \ types 'hello' \ display the HTTP header from the server, stop when an empty line is received : HTTP-Header begin SktLine RemoveComments dup 1 > while \ an empty line may have had an extra space added from the CR evaluate \ take any necessary action repeat 2drop ; \ ***************************************************************************** \ Name and IP address lookup \ Note that these two functions are deprecated in favour of getnameinfo \ and getaddrinfo \ ***************************************************************************** \ get the IP address of the given host name : SktGetHostIP ( z" -- IP ) SktStartup gethostbyname dup 0= if drop cr WSAGetLastError dup .WSAerror throw then 3 cells + @ @ @ ; \ returns the name string corresponding to the IP address given : SktGetHostName ( IP -- z" ) SktStartup >r rp@ 4 AF_INET gethostbyaddr r> drop dup 0= if drop cr WSAGetLastError dup .WSAerror throw then @ ; : ttnm cr z" www.inventio.co.uk" dup zcount type SktGetHostIP dup cr .IP SktGetHostName zcount cr type ; \ ToDo: 0 [if] if(getnameinfo((LPSOCKADDR)&stDestAddr, sizeof(stDestAddr), strURL, sizeof(strURL), NULL, 0, NI_NAMEREQD) != 0) { szURL = "not found"; ] else { // we've resolved the name. Pass it back szURL = strURL; ] [then] \ ***************************************************************************** \ Client terminal \ ***************************************************************************** \ choose the colour depending on the first character of the line : +OK or -ERR : SetAttribute MyRecv c@ [char] - = if 2 else 3 then attribute ; \ read and display one line from the socket : SktReadLine SktRead ?dup if SetAttribute cr MyRecv swap +type 0 attribute then ; \ ***************************************************************************** \ Send what we type \ ***************************************************************************** $200 constant |MySend| \ the size of our send buffer |MySend| Buffer: MySend \ our send buffer variable #MySend \ how many bytes to send so far \ accumulate characters, act on Backspace, ctrlC, Escape and Enter \ Note the SktWriteCR which does all of the work when you press Enter : Nemit ( c) dup $0D = if #MySend @ if MySend #MySend @ SktWriteCR 0 #MySend ! then drop exit then dup $08 = if 08 emit bl emit 08 emit #MySend @ 1- 0 max #MySend ! drop exit then dup $1B = if cr ." Done." 1000 throw then dup $03 = if cr ." ctrlC" 1001 throw then dup emit MySend #MySend @ + c! \ store the character in the send buffer 1 #MySend +! \ increment the count ; : InitNemit 0 #MySend ! ; \ ***************************************************************************** \ The client \ ***************************************************************************** \ the inner loop of client \ Note the occasional ( 32 counts at 18.2 Hz ) SktWrite to test if \ the connection is still OK. \ If you don't do this, the server can reset the connection and \ you just sit there... \ Please let me know if you know of another way of doing this. \ Note : you cannot do this on an HTTP server - it closes the connection : (Client) ( IPaddress port ) swap SktGetHostIP swap SktConnect InitNemit \ nothing to send yet begin 10 ms \ allow the rest of Windows to have a turn key? if key Nemit then \ accumulate key presses, send on SktReadLine \ counter $1F and 0= if SktCR then \ poll for connection reset again ; \ A simple client terminal. \ When you have connected to the email server, type HELP for a list of commands, then \ user howerd.oakford \ change for your user name \ pass xxxxxxxxxx \ change for your password \ list \ list the emails \ top 1 10 \ show the top 10 lines of message 1 \ Note : server replies are in blue if OK or red for errors. : Client cr cr ." Client TCP terminal. Press Esc to exit... " z" pop.ntlworld.com" POP3_PORT \ z" mail.freenetname.co.uk" POP3_PORT \ z" time.nist.gov" DAYTIME_PORT \ z" pop.wxs.com" POP3_PORT \ z" www.inventio.co.uk" HTTP_PORT \ see HTTP section for this port \ z" pop.ntlworld.com" QOTD_PORT \ z" www.inventio.co.uk" WHOIS_PORT \ z" qotd.???.???" QOTD_PORT cr ." Connect to : " >r dup zcount type r> ['] (client) catch \ the main loop dup case 1000 of drop 2drop cr ." User pressed the Escape key" endof 1001 of drop 2drop cr ." ctrlC pressed - socket left open for test " exit endof drop 2drop endcase cr ." Closing socket and cleaning up..." cr SktClose \ close down the socket SktCleanup \ clean up the WSA system ; \ Some short test words : : ttx SktClose ; : ttc z" pop.ntlworld.com" SktGetHostIP POP3_PORT SktConnect ; : ttr cr ." recv# = " SktRead dup . MyRecv swap type ; \ ***************************************************************************** \ HTTP responses \ These commands are EVALUATEd \ If we want to process a given field we define its name here, if it has \ a value that we want we parse it, otherwise just display it using RestOfLine \ ***************************************************************************** \ Information about the HTTP request and response : variable HeadOnly \ true if we requested the HEAD only variable ResponseCode \ the 200 or 404 response code, in case we need to use it variable HTTPversion \ the version returned by the server, should be what we asked for variable ContentLength \ the size of the content data, in non-chunked mode create ContentType 33 allot \ the Content-Type: string saved in case we need it variable Chunked? \ content data can be in chunked or ContentLength mode variable ConnectionClosed \ by the server create Etag 33 allot \ the Etag, a secure hash of the file : InitVariables 0 HeadOnly ! \ head only not specifed yet 0 ResponseCode ! \ start off with no response code 0 HTTPversion ! \ no HTTP version received yet 0 ContentLength ! \ reset the count, in case we don't receive one 0 ContentType c! \ no content type received yet 0 Chunked? ! \ start off not in Chunked mode 0 ConnectionClosed ! \ connection is not yet closed by the server 0 Etag c! \ no Etag received yet ; \ Test words : : .hex ( u c) base @ >r hex u.r r> base ! ; : .SktData ( n) 0 ?do SktKey 3 .hex loop ; : SkipRestOfLine \ ignore until the end of the evaluate buffer - like \ #TIB @ >IN ! ; : RestOfLine \ just display the rest of the line TIB >IN @ + #TIB @ >IN @ - 0 MAX dup if 3 attribute space type 0 attribute else 2drop then SkipRestOfLine ; 0 [if] \ Note : this is not required - the hex chunk count is picked up from the \ socket stream, not from the evaluated line : GetHexNumber base @ >r hex bl word count number r> base ! ; [then] \ Convert CR , LF amd TABs to spaces so that number does not throw : MakeSafeForNumber ( a n - a n) 2dup over + swap do i c@ 32 max i c! loop ; : GetDecNumber base @ >r decimal bl word count MakeSafeForNumber -trailing ['] number catch if cr ." Number!!!" 1003 throw then r> base ! ; : HTTP/x.x GetDecNumber ResponseCode ! 7 attribute ResponseCode @ 5 u.r space 0 attribute RestOfLine ; : HTTP/1.1 cr ." HTTP/1.1" HTTP/x.x 11 HTTPversion ! ; : HTTP/1.0 cr ." HTTP/1.0" HTTP/1.1 10 HTTPversion ! ; : Date: cr ." Date:" RestOfLine ; : Server: cr ." Server:" >IN @ >r [char] / word r> >IN ! RestOfLine count s" Apache" compare 0= if 7 attribute ." Open Source" 0 attribute then ; : Vary: cr ." Vary:" RestOfLine ; : Last-Modified: cr ." Last-Modified:" RestOfLine ; : ETag: cr ." ETag:" [char] " word count Etag place 7 attribute space Etag count type 0 attribute RestOfLine ; : Accept-Ranges: cr ." Accept-Ranges:" RestOfLine ; : Allow: cr ." Allow:" RestOfLine ; : Connection: cr ." Connection:" 0 ConnectionClosed ! ; : close 7 attribute ." close" -1 ConnectionClosed ! 0 attribute RestOfLine ; : X-Powered-By: cr ." X-Powered-By:" RestOfLine ; : Cache-Control: cr ." Cache-Control:" RestOfLine ; : Expires: cr ." Expires:" RestOfLine ; : Transfer-Encoding: cr ." Transfer-Encoding:" 0 Chunked? ! ; : chunked 7 attribute ." chunked" -1 Chunked? ! 0 attribute ; \ HTTP version 1.0 just specified a number of bytes of data : Content-Length: cr ." Content-Length:" GetDecNumber ContentLength ! RestOfLine 7 attribute ContentLength @ 5 u.r 0 attribute ; : Content-Type: cr ." Content-Type:" bl word count 0 max 32 min ContentType place 7 attribute space ContentType count type 0 attribute RestOfLine ; \ ***************************************************************************** \ Chunked data \ ***************************************************************************** \ convert a single digit 0 to 9 and A to F ( or a to f ) to its hexadecimal value : ASCII->hex ( c - c') dup [char] 9 > if 7 - then [char] 0 - $0F and ; \ HTTP version 1.1 added "chunked data mode" where pairs of number of bytes followed by \ the data are sent, terminated by a number of bytes of 0 : GetChunkLength ( - u) 0 begin SktKey dup [char] 0 < not while swap 4 lshift swap ASCII->hex or repeat drop SkipToEndOfLine ; : GetChunkData ( u) cr 0 ?dup do SktKey +emit loop \ <<<--- you can do something with this data SkipToEndOfLine ; : GetChunks begin GetChunkLength 0 attribute cr ." ChunkLength = " dup 5 u.r 5 attribute dup while GetChunkData repeat drop SkipToEndOfLine \ discard the terminating CRLF or LF 0 Chunked? ! \ no longer in Chunked mode ; \ ***************************************************************************** \ Response content \ ***************************************************************************** : GetContent \ display the content of the response 5 attribute \ show content data in pink Chunked? @ if \ chunked data mode GetChunks else \ ContentLength mode cr ContentLength @ 0 ?do SktKey +emit loop \ <<<--- you can do something with this data then 0 attribute \ back to black ( Amy Winehouse? ) ; \ display the HTTP content from the server \ This can be either ContentLength bytes or chunked data, \ or if the socket is closed by the server, an unknown length : HTTP-Content HeadOnly @ 0= if \ if we requested HEAD only, there is no content GetContent then ; \ ***************************************************************************** \ HTTP requests \ ***************************************************************************** 256 constant |MyHostName| |MyHostName| buffer: MyHostName 1024 buffer: MyHTTPstring : SetupHost ( a n - IP ) \ specify the host name that we want to connect to MyHostName |MyHostName| erase \ for null-terminated string ( a n) MyHostName place MyHostName count drop SktGetHostIP \ get IP address from null terminated host name ; 0 value BreakMe \ set to true to break the HTTP header that we send \ send an HTTP request \ Note that the host name is used to open a socket and as part o the HTTP/1.1 request : (HTTP) ( a1 n1 a2 n2 a3 n3) \ s" filename" s" www.host.com" s" GET" (HTTP) 2swap ( a2 n2) SetupHost HTTP_PORT SktConnect ( a3 n3) 2dup s" HEAD" compare 0= HeadOnly ! \ no content data will be returned ( command) MyHTTPstring place s" /" MyHTTPstring append ( a1 n1) ( filename) MyHTTPstring append BreakMe if s" HTTP/1.x " MyHTTPstring append else s" HTTP/1.1 " MyHTTPstring append then CRLF$ count MyHTTPstring append s" Host: " MyHTTPstring append MyHostName count MyHTTPstring append CRLF$ count MyHTTPstring append CRLF$ count MyHTTPstring append \ blank line marks end or request cr ." ======= Start of request =======" MyHTTPstring count cr 2dup ++type \ display what we send to the socket SktWrite \ write the HTTP request to the socket cr ." ------- Start of response header -------" HTTP-Header \ display the header cr ." ------- Start of response content -------" HTTP-Content \ display the content ; : HTTP ( a1 n1 a2 n2 a3 n3) \ s" filename" s" www.host.com" s" GET" HTTP InitVariables \ make sure we start of in a known state ['] (HTTP) catch ?dup if case 1002 of cr ." Could not read from socket" endof 1003 of cr ." could not evaluate a number " endof cr ." Caught throw # " . endcase 2drop 2drop 2drop then \ catch any errors 0 attribute cr ." ======= End of request and response =======" ConnectionClosed @ if 500 ms-ShowRemaining \ dump out anything left from the socket 0 attribute cr ." Note : connection was closed by the server" cr else 100 ms-ShowRemaining \ dump out anything left from the socket then SktClose \ close down the socket SktCleanup \ clean up the WSA system ; \ The GET request returns an HTTP header and then the file : HTTP-GET ( a1 n1 a2 n2) s" GET" HTTP ; \ filename \ The HEAD request only returns the HTTP header : HTTP-HEAD ( a1 n1 a2 n2) s" HEAD" HTTP ; \ filename \ The OPTIONS request returns the requests available on this HTTP server : HTTP-OPTIONS 0 0 2swap s" OPTIONS" HTTP ; \ The TRACE request returns the data just sent to the HTTP server : HTTP-TRACE s" TRACE" HTTP ; : .Title 1 attribute cr cr type 0 attribute ; : tt1 s" tt1 200 OK - normal working GET" .Title s" mytest.htm" s" www.inventio.co.uk" HTTP-GET ; : tt2 s" tt2 404 Not Found - the famous 404, in chunked mode" .Title s" NotAfile.htm" s" www.inventio.co.uk" HTTP-GET ; : tt3 s" tt3 200 OK - just the HEAD" .Title s" mytest.htm" s" www.inventio.co.uk" HTTP-HEAD ; : tt4 s" tt4 200 OK - another file, this time a jpg" .Title s" IMAGE001.JPG" s" www.inventio.co.uk" HTTP-GET ; : tt5 s" tt5 200 - try a PHP file" .Title s" index.php" s" www.google.co.uk" HTTP-GET ; : tt6 s" tt6 200 OK - TRACE" .Title s" mytest.htm" s" www.inventio.co.uk" HTTP-TRACE ; : tt7 s" tt7 400 Bad Request - send an invalid HTTP version" .Title -1 to BreakMe s" mytest.htm" s" www.inventio.co.uk" HTTP-GET 0 to BreakMe ; : tt8 s" tt8 400 Bad Request - send an invalid HTTP version #2 " .Title -1 to BreakMe s" mytest.htm" s" www.google.co.uk" HTTP-GET 0 to BreakMe ; : tt9 s" tt9 200 OK - normal working GET" .Title s" /icfp08-contest/simulator.html" s" smlnj.org" HTTP-GET ; : tt10 s" tt10 400 Bad Request - send an invalid HTTP version #2 " .Title -1 to BreakMe s" /icfp08-contest/simulator.html" s" smlnj.org" HTTP-TRACE 0 to BreakMe ; : help 0 attribute cr WSAver ." Help text " 1 attribute cr ." Inverse - Title of test" 0 attribute cr ." Black - text we display, for information only" 2 attribute cr ." Red - errors" 3 attribute cr ." Blue - part of the line that we don't evaluate, just display" 4 attribute cr ." Cyan - the characters we send to the socket" 5 attribute cr ." Magenta - the data content we get from the socket" 7 attribute cr ." Green - data parsed from the evaluated input line" 0 attribute cr ." An ASCII linefeed character ( decimal 10 ) is shown as a " 4 emit cr ." An ASCII carriage return character ( decimal 13 ) is shown as a " 5 emit cr ." on output, and is ignored when received from the socket in a header line" cr ." Type locate ttall g to see the code" cr ." Type " 4 attribute ." ttall" 0 attribute ." to run the HTTP tests, " cr ." or " 4 attribute ." Client" 0 attribute ." to run a POP3 email reader." ; : ttall tt1 tt2 tt3 tt4 tt5 tt6 tt7 \ tt8 help ; help 0 [if] \ Some unfinished code for later.... \ ***************************************************************************** \ UDP terminal ToDo: \ ***************************************************************************** variable vMyVar \ used by NonBlocking \ makes the socket non-blocking. \ This means that the call to recv in SktRead will return even if there \ are no bytes available. : NonBlocking 1 vMyVar ! socket_handle @ FIONBIO vMyVar ioctlsocket WSAerror ; : SktBind ( IP port protocol) SktClose \ you cannot bind an already bound socket... SktSetup NonBlocking \ make the socket non-blocking \ tt. socket_handle @ socket_addr |socket_addr| bind WSAerror ; \ : SktListen socket_handle @ 5 listen WSAerror ; variable len : SktReadFrom ( - u) socket_handle @ 0= if cr ." No socket!" 0 1002 throw then socket_handle @ MyRecv |MyRecv| 0 socket_addr |socket_addr| len ! len recvfrom dup WSAerror dup -1 = if drop 0 then \ replace a -1 flag (no data) by a count of 0 bytes ; \ send a UDP packet to the IP address and port specified by socket_addr : SktSendTo ( a u) socket_handle @ rot rot 0 socket_addr |socket_addr| sendto dup WSAerror ; \ accumulate characters, act on Backspace, ctrlC, Escape and Enter \ Note the SktWriteCR which does all of the work when you press Enter : Uemit ( c) dup $0D = if MySend #MySend @ SktSendTo 0 #MySend ! drop cr exit then dup $08 = if 08 emit bl emit 08 emit #MySend @ 1- 0 max #MySend ! drop exit then dup $1B = if cr ." Done." 1000 throw then dup $03 = if cr ." ctrlC" 1001 throw then dup emit MySend #MySend @ + c! \ store the character in the send buffer 1 #MySend +! \ increment the count ; 0 [if] : UDPC 0 Skt 0 POP3_PORT IPPROTO_UDP SktBind 1 Skt ip_default @ POP3_PORT IPPROTO_UDP SktSetup 0 Skt begin 10 ms SktReadFrom ?dup if cr MyRecv swap 0 max 100 min type then key? if 1 Skt key Uemit 0 Skt then \ accumulate key presses, send on again ; [then] : UDP 1 Skt ip_default @ POP3_PORT IPPROTO_UDP SktSetup SktSendTo 0 Skt ; : ttu s" hello www!" ip_default @ POP3_PORT UDP ; \ the inner loop of ttudp : (ttudp) ( IP port ) 0 Skt 2drop ip_default @ POP3_PORT IPPROTO_UDP SktSetup InitNemit \ nothing to send yet begin 10 ms \ allow the rest of Windows to have a turn SktReadFrom ?dup if cr MyRecv swap 0 max 512 min type then key? if key Nemit then \ accumulate key presses, send on again ; \ A simple UDP terminal. : ttudp cr cr ." A simple UDP terminal. Press Esc to exit... " SktStartup \ startup the WSA system z" pop.ntlworld.com" POP3_PORT \ z" time.nist.gov" DAYTIME_PORT \ z" pop.wxs.com" POP3_PORT \ z" www.inventio.co.uk" HTTP_PORT \ z" pop.ntlworld.com" QOTD_PORT \ z" ???.???.???" WHOIS_PORT \ z" qotd.???.???" QOTD_PORT ['] (ttudp) catch \ the main loop dup case 1000 of drop 2drop cr ." User pressed the Escape key" endof 1001 of drop 2drop cr ." ctrlC pressed - socket left open for test " exit endof drop 2drop endcase cr ." Closing socket and cleaning up..." cr SktClose \ close down the socket SktCleanup \ clean up the WSA system ; cr cr .( Type client to start the simple client : ) cr } 0 [if] \\ { Broadcast and Multicast \ A crucial feature supported by UDP but not TCP is sending a single message to \ multiple destinations. UDP supports both broadcast and multicast communication. \ Broadcasting a packet makes it available within a subnet mask. \ Multicasting is subscription-based in the sense that listeners have to join a \ multicast group to receive messages sent to that group. \ A multicast group uses an IP address in the range of 224.0.0.0 through \ 239.255.255.255. \ To listen on a multicast group, you need to indicate that you want multicast \ messages from a specific multicast group by setting the add membership SocketOption \ after calling Bind, but before calling BeginReceiveFrom: IPAddress multicastGroup = IPAddress.Parse("239.255.255.19"); socket.Bind(...); socket.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.AddMembership, new MulticastOption(multicastGroup)); socket.BeginReceiveFrom(...); \ You do not need to set SocketOption in order to send to a multicast group, as \ shown here: const int ProtocolPort = 3001; Socket sendSocket = new Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp); EndPoint sendEndPoint = new IPEndPoint(multicastGroup, ProtocolPort); sendSocket.SendTo(buffer, bufferUsed, SocketFlags.None, sendEndPoint); } { int netOpenUdpSocket(port_t port){ int sock; struct sockaddr_in name; int bindval; sock=socket(PF_INET,SOCK_DGRAM,0); if(sock>=0) { name.sin_family = AF_INET; name.sin_port = htons((ushort)port); name.sin_addr.s_addr = htonl(INADDR_ANY); bindval=bind(sock,(struct sockaddr*)&name,sizeof(name)); if(bindval>=0) { u_long val=1; os_ioctlsocket(sock,FIONBIO,&val); // make it nonblocking return sock; ] os_closesocket(sock); ] return -1; // error } \ : my-ip-addr 0 zGetHostIP drop ; $104 constant MAXSTRING create my-ip-addr-buf MAXSTRING allot 0 my-ip-addr-buf ! : my-ip-addr ( -- IP ) my-ip-addr-buf zGetHostIP drop ; : GetPeerName ( s -- addr u ior ) |socket_addr| >r rp@ socket_addr rot getpeername SOCKET_ERROR = if here 0 WSAGetLastError else socket_addr socket_addr @ GetHostName then r> drop ; CREATE SINLEN |socket_addr| , : SOCKET-ACCEPT ( ADDR ALEN FH -- s2 ior ) swap >r rp@ -rot accept dup WSAerror r> drop ; : CLIENT-OPEN ( addr u port -- s ) >r GetHostIP abort" Server not available " r> SktConnect ; 100 buffer: pop3-server$ : \pop3 s" pop.wxs.com" pop3-server$ place ; : get-pop3-server ( -- IP ior ) SktStartup pop3-server$ 1+ zGetHostIP ?dup if cr .WSAerror then ; \ \pop3 \ get-pop3-server .IP : init-pop3 ( - s ) pop3-server$ count POP3_PORT client-open ; \\ create my-ip-name cr my-ip-addr cr dup NtoA type GetHostName drop space type \ dup 1+ allot my-ip-name place \\ { typedef struct addrinfo { int ai_flags; int ai_family; int ai_socktype; int ai_protocol; size_t ai_addrlen; char* ai_canonname; struct sockaddr* ai_addr; struct addrinfo* ai_next; ] ADDRINFOA, *PADDRINFOA; int WSAAPI getaddrinfo( const char FAR* nodename, const char FAR* servname, const struct addrinfo FAR* hints, struct addrinfo FAR** res ); int WSAAPI getnameinfo( const struct sockaddr FAR* sa, socklen_t salen, char FAR* host, DWORD hostlen, char FAR* serv, DWORD servlen, int flags ); // Example code : //-------------------------------- // Declare and initialize variables. char* ip = "127.0.0.1"; char* port = "27015"; struct addrinfo aiHints; struct addrinfo *aiList = NULL; int retVal; //-------------------------------- // Setup the hints address info structure // which is passed to the getaddrinfo() function memset(&aiHints, 0, sizeof(aiHints)); aiHints.ai_family = AF_INET; aiHints.ai_socktype = SOCK_STREAM; aiHints.ai_protocol = IPPROTO_TCP; //-------------------------------- // Call getaddrinfo(). If the call succeeds, // the aiList variable will hold a linked list // of addrinfo structures containing response // information about the host if ((retVal = getaddrinfo(ip, port, &aiHints, &aiList)) != 0) { printf("getaddrinfo() failed.\n"); } \ Windows XP version : LIBRARY Ws2_32.dll OPENDLLS 4 import: getaddrinfo 7 import: getnameinfo #32 Buffer: aiHints #32 Buffer: IPaddress #32 Buffer: IPaddress variable aiList : SktGetAddrInfo AF_INET aiHints cell + ! SOCK_STREAM aiHints 2 cells + ! IPPROTO_TCP aiHints 3 cells + ! IPaddress IPaddress aiHints aiList getaddrinfo ?dup if dup .WSAerror throw then .... getnameinfo .... \ ToDo!!! ; : BindSocketInterface ( port ip s -- ior ) >R /sockaddr_in ALLOCATE ?DUP IF NIP R> DROP EXIT THEN SWAP >R >R 256 /MOD SWAP 256 * + R@ sin_port W! AF_INET R@ sin_family W! R@ R> R> SWAP >R R@ sin_addr ! /sockaddr_in R> R> bind SWAP FREE DROP SOCKET_ERROR = IF WSAGetLastError ELSE 0 THEN ; USER CONNECT-INTERFACE : ConnectSocket ( IP port socket -- ior ) CONNECT-INTERFACE @ ?DUP IF OVER 0 ROT ROT BindSocketInterface ?DUP IF NIP NIP NIP EXIT THEN THEN >R 256 /MOD SWAP 256 * + sock_addr sin_port W! sock_addr sin_addr ! /sockaddr_in sock_addr R> connect SOCKET_ERROR = IF WSAGetLastError ELSE 0 THEN ; #include #include "winsock2.h" void main() { //---------------------- // Initialize Winsock WSADATA wsaData; int iResult = WSAStartup(MAKEWORD(2,2), &wsaData); if (iResult != NO_ERROR) printf("Error at WSAStartup()\n"); //---------------------- // Create a SOCKET for listening for // incoming connection requests SOCKET ListenSocket; ListenSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); if (ListenSocket == INVALID_SOCKET) { printf("Error at socket(): %ld\n", WSAGetLastError()); WSACleanup(); return; } //---------------------- // The sockaddr_in structure specifies the address family, // IP address, and port for the socket that is being bound. sockaddr_in service; service.sin_family = AF_INET; service.sin_addr.s_addr = inet_addr("127.0.0.1"); service.sin_port = htons(27015); //---------------------- // Bind the socket. if (bind( ListenSocket, (SOCKADDR*) &service, sizeof(service)) == SOCKET_ERROR) { printf("bind() failed.\n"); closesocket(ListenSocket); return; } WSACleanup(); return; } #include #include "winsock2.h" void main() { //---------------------- // Initialize Winsock WSADATA wsaData; int iResult = WSAStartup(MAKEWORD(2,2), &wsaData); if (iResult != NO_ERROR) printf("Error at WSAStartup()\n"); //---------------------- // Create a SOCKET for listening for // incoming connection requests. SOCKET ListenSocket; ListenSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); if (ListenSocket == INVALID_SOCKET) { printf("Error at socket(): %ld\n", WSAGetLastError()); WSACleanup(); return; } //---------------------- // The sockaddr_in structure specifies the address family, // IP address, and port for the socket that is being bound. sockaddr_in service; service.sin_family = AF_INET; service.sin_addr.s_addr = inet_addr("127.0.0.1"); service.sin_port = htons(27015); if (bind( ListenSocket, (SOCKADDR*) &service, sizeof(service)) == SOCKET_ERROR) { printf("bind() failed.\n"); closesocket(ListenSocket); return; } //---------------------- // Listen for incoming connection requests // on the created socket if (listen( ListenSocket, 1 ) == SOCKET_ERROR) printf("Error listening on socket.\n"); printf("Listening on socket...\n"); WSACleanup(); return; } { Typically, only one usage of each socket address (protocol/IP address/port) is permitted. This error occurs if an application attempts to bind a socket to an IP address/port that has already been used for an existing socket, or a socket that was not closed properly, or one that is still in the process of closing. For server applications that need to bind multiple sockets to the same port number, consider using setsockopt (SO_REUSEADDR). Client applications usually need not call bind at all� connect chooses an unused port automatically. When bind is called with a wildcard address (involving ADDR_ANY), a WSAEADDRINUSE error could be delayed until the specific address is committed. This could happen with a call to another function later, including connect, listen, WSAConnect, or WSAJoinLeaf. } [then] [then]