geos_one/archie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
b2af3b41bd
archie/tcl7.6/win/tclWinSock.c
Mario Fetka b2af3b41bd Update tcl/tk for tcl-dp
2024-05-27 16:40:40 +02:00

1685 lines
48 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/*
* tclWinSock.c --
*
* This file contains Windows-specific socket related code.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclWinSock.c 1.50 96/10/03 15:01:29
*/
#include "tclInt.h"
#include "tclPort.h"
/*
* The following structure contains pointers to all of the WinSock API entry
* points used by Tcl. It is initialized by InitSockets. Since we
* dynamically load Winsock.dll on demand, we must use this function table
* to refer to functions in the socket API.
*/
static struct {
SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr,
int FAR *addrlen);
int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr,
int namelen);
int (PASCAL FAR *closesocket)(SOCKET s);
int (PASCAL FAR *connect)(SOCKET s, const struct sockaddr FAR *name,
int namelen);
int (PASCAL FAR *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp);
int (PASCAL FAR *getsockopt)(SOCKET s, int level, int optname,
char FAR * optval, int FAR *optlen);
u_short (PASCAL FAR *htons)(u_short hostshort);
unsigned long (PASCAL FAR *inet_addr)(const char FAR * cp);
char FAR * (PASCAL FAR *inet_ntoa)(struct in_addr in);
int (PASCAL FAR *listen)(SOCKET s, int backlog);
u_short (PASCAL FAR *ntohs)(u_short netshort);
int (PASCAL FAR *recv)(SOCKET s, char FAR * buf, int len, int flags);
int (PASCAL FAR *send)(SOCKET s, const char FAR * buf, int len, int flags);
int (PASCAL FAR *setsockopt)(SOCKET s, int level, int optname,
const char FAR * optval, int optlen);
int (PASCAL FAR *shutdown)(SOCKET s, int how);
SOCKET (PASCAL FAR *socket)(int af, int type, int protocol);
struct hostent FAR * (PASCAL FAR *gethostbyname)(const char FAR * name);
struct hostent FAR * (PASCAL FAR *gethostbyaddr)(const char FAR *addr,
int addrlen, int addrtype);
int (PASCAL FAR *gethostname)(char FAR * name, int namelen);
int (PASCAL FAR *getpeername)(SOCKET sock, struct sockaddr FAR *name,
int FAR *namelen);
struct servent FAR * (PASCAL FAR *getservbyname)(const char FAR * name,
const char FAR * proto);
int (PASCAL FAR *getsockname)(SOCKET sock, struct sockaddr FAR *name,
int FAR *namelen);
int (PASCAL FAR *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData);
int (PASCAL FAR *WSACleanup)(void);
int (PASCAL FAR *WSAGetLastError)(void);
int (PASCAL FAR *WSAAsyncSelect)(SOCKET s, HWND hWnd, u_int wMsg,
long lEvent);
} winSock;
/*
* The following define declares a new user message for use on the
* socket window.
*/
#define SOCKET_MESSAGE WM_USER+1
/*
* The following structure is used to store the data associated with
* each socket. A Tcl_File of type TCL_WIN_SOCKET will contain a
* pointer to one of these structures in the clientdata slot.
*/
typedef struct SocketInfo {
SOCKET socket; /* Windows SOCKET handle. */
int flags; /* Bit field comprised of the flags
* described below. */
int watchMask; /* OR'ed combination of TCL_READABLE and
* TCL_WRITABLE as set by Tcl_WatchFile. */
int eventMask; /* OR'ed combination of FD_READ, FD_WRITE,
* FD_CLOSE, FD_ACCEPT and FD_CONNECT. */
int occurredMask; /* OR'ed combination of the above flags
* for those events that have actually
* occurred on the socket. */
Tcl_File file; /* The file handle for the socket. */
Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
ClientData acceptProcData; /* The data for the accept proc. */
struct SocketInfo *nextPtr; /* The next socket on the global socket
* list. */
} SocketInfo;
/*
* This defines the minimum buffersize maintained by the kernel.
*/
#define TCP_BUFFER_SIZE 4096
/*
* The following macros may be used to set the flags field of
* a SocketInfo structure. We leave the first three bits open
* for TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION
*/
#define SOCKET_WATCH (1<<4)
/* TclWinWatchSocket has been called since the
* last time we entered Tcl_WaitForEvent. */
#define SOCKET_REGISTERED (1<<5)
/* A valid WSAAsyncSelect handler is
* registered. */
#define SOCKET_ASYNCH (1<<6)
/* The socket is in asynch mode. */
#define SOCKET_CLOSED (1<<7) /* The socket had an FD_CLOSE event. */
#define SOCKET_EOF (1<<8) /* A zero read happened on the socket. */
/*
* Every open socket has an entry on the following list.
*/
static SocketInfo *socketList = NULL;
/*
* Static functions defined in this file.
*/
static void CleanupSockets _ANSI_ARGS_((ClientData clientData));
static SocketInfo * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
int port, char *host, int server, char *myaddr,
int myport, int async));
static int CreateSocketAddress _ANSI_ARGS_(
(struct sockaddr_in *sockaddrPtr,
char *host, int port));
static int InitSockets _ANSI_ARGS_((void));
static SocketInfo * NewSocketInfo _ANSI_ARGS_((Tcl_File file));
static void SocketFreeProc _ANSI_ARGS_((ClientData clientData));
static LRESULT CALLBACK SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam));
static void TcpAccept _ANSI_ARGS_((ClientData data, int mask));
static int TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
char *optionName, Tcl_DString *optionValue));
static int TcpInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCode));
static void TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static int TcpReadyProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static Tcl_File TcpGetProc _ANSI_ARGS_((ClientData instanceData,
int direction));
/*
* This structure describes the channel type structure for TCP socket
* based IO.
*/
static Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
NULL, /* Block: Not used. */
TcpCloseProc, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
NULL, /* Set option proc. */
TcpGetOptionProc, /* Get option proc. */
TcpWatchProc, /* Initialize notifier to watch this channel. */
TcpReadyProc, /* Are events present? */
TcpGetProc, /* Get a Tcl_File from channel. */
};
/*
* Socket notification window. This window is used to receive socket
* notification events.
*/
static HWND socketWindow = NULL;
/*
* Window class for creating the socket notification window.
*/
static ATOM socketClass;
/*
* Define version of Winsock required by Tcl.
*/
#define WSA_VERSION_REQD MAKEWORD(1,1)
/*
*----------------------------------------------------------------------
*
* InitSockets --
*
* Initialize the socket module. Attempts to load the wsock32.dll
* library and set up the winSock function table. If successful,
* registers the event window for the socket notifier code.
*
* Results:
* Returns 1 on successful initialization, 0 on failure.
*
* Side effects:
* Dynamically loads wsock32.dll, and registers a new window
* class and creates a window for use in asynchronous socket
* notification.
*
*----------------------------------------------------------------------
*/
static int
InitSockets()
{
WSADATA wsaData;
WNDCLASS class;
HINSTANCE handle;
/*
* Load the socket DLL and initialize the function table.
*/
handle = TclWinLoadLibrary("wsock32.dll");
if (handle != NULL) {
winSock.accept = (SOCKET (PASCAL FAR *)(SOCKET s,
struct sockaddr FAR *addr, int FAR *addrlen))
GetProcAddress(handle, "accept");
winSock.bind = (int (PASCAL FAR *)(SOCKET s,
const struct sockaddr FAR *addr, int namelen))
GetProcAddress(handle, "bind");
winSock.closesocket = (int (PASCAL FAR *)(SOCKET s))
GetProcAddress(handle, "closesocket");
winSock.connect = (int (PASCAL FAR *)(SOCKET s,
const struct sockaddr FAR *name, int namelen))
GetProcAddress(handle, "connect");
winSock.ioctlsocket = (int (PASCAL FAR *)(SOCKET s, long cmd,
u_long FAR *argp)) GetProcAddress(handle, "ioctlsocket");
winSock.getsockopt = (int (PASCAL FAR *)(SOCKET s,
int level, int optname, char FAR * optval, int FAR *optlen))
GetProcAddress(handle, "getsockopt");
winSock.htons = (u_short (PASCAL FAR *)(u_short hostshort))
GetProcAddress(handle, "htons");
winSock.inet_addr = (unsigned long (PASCAL FAR *)(const char FAR *cp))
GetProcAddress(handle, "inet_addr");
winSock.inet_ntoa = (char FAR * (PASCAL FAR *)(struct in_addr in))
GetProcAddress(handle, "inet_ntoa");
winSock.listen = (int (PASCAL FAR *)(SOCKET s, int backlog))
GetProcAddress(handle, "listen");
winSock.ntohs = (u_short (PASCAL FAR *)(u_short netshort))
GetProcAddress(handle, "ntohs");
winSock.recv = (int (PASCAL FAR *)(SOCKET s, char FAR * buf,
int len, int flags)) GetProcAddress(handle, "recv");
winSock.send = (int (PASCAL FAR *)(SOCKET s, const char FAR * buf,
int len, int flags)) GetProcAddress(handle, "send");
winSock.setsockopt = (int (PASCAL FAR *)(SOCKET s, int level,
int optname, const char FAR * optval, int optlen))
GetProcAddress(handle, "setsockopt");
winSock.shutdown = (int (PASCAL FAR *)(SOCKET s, int how))
GetProcAddress(handle, "shutdown");
winSock.socket = (SOCKET (PASCAL FAR *)(int af, int type,
int protocol)) GetProcAddress(handle, "socket");
winSock.gethostbyaddr = (struct hostent FAR * (PASCAL FAR *)
(const char FAR *addr, int addrlen, int addrtype))
GetProcAddress(handle, "gethostbyaddr");
winSock.gethostbyname = (struct hostent FAR * (PASCAL FAR *)
(const char FAR *name))
GetProcAddress(handle, "gethostbyname");
winSock.gethostname = (int (PASCAL FAR *)(char FAR * name,
int namelen)) GetProcAddress(handle, "gethostname");
winSock.getpeername = (int (PASCAL FAR *)(SOCKET sock,
struct sockaddr FAR *name, int FAR *namelen))
GetProcAddress(handle, "getpeername");
winSock.getservbyname = (struct servent FAR * (PASCAL FAR *)
(const char FAR * name, const char FAR * proto))
GetProcAddress(handle, "getservbyname");
winSock.getsockname = (int (PASCAL FAR *)(SOCKET sock,
struct sockaddr FAR *name, int FAR *namelen))
GetProcAddress(handle, "getsockname");
winSock.WSAStartup = (int (PASCAL FAR *)(WORD wVersionRequired,
LPWSADATA lpWSAData)) GetProcAddress(handle, "WSAStartup");
winSock.WSACleanup = (int (PASCAL FAR *)(void))
GetProcAddress(handle, "WSACleanup");
winSock.WSAGetLastError = (int (PASCAL FAR *)(void))
GetProcAddress(handle, "WSAGetLastError");
winSock.WSAAsyncSelect = (int (PASCAL FAR *)(SOCKET s, HWND hWnd,
u_int wMsg, long lEvent))
GetProcAddress(handle, "WSAAsyncSelect");
}
/*
* Initialize the winsock library and check the version number.
*/
if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
return 0;
}
if (wsaData.wVersion != WSA_VERSION_REQD) {
(*winSock.WSACleanup)();
return 0;
}
/*
* Register the async notification window class and window.
*/
class.style = 0;
class.cbClsExtra = 0;
class.cbWndExtra = 0;
class.hInstance = TclWinGetTclInstance();
class.hbrBackground = NULL;
class.lpszMenuName = NULL;
class.lpszClassName = "TclSocket";
class.lpfnWndProc = SocketProc;
class.hIcon = NULL;
class.hCursor = NULL;
socketClass = RegisterClass(&class);
if (!socketClass) {
TclWinConvertError(GetLastError());
(*winSock.WSACleanup)();
return 0;
}
socketWindow = CreateWindowEx(0, (LPCTSTR)socketClass, "TclSocket",
WS_OVERLAPPED, 0, 0, 0, 0, NULL, NULL,
TclWinGetTclInstance(), NULL);
if (socketWindow == NULL) {
TclWinConvertError(GetLastError());
UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
(*winSock.WSACleanup)();
return 0;
}
Tcl_CreateExitHandler(CleanupSockets, (ClientData) NULL);
return 1;
}
/*
*----------------------------------------------------------------------
*
* CleanupSockets --
*
* Callback invoked during exit clean up to release the WinSock
* DLL.
*
* Results:
* None.
*
* Side effects:
* Releases the WinSock DLL.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static void
CleanupSockets(clientData)
ClientData clientData; /* Not used. */
{
DestroyWindow(socketWindow);
UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
(*winSock.WSACleanup)();
}
/*
*----------------------------------------------------------------------
*
* TcpCloseProc --
*
* This procedure is called by the generic IO level to perform
* channel type specific cleanup on a socket based channel
* when the channel is closed.
*
* Results:
* 0 if successful, the value of errno if failed.
*
* Side effects:
* Closes the socket.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
TcpCloseProc(instanceData, interp)
ClientData instanceData; /* The socket to close. */
Tcl_Interp *interp; /* Unused. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int errorCode = 0;
/*
* Clean up the OS socket handle.
*/
(void) ((*winSock.shutdown)(infoPtr->socket, 2));
if ((*winSock.closesocket)(infoPtr->socket) == SOCKET_ERROR) {
TclWinConvertWSAError((*winSock.WSAGetLastError)());
errorCode = errno;
}
/*
* Delete a file handler that may be active for this socket.
* Channel handlers are already deleted in the generic IO close
* code which called this function.
*/
Tcl_DeleteFileHandler(infoPtr->file);
/*
* Free the file handle. As a side effect, this will call the
* SocketFreeProc to release the SocketInfo associated with this file.
*/
Tcl_FreeFile(infoPtr->file);
return errorCode;
}
/*
*----------------------------------------------------------------------
*
* SocketFreeProc --
*
* This callback is invoked by Tcl_FreeFile in order to delete
* the notifier data associated with a file handle.
*
* Results:
* None.
*
* Side effects:
* Removes the SocketInfo from the global socket list.
*
*----------------------------------------------------------------------
*/
static void
SocketFreeProc(clientData)
ClientData clientData;
{
SocketInfo *infoPtr = (SocketInfo *) clientData;
/*
* Remove the socket from socketList.
*/
if (infoPtr == socketList) {
socketList = infoPtr->nextPtr;
} else {
SocketInfo *p;
for (p = socketList; p != NULL; p = p->nextPtr) {
if (p->nextPtr == infoPtr) {
p->nextPtr = infoPtr->nextPtr;
break;
}
}
}
ckfree((char *) infoPtr);
}
/*
*----------------------------------------------------------------------
*
* NewSocketInfo --
*
* This function allocates and initializes a new SocketInfo
* structure.
*
* Results:
* Returns a newly allocated SocketInfo.
*
* Side effects:
* Adds the socket to the global socket list.
*
*----------------------------------------------------------------------
*/
static SocketInfo *
NewSocketInfo(file)
Tcl_File file;
{
SocketInfo *infoPtr;
infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
infoPtr->socket = (SOCKET) Tcl_GetFileInfo(file, NULL);
infoPtr->flags = 0;
infoPtr->watchMask = 0;
infoPtr->eventMask = 0;
infoPtr->occurredMask = 0;
infoPtr->file = file;
infoPtr->acceptProc = NULL;
infoPtr->nextPtr = socketList;
socketList = infoPtr;
Tcl_SetNotifierData(file, SocketFreeProc, (ClientData) infoPtr);
return infoPtr;
}
/*
*----------------------------------------------------------------------
*
* CreateSocket --
*
* This function opens a new socket and initializes the
* SocketInfo structure.
*
* Results:
* Returns a new SocketInfo, or NULL with an error in interp.
*
* Side effects:
* Adds a new socket to the socketList.
*
*----------------------------------------------------------------------
*/
static SocketInfo *
CreateSocket(interp, port, host, server, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
char *host; /* Name of host on which to open port. */
int server; /* 1 if socket should be a server socket,
* else 0 for a client socket. */
char *myaddr; /* Optional client-side address */
int myport; /* Optional client-side port */
int async; /* If nonzero, connect client socket
* asynchronously. Unused. */
{
int status;
struct sockaddr_in sockaddr; /* Socket address */
struct sockaddr_in mysockaddr; /* Socket address for client */
SOCKET sock;
if (! CreateSocketAddress(&sockaddr, host, port)) {
goto addressError;
}
if ((myaddr != NULL || myport != 0) &&
! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
goto addressError;
}
sock = (*winSock.socket)(AF_INET, SOCK_STREAM, 0);
if (sock == INVALID_SOCKET) {
goto addressError;
}
/*
* Set kernel space buffering
*/
TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
if (server) {
/*
* Bind to the specified port. Note that we must not call setsockopt
* with SO_REUSEADDR because Microsoft allows addresses to be reused
* even if they are still in use.
*/
status = (*winSock.bind)(sock, (struct sockaddr *) &sockaddr,
sizeof(sockaddr));
if (status != SOCKET_ERROR) {
(*winSock.listen)(sock, 5);
}
} else {
if (myaddr != NULL || myport != 0) {
status = (*winSock.bind)(sock, (struct sockaddr *) &mysockaddr,
sizeof(struct sockaddr));
if (status < 0) {
goto bindError;
}
}
status = (*winSock.connect)(sock, (struct sockaddr *) &sockaddr,
sizeof(sockaddr));
}
if (status != SOCKET_ERROR) {
u_long flag = 1;
status = (*winSock.ioctlsocket)(sock, FIONBIO, &flag);
}
bindError:
if (status == SOCKET_ERROR) {
TclWinConvertWSAError((*winSock.WSAGetLastError)());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
Tcl_PosixError(interp), (char *) NULL);
}
(*winSock.closesocket)(sock);
return NULL;
}
/*
* Add this socket to the global list of sockets.
*/
return NewSocketInfo(Tcl_GetFile((ClientData) sock, TCL_WIN_SOCKET));
addressError:
TclWinConvertWSAError((*winSock.WSAGetLastError)());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
* CreateSocketAddress --
*
* This function initializes a sockaddr structure for a host and port.
*
* Results:
* 1 if the host was valid, 0 if the host could not be converted to
* an IP address.
*
* Side effects:
* Fills in the *sockaddrPtr structure.
*
*----------------------------------------------------------------------
*/
static int
CreateSocketAddress(sockaddrPtr, host, port)
struct sockaddr_in *sockaddrPtr; /* Socket address */
char *host; /* Host. NULL implies INADDR_ANY */
int port; /* Port number */
{
struct hostent *hostent; /* Host database entry */
struct in_addr addr; /* For 64/32 bit madness */
(void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
sockaddrPtr->sin_family = AF_INET;
sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF));
if (host == NULL) {
addr.s_addr = INADDR_ANY;
} else {
addr.s_addr = (*winSock.inet_addr)(host);
if (addr.s_addr == INADDR_NONE) {
hostent = (*winSock.gethostbyname)(host);
if (hostent != NULL) {
memcpy((char *) &addr,
(char *) hostent->h_addr_list[0],
(size_t) hostent->h_length);
} else {
#ifdef EHOSTUNREACH
errno = EHOSTUNREACH;
#else
#ifdef ENXIO
errno = ENXIO;
#endif
#endif
return 0; /* Error. */
}
}
}
/*
* NOTE: On 64 bit machines the assignment below is rumored to not
* do the right thing. Please report errors related to this if you
* observe incorrect behavior on 64 bit machines such as DEC Alphas.
* Should we modify this code to do an explicit memcpy?
*/
sockaddrPtr->sin_addr.s_addr = addr.s_addr;
return 1; /* Success. */
}
/*
*----------------------------------------------------------------------
*
* Tcl_OpenTcpClient --
*
* Opens a TCP client socket and creates a channel around it.
*
* Results:
* The channel or NULL if failed. An error message is returned
* in the interpreter on failure.
*
* Side effects:
* Opens a client socket and creates a new channel.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
char *host; /* Host on which to open port. */
char *myaddr; /* Client-side address */
int myport; /* Client-side port */
int async; /* If nonzero, should connect
* client socket asynchronously. */
{
Tcl_Channel chan;
SocketInfo *infoPtr;
char channelName[20];
if (TclHasSockets(interp) != TCL_OK) {
return NULL;
}
/*
* Create a new client socket and wrap it in a channel.
*/
infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
if (infoPtr == NULL) {
return NULL;
}
sprintf(channelName, "sock%d", infoPtr->socket);
chan = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(interp, chan, "-translation", "auto crlf") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* Tcl_MakeTcpClientChannel --
*
* Creates a Tcl_Channel from an existing client TCP socket.
*
* Results:
* The Tcl_Channel wrapped around the preexisting TCP socket.
*
* Side effects:
* None.
*
* NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_MakeTcpClientChannel(sock)
ClientData sock; /* The socket to wrap up into a channel. */
{
SocketInfo *infoPtr;
char channelName[20];
Tcl_Channel chan;
int flag = 1;
if (TclHasSockets(NULL) != TCL_OK) {
return NULL;
}
/*
* Set kernel space buffering and non-blocking.
*/
TclSockMinimumBuffers((SOCKET) sock, TCP_BUFFER_SIZE);
if ((*winSock.ioctlsocket)((SOCKET)sock, FIONBIO, &flag) == SOCKET_ERROR) {
TclWinConvertWSAError ((*winSock.WSAGetLastError)());
return NULL;
}
infoPtr = NewSocketInfo (Tcl_GetFile((ClientData) sock,
TCL_WIN_SOCKET));
sprintf(channelName, "sock%d", infoPtr->socket);
chan = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan,
"-translation", "auto crlf") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* Tcl_OpenTcpServer --
*
* Opens a TCP server socket and creates a channel around it.
*
* Results:
* The channel or NULL if failed. An error message is returned
* in the interpreter on failure.
*
* Side effects:
* Opens a server socket and creates a new channel.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
Tcl_Interp *interp; /* For error reporting - may be
* NULL. */
int port; /* Port number to open. */
char *host; /* Name of local host. */
Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections
* from new clients. */
ClientData acceptProcData; /* Data for the callback. */
{
Tcl_Channel chan;
SocketInfo *infoPtr;
char channelName[20];
if (TclHasSockets(interp) != TCL_OK) {
return NULL;
}
/*
* Create a new client socket and wrap it in a channel.
*/
infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
if (infoPtr == NULL) {
return NULL;
}
infoPtr->acceptProc = acceptProc;
infoPtr->acceptProcData = acceptProcData;
/*
* Set up the callback mechanism for accepting connections
* from new clients. The caller will use Tcl_TcpRegisterCallback
* to register a callback to call when a new connection is
* accepted.
*/
Tcl_CreateFileHandler(infoPtr->file, TCL_READABLE, TcpAccept,
(ClientData) infoPtr);
sprintf(channelName, "sock%d", infoPtr->socket);
chan = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, 0);
if (Tcl_SetChannelOption(interp, chan, "-eofchar", "") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return (Tcl_Channel) NULL;
}
return chan;
}
/*
*----------------------------------------------------------------------
*
* TcpAccept --
* Accept a TCP socket connection. This is called by the event loop,
* and it in turns calls any registered callbacks for this channel.
*
* Results:
* None.
*
* Side effects:
* Evals the Tcl script associated with the server socket.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static void
TcpAccept(data, mask)
ClientData data; /* Callback token. */
int mask; /* Not used. */
{
SOCKET newSocket;
SocketInfo *infoPtr = (SocketInfo *) data;
SocketInfo *newInfoPtr;
struct sockaddr_in addr;
int len;
Tcl_Channel chan;
char channelName[20];
u_long flag = 1;
len = sizeof(struct sockaddr_in);
newSocket = (*winSock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
&len);
infoPtr->flags= (~(TCL_READABLE));
if (newSocket == INVALID_SOCKET) {
return;
}
/*
* Clear the inherited event mask.
*/
(*winSock.WSAAsyncSelect)(newSocket, socketWindow, 0, 0);
/*
* Set the socket into non-blocking mode.
*/
if ((*winSock.ioctlsocket)(newSocket, FIONBIO, &flag) != 0) {
(*winSock.closesocket)(newSocket);
return;
}
/*
* Add this socket to the global list of sockets.
*/
newInfoPtr = NewSocketInfo(Tcl_GetFile((ClientData) newSocket,
TCL_WIN_SOCKET));
sprintf(channelName, "sock%d", newSocket);
chan = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, chan, "-translation", "auto crlf") ==
TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return;
}
if (Tcl_SetChannelOption(NULL, chan, "-eofchar", "") == TCL_ERROR) {
Tcl_Close((Tcl_Interp *) NULL, chan);
return;
}
/*
* Invoke the accept callback procedure.
*/
if (infoPtr->acceptProc != NULL) {
(infoPtr->acceptProc) (infoPtr->acceptProcData, chan,
(*winSock.inet_ntoa)(addr.sin_addr),
(*winSock.ntohs)(addr.sin_port));
}
}
/*
*----------------------------------------------------------------------
*
* TcpInputProc --
*
* This procedure is called by the generic IO level to read data from
* a socket based channel.
*
* Results:
* The number of bytes read or -1 on error.
*
* Side effects:
* Consumes input from the socket.
*
*----------------------------------------------------------------------
*/
static int
TcpInputProc(instanceData, buf, toRead, errorCodePtr)
ClientData instanceData; /* The socket state. */
char *buf; /* Where to store data. */
int toRead; /* Maximum number of bytes to read. */
int *errorCodePtr; /* Where to store error codes. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesRead;
*errorCodePtr = 0;
/*
* First check to see if EOF was already detected, to prevent
* calling the socket stack after the first time EOF is detected.
*/
if (infoPtr->flags & SOCKET_EOF) {
return 0;
}
/*
* No EOF yet, so try to read more from the socket.
*/
bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
if (bytesRead == SOCKET_ERROR) {
TclWinConvertWSAError((*winSock.WSAGetLastError)());
*errorCodePtr = errno;
bytesRead = -1;
}
/*
* Ensure that the socket stays readable until we get either an EWOULDBLOCK
* or a zero sized read.
*/
if (errno == EWOULDBLOCK) {
infoPtr->flags &= (~(TCL_READABLE));
} else if (bytesRead == 0) {
infoPtr->flags |= SOCKET_EOF;
} else {
infoPtr->flags |= TCL_READABLE;
}
return bytesRead;
}
/*
*----------------------------------------------------------------------
*
* TcpOutputProc --
*
* This procedure is called by the generic IO level to write data
* to a socket based channel.
*
* Results:
* The number of bytes written or -1 on failure.
*
* Side effects:
* Produces output on the socket.
*
*----------------------------------------------------------------------
*/
static int
TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* The socket state. */
char *buf; /* Where to get data. */
int toWrite; /* Maximum number of bytes to write. */
int *errorCodePtr; /* Where to store error codes. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesWritten;
*errorCodePtr = 0;
bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
if (bytesWritten == SOCKET_ERROR) {
TclWinConvertWSAError((*winSock.WSAGetLastError)());
if (errno == EWOULDBLOCK) {
infoPtr->flags &= (~(TCL_WRITABLE));
}
*errorCodePtr = errno;
return -1;
}
/*
* Clear the writable bit in the flags. If an async handler
* is still registered for this socket, then it will generate a new
* event if there is still data available. When the event is
* processed, the readable bit will be turned back on.
*/
infoPtr->flags &= (~(TCL_WRITABLE));
return bytesWritten;
}
/*
*----------------------------------------------------------------------
*
* TcpGetOptionProc --
*
* Computes an option value for a TCP socket based channel, or a
* list of all options and their values.
*
* Note: This code is based on code contributed by John Haxby.
*
* Results:
* A standard Tcl result. The value of the specified option or a
* list of all options and their values is returned in the
* supplied DString.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TcpGetOptionProc(instanceData, optionName, dsPtr)
ClientData instanceData; /* Socket state. */
char *optionName; /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
Tcl_DString *dsPtr; /* Where to store the computed
* value; initialized by caller. */
{
SocketInfo *infoPtr;
struct sockaddr_in sockname;
struct sockaddr_in peername;
struct hostent *hostEntPtr;
SOCKET sock;
int size = sizeof(struct sockaddr_in);
size_t len = 0;
char buf[128];
infoPtr = (SocketInfo *) instanceData;
sock = (int) infoPtr->socket;
if (optionName != (char *) NULL) {
len = strlen(optionName);
}
if ((len == 0) ||
((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
if ((*winSock.getpeername)(sock, (struct sockaddr *) &peername, &size)
>= 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(peername.sin_addr));
hostEntPtr = (*winSock.gethostbyaddr)(
(char *) &(peername.sin_addr), sizeof(peername.sin_addr),
AF_INET);
if (hostEntPtr != (struct hostent *) NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(peername.sin_addr));
}
sprintf(buf, "%d", (*winSock.ntohs)(peername.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
} else {
return TCL_OK;
}
}
}
if ((len == 0) ||
((len > 1) && (optionName[1] == 's') &&
(strncmp(optionName, "-sockname", len) == 0))) {
if ((*winSock.getsockname)(sock, (struct sockaddr *) &sockname, &size)
>= 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-sockname");
Tcl_DStringStartSublist(dsPtr);
}
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(sockname.sin_addr));
hostEntPtr = (*winSock.gethostbyaddr)(
(char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
AF_INET);
if (hostEntPtr != (struct hostent *) NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(sockname.sin_addr));
}
sprintf(buf, "%d", (*winSock.ntohs)(sockname.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
} else {
return TCL_OK;
}
}
}
if (len > 0) {
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TcpWatchProc --
*
* Initialize the notifier to watch Tcl_Files from this channel.
*
* Results:
* None.
*
* Side effects:
* Sets up the notifier so that a future event on the channel will
* be seen by Tcl.
*
*----------------------------------------------------------------------
*/
static void
TcpWatchProc(instanceData, mask)
ClientData instanceData; /* The socket state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABEL and TCL_EXCEPTION. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
Tcl_WatchFile(infoPtr->file, mask);
}
/*
*----------------------------------------------------------------------
*
* TcpReadyProc --
*
* Called by the notifier to check whether events of interest are
* present on the channel.
*
* Results:
* Returns OR-ed combination of TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION to indicate which events of interest are present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TcpReadyProc(instanceData, mask)
ClientData instanceData; /* The socket state. */
int mask; /* Events of interest; an OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
return Tcl_FileReady(infoPtr->file, mask);
}
/*
*----------------------------------------------------------------------
*
* TcpGetProc --
*
* Called from Tcl_GetChannelFile to retrieve Tcl_Files from inside
* a TCP socket based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static Tcl_File
TcpGetProc(instanceData, direction)
ClientData instanceData; /* The socket state. */
int direction; /* Which Tcl_File to retrieve? */
{
SocketInfo *statePtr = (SocketInfo *) instanceData;
return statePtr->file;
}
/*
*----------------------------------------------------------------------
*
* TclWinWatchSocket --
*
* This function imlements the socket specific portion of the
* Tcl_WatchFile function in the notifier.
*
* Results:
* None.
*
* Side effects:
* The watched socket will be placed into non-blocking mode, and
* an entry on the asynch handler list will be created if necessary.
*
*----------------------------------------------------------------------
*/
void
TclWinWatchSocket(file, mask)
Tcl_File file; /* Socket to watch. */
int mask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION:
* indicates conditions to wait for
* in select. */
{
SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
Tcl_Time dontBlock;
dontBlock.sec = 0; dontBlock.usec = 0;
/*
* Create socket info on demand if necessary. We should only enter this
* code if the socket was created outside of Tcl. Since this may be
* the first time that the socket code has been called, we need to invoke
* TclHasSockets to ensure that everything is initialized properly.
*/
if (infoPtr == NULL) {
if (TclHasSockets(NULL) != TCL_OK) {
return;
}
infoPtr = NewSocketInfo(file);
}
infoPtr->flags |= SOCKET_WATCH;
/*
* If the new mask includes more conditions than the current mask,
* then we mark the socket as unregistered so it will be reregistered
* the next time we enter Tcl_WaitForEvent.
*/
mask |= infoPtr->watchMask;
if (infoPtr->watchMask != mask) {
infoPtr->flags &= (~(SOCKET_REGISTERED));
infoPtr->watchMask = mask;
}
/*
* Check if any bits are set on the flags. If there are, this
* means that the socket already had events on it, and we need to
* check it immediately. To do this, set the maximum block time to
* zero.
*/
if ((infoPtr->flags & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION)) != 0) {
Tcl_SetMaxBlockTime(&dontBlock);
}
}
/*
*----------------------------------------------------------------------
*
* TclWinNotifySocket --
*
* Set up event notifiers for any sockets that are being watched.
* Also, clean up any sockets that are no longer being watched.
*
* Results:
* None.
*
* Side effects:
* Adds and removes asynch select handlers.
*
*----------------------------------------------------------------------
*/
void
TclWinNotifySocket()
{
SocketInfo *infoPtr;
if (socketList == NULL) {
return;
}
/*
* Establish or remove any notifiers.
*/
for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->flags & SOCKET_WATCH) {
if (!(infoPtr->flags & SOCKET_REGISTERED)) {
int events = 0;
if (infoPtr->watchMask & TCL_READABLE) {
events |= (FD_READ | FD_ACCEPT | FD_CLOSE);
}
if (infoPtr->watchMask & TCL_WRITABLE) {
events |= (FD_WRITE | FD_CONNECT);
}
/*
* If we are interested in any events, mark the
* socket as registered.
*/
if (events != 0) {
infoPtr->flags |= SOCKET_REGISTERED;
}
/*
* If the new event interest mask does not match what is
* currently set into the socket, set the new mask.
*/
if (events != infoPtr->eventMask) {
infoPtr->eventMask = events;
(*winSock.WSAAsyncSelect)(infoPtr->socket, socketWindow,
SOCKET_MESSAGE, events);
}
}
} else {
/*
* We are no longer supposed to be watching this socket. Remove
* its registration and remember that we are not interested in
* any events on it.
*/
if (infoPtr->flags & SOCKET_REGISTERED) {
infoPtr->flags &= ~(SOCKET_REGISTERED);
infoPtr->eventMask = 0;
(*winSock.WSAAsyncSelect)(infoPtr->socket, socketWindow, 0, 0);
}
}
}
}
/*
*----------------------------------------------------------------------
*
* TclWinSocketReady --
*
* This function is invoked by Tcl_FileReady to check whether
* the specified conditions are present on a socket.
*
* Results:
* The return value is 0 if none of the conditions specified by
* mask were true for socket the last time the system checked.
* If any of the conditions were true, then the return value is a
* mask of those that were true.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclWinSocketReady(file, mask)
Tcl_File file; /* File handle for a stream. */
int mask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION:
* indicates conditions caller cares about. */
{
SocketInfo *infoPtr = (SocketInfo *) Tcl_GetNotifierData(file, NULL);
int result, status, occurred;
u_long nBytes;
result = (infoPtr->flags & mask);
occurred = infoPtr->occurredMask;
infoPtr->occurredMask = 0;
infoPtr->flags &= (~(SOCKET_WATCH));
if (result & TCL_READABLE) {
/*
* Must check for readability condition still being present on the
* socket, because someone might have consumed the data in the
* meantime. If we are accepting on the socket or it got closed,
* the socket is readable.
*/
if (occurred & FD_ACCEPT) {
/* Empty body. */
} else if (occurred & FD_CLOSE) {
/* Remember the FD_CLOSE event. */
infoPtr->flags |= SOCKET_CLOSED;
} else {
/*
* Otherwise it is readable only if there is data present.
* NOTE: We do not really care whether FD_READ happened..
*/
status = (*winSock.ioctlsocket)(infoPtr->socket, FIONREAD,
&nBytes);
if ((status == SOCKET_ERROR) ||
((nBytes == 0) && (!(infoPtr->flags & SOCKET_CLOSED)))) {
result &= (~(TCL_READABLE));
infoPtr->flags &= (~(TCL_READABLE));
}
}
}
return result;
}
/*
*----------------------------------------------------------------------
*
* SocketProc --
*
* This function is called when WSAAsyncSelect has been used
* to register interest in a socket event, and the event has
* occurred.
*
* Results:
* 0 on success.
*
* Side effects:
* The flags for the given socket are updated to reflect the
* event that occured.
*
*----------------------------------------------------------------------
*/
static LRESULT CALLBACK
SocketProc(hwnd, message, wParam, lParam)
HWND hwnd;
UINT message;
WPARAM wParam;
LPARAM lParam;
{
int event;
SOCKET socket;
SocketInfo *infoPtr;
if ((hwnd != socketWindow) || (message != SOCKET_MESSAGE)) {
return DefWindowProc(hwnd, message, wParam, lParam);
}
event = WSAGETSELECTEVENT(lParam);
socket = (SOCKET) wParam;
/*
* Find the specified socket on the socket list and update its
* check flags.
*/
for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->socket == socket) {
if (event & (FD_READ | FD_ACCEPT | FD_CLOSE)) {
infoPtr->flags |= TCL_READABLE;
}
if (event & (FD_WRITE | FD_CONNECT)) {
infoPtr->flags |= TCL_WRITABLE;
}
infoPtr->occurredMask |= event;
break;
}
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetHostName --
*
* Returns the name of the local host.
*
* Results:
* Returns a string containing the host name, or NULL on error.
* The returned string must be freed by the caller.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
char *
Tcl_GetHostName()
{
static int hostnameInitialized = 0;
static char hostname[255]; /* This buffer should be big enough for
* hostname plus domain name. */
if (TclHasSockets(NULL) != TCL_OK) {
return "";
}
if (hostnameInitialized) {
return hostname;
}
if ((*winSock.gethostname)(hostname, 100) == 0) {
hostnameInitialized = 1;
return hostname;
}
return (char *) NULL;
}
/*
*----------------------------------------------------------------------
*
* TclHasSockets --
*
* This function determines whether sockets are available on the
* current system and returns an error in interp if they are not.
* Note that interp may be NULL.
*
* Results:
* Returns TCL_OK if the system supports sockets, or TCL_ERROR with
* an error in interp.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclHasSockets(interp)
Tcl_Interp *interp;
{
static int initialized = 0; /* 1 if the socket system has been
* initialized. */
static int hasSockets = 0; /* 1 if the system supports sockets. */
if (!initialized) {
OSVERSIONINFO info;
initialized = 1;
/*
* Find out if we're running on Win32s.
*/
info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&info);
/*
* Check to see if Sockets are supported on this system. Since
* win32s panics if we call WSAStartup on a system that doesn't
* have winsock.dll, we need to look for it on the system first.
* If we find winsock, then load the library and initialize the
* stub table.
*/
if ((info.dwPlatformId != VER_PLATFORM_WIN32s)
|| (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
hasSockets = InitSockets();
}
}
if (hasSockets) {
return TCL_OK;
}
if (interp != NULL) {
Tcl_AppendResult(interp, "sockets are not available on this system",
NULL);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TclWinGetSockOpt, et al. --
*
* These functions are wrappers that let us bind the WinSock
* API dynamically so we can run on systems that don't have
* the wsock32.dll. We need wrappers for these interfaces
* because they are called from the generic Tcl code
*
* Results:
* As defined for each function.
*
* Side effects:
* As defined for each function.
*
*----------------------------------------------------------------------
*/
int PASCAL FAR
TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
int FAR *optlen)
{
return (*winSock.getsockopt)(s, level, optname, optval, optlen);
}
int PASCAL FAR
TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
int optlen)
{
return (*winSock.setsockopt)(s, level, optname, optval, optlen);
}
u_short PASCAL FAR
TclWinNToHS(u_short netshort)
{
return (*winSock.ntohs)(netshort);
}
struct servent FAR * PASCAL FAR
TclWinGetServByName(const char FAR * name, const char FAR * proto)
{
return (*winSock.getservbyname)(name, proto);
}
Reference in New Issue View Git Blame Copy Permalink