geos_one/archie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Intial commit

Browse Source
This commit is contained in:
Mario Fetka
2024-05-27 16:13:40 +02:00
parent f8dc12b10a
commit d71d446104
2495 changed files with 539746 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
tcl-dp/win/dpAppInit.c Normal file
View File

@@ -0,0 +1,177 @@
/*
* tclAppInit.c --
*
* Provides a default version of the main program and Tcl_AppInit
* procedure for Tcl applications (without Tk). Note that this
* program must be built in Win32 console mode to work properly.
*
* Copyright (c) 1996 by 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: @(#) tclAppInit.c 1.7 96/07/23 16:18:08
*/
#include "tcl.h"
#include "generic/dp.h"
#include <windows.h>
#include <locale.h>
#ifdef TCL_TEST
EXTERN int TclTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */
EXTERN int Dp_Init _ANSI_ARGS_((Tcl_Interp *interp));
/*
*----------------------------------------------------------------------
*
* main --
*
* This is the main program for the application.
*
* Results:
* None: Tcl_Main never returns here, so this procedure never
* returns either.
*
* Side effects:
* Whatever the application does.
*
*----------------------------------------------------------------------
*/
int
main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
char *args = GetCommandLine();
char **argvlist, *p;
int size, i;
/*
* Set up the default locale to be standard "C" locale so parsing
* is performed correctly.
*/
setlocale(LC_ALL, "C");
/*
* Precompute an overly pessimistic guess at the number of arguments
* in the command line by counting non-space spans.
*/
for (size = 2, p = args; *p != '\0'; p++) {
if (isspace(*p)) {
size++;
while (isspace(*p)) {
p++;
}
if (*p == '\0') {
break;
}
}
}
argvlist = (char **) ckalloc((unsigned) (size * sizeof(char *)));
argv = argvlist;
/*
* Parse the Windows command line string. If an argument begins with a
* double quote, then spaces are considered part of the argument until the
* next double quote. The argument terminates at the second quote. Note
* that this is different from the usual Unix semantics.
*/
for (i = 0, p = args; *p != '\0'; i++) {
while (isspace(*p)) {
p++;
}
if (*p == '\0') {
break;
}
if (*p == '"') {
p++;
argv[i] = p;
while ((*p != '\0') && (*p != '"')) {
p++;
}
} else {
argv[i] = p;
while (*p != '\0' && !isspace(*p)) {
p++;
}
}
if (*p != '\0') {
*p = '\0';
p++;
}
}
argv[i] = NULL;
argc = i;
Tcl_Main(argc, argv, Tcl_AppInit);
return 0; /* Needed only to prevent compiler warning. */
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppInit --
*
* This procedure performs application-specific initialization.
* Most applications, especially those that incorporate additional
* packages, will have their own version of this procedure.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
* message in interp->result if an error occurs.
*
* Side effects:
* Depends on the startup script.
*
*----------------------------------------------------------------------
*/
int
Tcl_AppInit(interp)
Tcl_Interp *interp; /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Dp_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
return TCL_OK;
}

134
tcl-dp/win/dpInit.c Normal file
View File

@@ -0,0 +1,134 @@
/*
* dpInit.c --
*
* Perform UNIX-specific initialization of DP.
*
* Copyright (c) 1995-1996 The Regents of Cornell University.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
#include "generic/dpPort.h"
#include "generic/dpInt.h"
/*
*----------------------------------------------------------------------
*
* DllEntryPoint --
*
* This wrapper function is used by Windows to invoke the
* initialization code for the DLL. If we are compiling
* with Visual C++, this routine will be renamed to DllMain.
* routine.
*
* Results:
* Returns TRUE;
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
BOOL APIENTRY
DllEntryPoint(hInst, reason, reserved)
HINSTANCE hInst; /* Library instance handle. */
DWORD reason; /* Reason this function is being called. */
LPVOID reserved; /* Not used. */
{
return TRUE;
}
/*
*----------------------------------------------------------------------
*
* DppInit --
*
* Performs Unix-specific interpreter initialization related to the
* dp_library variable.
*
* Results:
* Returns a standard Tcl result. Leaves an error message or result
* in interp->result.
*
* Side effects:
* Sets "dp_library" Tcl variable, runs "tk.tcl" script.
*
*----------------------------------------------------------------------
*/
int
DppInit(interp)
Tcl_Interp *interp;
{
int err;
char str[256];
/*
* (ToDo) Load in the TCL library
*/
/*
* Initialize the Windows Socket library
*/
err = WSAStartup(MAKEWORD(1, 1), &dpStartUpInfo);
switch (err) {
case 0:
/* All is well */
break;
case WSASYSNOTREADY:
Tcl_AppendResult (interp, "Error initializing Tcl-DP: ",
"network subsystem is not ready for network ",
"communication.", NULL);
return TCL_ERROR;
case WSAVERNOTSUPPORTED:
Tcl_AppendResult (interp, "Error initializing Tcl-DP: ",
"The version of Windows Sockets support requested ",
"is not provided by this particular Windows Sockets ",
"implementation.", NULL);
return TCL_ERROR;
case WSAEINVAL:
Tcl_AppendResult (interp, "Error initializing Tcl-DP: ",
"The Windows Sockets version specified by the ",
"application is not supported by this DLL.", NULL);
return TCL_ERROR;
default:
sprintf (str, "%d", err);
Tcl_AppendResult (interp, "Error initializing Tcl-DP: ",
"Unknown error from WSAStartup. Error code is ",
str, ". Please email this error message to ",
"tcl-dp@cs.cornell.edu", NULL);
return TCL_ERROR;
}
/*
* Confirm that the Windows Sockets DLL supports 1.1.
* Note that if the DLL supports versions greater
* than 1.1 in addition to 1.1, it will still return
* 1.1 in wVersion since that is the version we
* requested.
*/
if (LOBYTE(dpStartUpInfo.wVersion) != 1 ||
HIBYTE(dpStartUpInfo.wVersion) != 1 ) {
WSACleanup();
sprintf (str, "%d.%d", LOBYTE(dpStartUpInfo.wVersion),
HIBYTE(dpStartUpInfo.wVersion));
Tcl_AppendResult (interp, "Error initializing Tcl-DP: ",
"Tcl-DP requires at least winsock version 1.1. ",
"Installed winsock.dll has version ", str, NULL);
return TCL_ERROR;
}
return TCL_OK;
}

157
tcl-dp/win/dpPort.h Normal file
View File

@@ -0,0 +1,157 @@
/*
* win/dpPort.h --
*
* This file is included by all of the DP C files. It contains
* information that are specific for the MS Windows environment,
* such as header files and a few other things.
*
* Copyright (c) 1995-1996 The Regents of Cornell University.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
#ifndef _DPWINPORT
#define _DPWINPORT
#include <stdlib.h>
#include <string.h>
#include <errno.h>
/*
* VC++ has an alternate entry point called DllMain, so we need to rename
* our entry point.
*/
# if defined(_MSC_VER)
# define EXPORT(a,b) __declspec(dllexport) a b
# define DllEntryPoint DllMain
# else
# if defined(__BORLANDC__)
# define EXPORT(a,b) a _export b
# else
# define EXPORT(a,b) a b
# endif
# endif
#ifndef _WINSOCKAPI_
# include <winsock.h>
#endif
#define NONBLOCKING(flags) (flags & O_NONBLOCK)
#define DP_INVALID_SOCKET INVALID_SOCKET
#define DP_SOCKET TCL_WIN_SOCKET
#define SERIAL_HANDLE TCL_WIN_FILE
#define DP_SOCKET_ERROR SOCKET_ERROR
#define DP_INADDR_NONE INADDR_NONE
#define ASYNC_CONNECT_ERROR EWOULDBLOCK
#define DP_INADDR_ANY INADDR_ANY
#ifdef _TCL80
typedef ClientData FileHandle;
typedef struct SocketInfo {
Tcl_Channel channel; /* Channel associated with this socket. */
SOCKET socket; /* Windows SOCKET handle. */
int flags; /* Bit field comprised of the flags*/
int watchEvents; /* OR'ed combination of FD_READ, ,*/
int selectEvents; /* OR'ed combination of FD_READ, ,*/
int readyEvents; /* OR'ed combination of FD_READ, ,*/
int lastError; /* Error code from last message. */
struct SocketInfo *nextPtr; /* The next socket on the global socket*/
} SocketInfo;
typedef struct SocketEvent {
Tcl_Event header; /* Information that is standard for */
SOCKET socket; /* Socket descriptor that is ready. Use*/
} SocketEvent;
EXTERN HWND hwnd;
EXTERN int initd;
EXTERN SocketInfo *dpSocketList;
#define SOCKET_MESSAGE WM_USER+1
#define SOCKET_ASYNC (1<<0) /* The socket is in blocking mode. */
#define SOCKET_EOF (1<<1) /* A zero read happened on
* the socket. */
#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async connect. */
#define SOCKET_PENDING (1<<3) /* A message has been sent
* for this socket */
int SocketEventProc(Tcl_Event *evPtr, int flags);
void SocketExitHandler(ClientData clientData);
void InitDpSockets(void);
void SocketSetupProc(ClientData data, int flags);
void SocketCheckProc(ClientData data, int flags);
SocketInfo *NewSocketInfo(SOCKET socket);
LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam,
LPARAM lParam);
int SockGetFile(ClientData instanceData, int direction,
FileHandle *handlePtr);
int SockClose(ClientData instanceData, Tcl_Interp *interp);
int SockBlockMode(ClientData instanceData, int mode);
void SockWatch(ClientData instanceData, int mask);
int UdpIpmOutput(ClientData instanceData, char *buf, int toWrite,
int *errorCodePtr);
#endif
/*
* The following are abstract types for socket handles and IP addresses
*/
typedef SOCKET DpSocket;
typedef struct sockaddr DpSocketAddress;
typedef struct sockaddr_in DpSocketAddressIP;
typedef HANDLE SerialHandle;
/*
* The following structure is initialized by WSAStartup in DppInit().
* It contains general information about the winsock library and
* underlying network. It contains the following elements:
*
* WORD wVersion The version number that we're using
* (two bytes)
* WORD wHighVersion The highest version # supported by dll
* char szDescription[] A description of the Windows Sockets
* implementation, including vendor
* identification. Can contain
* any characters.
* char szSystemStatus[] Relevant status or configuration
* information.
* unsigned short iMaxSockets The maximum number of sockets
* which a single process can potentially
* open.
* unsigned short iMaxUdpDg The size in bytes of the largest UDP
* datagram that can be sent or received
* by a Windows Sockets application.
* If the implementation imposes no
* limit, iMaxUdpDg is zero.
* char FAR * lpVendorInfo A pointer to a vendor-specific data
* structure. See Programming with
* Sockets in the Win32 SDK documentation.
*/
WSADATA dpStartUpInfo;
/*
* Serial Port stuff
*/
/*
* Type of parity - these constants may also be
* defined in winbase.h so if they are already defined
* we don't bother....
*/
#if !defined(PARITY_NONE)
# define PARITY_NONE 0
# define PARITY_ODD 1
# define PARITY_EVEN 2
#endif
#endif /* _DPWINPORT */

722
tcl-dp/win/dpSerial.c Normal file
View File

@@ -0,0 +1,722 @@
/*
* win/dpSerial.c
*
* Win32 Tcl_Channel implementation for serial ports
*/
#include "generic/dpPort.h"
#include "generic/dpInt.h"
/*
* This is a Tcl function that is not exported but
* is very handy for error reporting so we use it
* anyhow.
*/
extern void TclWinConvertError(DWORD errCode);
#define MAX_LENGTH 10
#define NUM_PORTS 4
static char *portNames[NUM_PORTS] = {
"COM1",
"COM2",
"COM3",
"COM4"
};
static unsigned long serialCount = 0;
int DppOpenSerialChannel _ANSI_ARGS_((Tcl_Interp *interp,
ClientData instanceData, char *devStr, int flags));
int DppSerialBlock _ANSI_ARGS_((ClientData instanceData,
int mode));
int DppSerialClose _ANSI_ARGS_((ClientData instanceData));
int DppSerialInput _ANSI_ARGS_((ClientData instanceData,
char *bufPtr, int bufSize, int *errorCodePtr));
int DppSerialOutput _ANSI_ARGS_((ClientData instanceData,
char *bufPtr, int toWrite, int *errorCodePtr));
int DppSerialSetOption _ANSI_ARGS_((ClientData instanceData,
int optionName, int val));
int DppSerialGetOption _ANSI_ARGS_((ClientData instanceData,
int opt, char *optionName,
Tcl_DString *dsPtr));
int DppSerialFileReady _ANSI_ARGS_((ClientData instanceData,
int mask));
void DppSerialWatchFile _ANSI_ARGS_((ClientData instanceData,
int mask));
static char * DppBaudRateConsToStr _ANSI_ARGS_((int rate));
static int DppBaudRateNumToCons _ANSI_ARGS_((int rate));
static char * DppCheckDevice _ANSI_ARGS_((char *devStr));
/* ------------------------------------------------
*
* DppOpenSerialChannel -
*
* Creates a DP channel using the serial port specified
* in dev (i.e. "COM1" or "COM2")
*
* We do not allow nonblocking IO since we are not
* multithreaded.
*
* Returns
*
* Tcl_Channel used for I/O.
*
* Side Effects
*
* Memory allocated.
*
* ------------------------------------------------
*/
int
DppOpenSerialChannel(interp, instanceData, devStr, flags)
Tcl_Interp *interp;
ClientData instanceData;
char *devStr; /* (in) device to use */
int flags; /* Bit 0: block Bit 1: read-only */
{
SerialState *ssPtr = (SerialState *) instanceData;
char *openStr;
HANDLE fd;
DCB dcb;
char channelName[10];
Tcl_Channel chan;
int mode = GENERIC_WRITE;
if ((openStr = DppCheckDevice(devStr)) == NULL) {
Tcl_AppendResult(interp, "Unknown device \"", devStr, "\"", NULL);
return TCL_ERROR;
}
if (flags & 0x2) {
mode = 0;
}
fd = CreateFile(openStr, GENERIC_READ | mode,
0, NULL, OPEN_EXISTING, 0, NULL);
if (fd == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
Tcl_AppendResult(interp, "Error opening ", openStr, ": ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
/*
* Setup serial port to a default configuration
*/
GetCommState(fd, &dcb);
if (!BuildCommDCB("19200,N,8,1", &dcb)) {
goto error;
}
SetCommState(fd, &dcb);
ssPtr->fd = fd;
strcpy(ssPtr->deviceName, devStr);
/*
* Set blocking mode for port
*/
if (DppSerialSetOption((ClientData)ssPtr, DP_BLOCK, flags & 0x1)
== TCL_ERROR) {
goto error;
}
return TCL_OK;
error:
TclWinConvertError(GetLastError());
Tcl_AppendResult(interp, "Error configuring serial device: ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
/* --------------------------------------------------
*
* DppSerialBlock --
*
* Sets serial channel to block or not.
*
* Our non-blocking implementation is a bit
* strange. We are not using some sort of
* callback/event mechanism but rather
* emulating not blocking by simply reading
* all we can at that moment and returning it.
* The user MUST check to make sure the entire
* message was received when reading or else
* turning blocking on.
*
* Returns
*
* TCL_OK or TCL_ERROR
*
* Side Effects
*
* None.
*
* ---------------------------------------------------
*/
int
DppSerialBlock(instanceData, mode)
ClientData instanceData;
int mode;
{
if (mode == TCL_MODE_BLOCKING) {
return DppSerialSetOption(instanceData, DP_BLOCK, 1);
} else {
return DppSerialSetOption(instanceData, DP_BLOCK, 0);
}
}
/* --------------------------------------------------
*
* SerialClose --
*
* Closes the serial port and frees memory
* associated with the port.
*
* Returns
*
* TCL_OK or TCL_ERROR
*
* Side Effects
*
* Channel is no longer available.
*
* ---------------------------------------------------
*/
int
DppSerialClose(instanceData)
ClientData instanceData;
{
SerialState *ssPtr = (SerialState *) instanceData;
BOOL rc;
FlushFileBuffers(ssPtr->fd);
rc = CloseHandle(ssPtr->fd);
ckfree((char *)ssPtr);
if (!rc) {
return TCL_ERROR;
} else {
return TCL_OK;
}
}
/* --------------------------------------------------
*
* SerialInput --
*
* Reads upto bufSize bytes from serial port
* into buf.
*
* Returns
*
* Number of bytes read or -1 with Win32 error code
* in errorCodePtr.
*
* Side Effects
*
* buf is modified.
*
* -------------------------------------------------
*/
int
DppSerialInput(instanceData, bufPtr, bufSize, errorCodePtr)
ClientData instanceData;
char *bufPtr;
int bufSize;
int *errorCodePtr;
{
BOOL rc;
DWORD amount;
SerialState *ssPtr = (SerialState *) instanceData;
rc = ReadFile(ssPtr->fd, bufPtr, bufSize, &amount, NULL);
if (!rc) {
TclWinConvertError(GetLastError());
*errorCodePtr = Tcl_GetErrno();
return -1;
}
if (!amount) {
// We read no data.
// Check to see if we are in non-blocking mode
// and return an EAGAIN error if we are...
COMMTIMEOUTS cto;
GetCommTimeouts(ssPtr->fd, &cto);
if (cto.ReadIntervalTimeout == MAXDWORD) {
*errorCodePtr = EAGAIN;
} else {
TclWinConvertError(GetLastError());
*errorCodePtr = Tcl_GetErrno();
}
return -1;
}
return amount;
}
/* --------------------------------------------------
*
* SerialOutput --
*
* Sends toWrite bytes out through the serial
* port.
*
* Returns
*
* Number of bytes written or -1 and a POSIX
* error in errorCodePtr.
*
* Side Effects
*
* None.
*
* ---------------------------------------------------
*/
int
DppSerialOutput(instanceData, bufPtr, toWrite, errorCodePtr)
ClientData instanceData;
char *bufPtr;
int toWrite;
int *errorCodePtr;
{
BOOL rc;
DWORD amount;
SerialState *ssPtr = (SerialState *) instanceData;
rc = WriteFile(ssPtr->fd, bufPtr, toWrite, &amount, NULL);
if (!rc) {
TclWinConvertError(GetLastError());
*errorCodePtr = Tcl_GetErrno();
return -1;
}
if (!amount) {
// We wrote no data.
// Check to see if we are in non-blocking mode
// and return an EAGAIN error if we are...
COMMTIMEOUTS cto;
GetCommTimeouts(ssPtr->fd, &cto);
if (cto.ReadIntervalTimeout == MAXDWORD) {
*errorCodePtr = EAGAIN;
} else {
TclWinConvertError(GetLastError());
*errorCodePtr = Tcl_GetErrno();
}
return -1;
}
FlushFileBuffers(ssPtr->fd);
return amount;
}
/* --------------------------------------------------
*
* Dpp_SetSerialState --
*
* Platform-specific serial option changer.
*
* Returns
*
* TCL_OK or TCL_ERROR
*
* Side Effects
*
* None.
*
* ---------------------------------------------------
*/
int
DppSerialSetOption(instanceData, optionName, val)
ClientData instanceData;
int optionName;
int val;
{
SerialState *ssPtr = (SerialState *) instanceData;
DCB settings;
int rate;
COMMTIMEOUTS cto;
if (!GetCommState(ssPtr->fd, &settings)) {
return TCL_ERROR;
}
switch (optionName) {
case DP_PARITY:
if (val == PARITY_NONE) {
settings.fParity = FALSE;
settings.Parity = NOPARITY;
} else {
settings.fParity = TRUE;
if (val == PARITY_EVEN) {
settings.Parity = EVENPARITY;
} else {
settings.Parity = ODDPARITY;
}
}
break;
case DP_CHARSIZE:
if (val == 7) {
settings.ByteSize = 7;
} else {
settings.ByteSize = 8;
}
break;
case DP_STOPBITS:
if (val == 1) {
settings.StopBits = ONESTOPBIT;
} else {
settings.StopBits = TWOSTOPBITS;
}
break;
case DP_BAUDRATE:
rate = DppBaudRateNumToCons(val);
if (rate == -1) {
char baud[7];
sprintf(baud, "%ld", val);
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
}
settings.BaudRate = rate;
break;
case DP_BLOCK:
memset(&cto, 0, sizeof(COMMTIMEOUTS));
if (val == 1) {
/*
* We want to block.
* A read has numbytes * 1 s to complete
* before the system will return an error.
*
* A byte MUST arrive at least every 3 seconds
* during the read or we will timeout with
* an error.
*/
cto.ReadTotalTimeoutMultiplier = 1000;
cto.ReadIntervalTimeout = 3000;
} else {
/*
* This line will set the serial port to:
* READ - Return as much as possible without blocking
* WRITE - Write buf then return
*/
cto.ReadIntervalTimeout = MAXDWORD;
}
SetCommTimeouts(ssPtr->fd, &cto);
return TCL_OK;
default:
return TCL_ERROR;
}
if (!SetCommState(ssPtr->fd, &settings)) {
return TCL_ERROR;
}
return TCL_OK;
}
/* ----------------------------------------------------
*
* DppBaudRateNumToCons --
*
* Changes a numeric rate into a baudrate constant
* understood by the platform.
*
* Returns
*
* The baudrate constant or -1 on error.
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
int
DppBaudRateNumToCons(rate)
int rate;
{
switch (rate) {
case 1200:
return CBR_1200;
case 2400:
return CBR_2400;
case 4800:
return CBR_4800;
case 9600:
return CBR_9600;
case 19200:
return CBR_19200;
case 38400:
return CBR_38400;
case 57600:
return CBR_57600;
case 115200:
return CBR_115200;
default:
return -1;
}
}
/* ----------------------------------------------------
*
* DppSerialGetOption --
*
* Returns the value of the given option in dsPtr.
*
* Returns
*
* TCL_OK or TCL_ERROR
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
int
DppSerialGetOption(instanceData, opt, optionName, dsPtr)
ClientData instanceData;
int opt;
char *optionName;
Tcl_DString *dsPtr;
{
DCB commState;
SerialState *ssPtr = (SerialState *) instanceData;
char *rate;
COMMTIMEOUTS cto;
GetCommState(ssPtr->fd, &commState);
switch (opt) {
case DP_PARITY:
if (commState.Parity == EVENPARITY) {
Tcl_DStringAppend(dsPtr, "even", -1);
} else if (commState.Parity == ODDPARITY) {
Tcl_DStringAppend(dsPtr, "odd", -1);
} else if (commState.Parity == NOPARITY) {
Tcl_DStringAppend(dsPtr, "none", -1);
} else {
return TCL_ERROR;
}
return TCL_OK;
case DP_BAUDRATE:
rate = DppBaudRateConsToStr(commState.BaudRate);
Tcl_DStringAppend(dsPtr, rate, -1);
return TCL_OK;
case DP_CHARSIZE:
if (commState.ByteSize == 7) {
Tcl_DStringAppend(dsPtr, "7", -1);
} else {
Tcl_DStringAppend(dsPtr, "8", -1);
}
return TCL_OK;
case DP_STOPBITS:
if (commState.StopBits == ONESTOPBIT) {
Tcl_DStringAppend(dsPtr, "1", -1);
} else {
Tcl_DStringAppend(dsPtr, "2", -1);
}
return TCL_OK;
case DP_BLOCK:
GetCommTimeouts(ssPtr->fd, &cto);
if (cto.ReadIntervalTimeout < MAXDWORD) {
Tcl_DStringAppend(dsPtr, "true", -1);
} else {
Tcl_DStringAppend(dsPtr, "false", -1);
}
return TCL_OK;
case DP_DEVICENAME:
Tcl_DStringAppend(dsPtr, ssPtr->deviceName, -1);
return TCL_OK;
default:
{
char errStr[128];
sprintf(errStr, "bad option \"%s\": must be -blocking,"
"-buffering, -buffersize, -eofchar, -translation,"
" or a channel type specific option", optionName);
Tcl_DStringAppend(dsPtr, errStr, -1);
}
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
}
}
/* ----------------------------------------------------
*
* DppBaudRateConsToStr --
*
* Translates a Win32 baudrate constant to a
* human-readable string.
*
* Returns
*
* Pointer to the string representing the baudrate.
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
char *
DppBaudRateConsToStr(rate)
int rate;
{
switch (rate) {
case CBR_1200:
return "1200";
case CBR_2400:
return "2400";
case CBR_4800:
return "4800";
case CBR_9600:
return "9600";
case CBR_19200:
return "19200";
case CBR_38400:
return "38400";
case CBR_57600:
return "57600";
case CBR_115200:
return "115200";
default:
return NULL;
}
}
/* ----------------------------------------------------
*
* DppCheckDevice --
*
* Verifies that "checkStr" is a valid serial
* device on the OS or the DP naming method of
* "serialx". In Win32, we assume a device is
* any of the form "COMx" where x is a single
* digit number. If the name is given as
* "serialx", we translate it into the OS term.
*
* Returns
*
* TCL_OK and updates devStr if checkStr is valid or
* TCL_ERROR if checkStr is invalid.
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
char *
DppCheckDevice(devStr)
char *devStr;
{
int num;
if (strlen(devStr) == 7) {
if (_strnicmp(devStr, "serial", 6) == 0) {
num = devStr[6] - '1';
if ((num < 0) || (num > 3)) {
return NULL;
}
return portNames[num];
}
}
return NULL;
}
/* ----------------------------------------------------
*
* DppSerialWatchFile --
*
* Sets up event handling on the serial channel.
* We jsut set the event mask on the given handle.
*
* Returns
*
* Immediately.
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
void
DppSerialWatchFile(instanceData, mask)
ClientData instanceData;
int mask;
{
SerialState *ssPtr = (SerialState *) instanceData;
DWORD evts = 0;
if (mask & TCL_READABLE) {
evts |= EV_RXCHAR;
}
if (mask & TCL_WRITABLE) {
evts |= EV_TXEMPTY;
}
if (mask & TCL_EXCEPTION) {
evts |= EV_ERR;
}
SetCommMask(ssPtr->fd, evts);
}
/* ----------------------------------------------------
*
* DppSerialFileReady --
*
* Waits for an event to happen on the serial port.
* CAUTION!!!!
* This is different than the Tcl specs because
* there is no way to see what events have
* already happened: we MUST block until a new
* event takes place.
*
* Returns
*
* A mask of events.
*
* Side Effects
*
* None.
*
* -----------------------------------------------------
*/
int
DppSerialFileReady(instanceData, mask)
ClientData instanceData;
int mask;
{
SerialState *ssPtr = (SerialState *) instanceData;
OVERLAPPED ovStr;
DWORD evts;
DWORD events = 0;
GetCommMask(ssPtr->fd, &evts);
WaitCommEvent(ssPtr->fd, &evts, &ovStr);
if (evts & EV_RXCHAR) {
events |= TCL_READABLE;
}
if (evts & EV_TXEMPTY) {
events |= TCL_WRITABLE;
}
if (evts & EV_ERR) {
events |= TCL_EXCEPTION;
}
return events;
}

910
tcl-dp/win/dpSock.c Normal file
View File

@@ -0,0 +1,910 @@
/*
* win/dpSock.c --
*
* This file implements the few windows-specific routines for the
* socket code.
*
* Copyright (c) 1995-1996 Cornell University.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
#include "generic/dpInt.h"
#include "generic/dpPort.h"
#ifndef _TCL76
SocketInfo *dpSocketList;
int initd = FALSE;
HWND hwnd;
/*
*--------------------------------------------------------------
*
* DppSetupSocketEvents --
*
* Initializes a new socket structure and the events
* we are interested in handling.
*
* Results:
* None
*
* Side effects:
* This puts the socket in non-blocking mode
*
*--------------------------------------------------------------
*/
void
DppSetupSocketEvents(statePtr, sock, async, server)
SocketState *statePtr;
DpSocket sock;
int async;
int server;
{
SocketInfo *infoPtr;
infoPtr = NewSocketInfo(sock);
statePtr->sockInfo = infoPtr;
/*
* Set up the select mask for read/write events. If the connect
* attempt has not completed, include connect events.
*/
if (server) {
infoPtr->selectEvents = FD_ACCEPT;
infoPtr->watchEvents |= FD_ACCEPT;
} else {
infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
infoPtr->watchEvents |= FD_READ | FD_WRITE | FD_CLOSE;
if (async) {
infoPtr->flags |= SOCKET_ASYNC_CONNECT;
infoPtr->selectEvents |= FD_CONNECT;
}
}
/*
* Register for interest in events in the select mask. Note that
* automatically places the socket into non-blocking mode.
*/
(void) WSAAsyncSelect(infoPtr->socket, hwnd,
SOCKET_MESSAGE, infoPtr->selectEvents);
}
/*
*--------------------------------------------------------------
*
* SocketSetupProc --
*
* Scans for a ready socket.
*
* Results:
* None
*
* Side effects:
* Might set the event loop to poll.
*
*--------------------------------------------------------------
*/
void
SocketSetupProc(data, flags)
ClientData data; /* Not used. */
int flags; /* Event flags as passed to Tcl_DoOneEvent. */
{
SocketInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Check to see if there is a ready socket. If so, poll.
*/
for (infoPtr = dpSocketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->readyEvents & infoPtr->watchEvents) {
Tcl_SetMaxBlockTime(&blockTime);
break;
}
}
}
/*
*--------------------------------------------------------------
*
* NewSocketInfo --
*
* Creates and initialized a new socket structure.
*
* Results:
* None
*
* Side effects:
* Memory is allocated.
*
*--------------------------------------------------------------
*/
SocketInfo *
NewSocketInfo(socket)
SOCKET socket;
{
SocketInfo *infoPtr;
infoPtr = (SocketInfo *) ckalloc(sizeof(SocketInfo));
infoPtr->socket = socket;
infoPtr->flags = 0;
infoPtr->watchEvents = 0;
infoPtr->readyEvents = 0;
infoPtr->selectEvents = 0;
infoPtr->lastError = 0;
infoPtr->nextPtr = dpSocketList;
dpSocketList = infoPtr;
return infoPtr;
}
/*
*--------------------------------------------------------------
*
* SocketCheckProc --
*
* Finds a socket with an event to process and queues
* an event if one is found.
*
* Results:
* None
*
* Side effects:
* An event handler might execute later.
*
*--------------------------------------------------------------
*/
void
SocketCheckProc(data, flags)
ClientData data; /* Not used. */
int flags; /* Event flags as passed to Tcl_DoOneEvent. */
{
SocketInfo *infoPtr;
SocketEvent *evPtr;
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Queue events for any ready sockets that don't already have events
* queued (caused by persistent states that won't generate WinSock
* events).
*/
for (infoPtr = dpSocketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if ((infoPtr->readyEvents & infoPtr->watchEvents)
&& !(infoPtr->flags & SOCKET_PENDING)) {
infoPtr->flags |= SOCKET_PENDING;
evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
evPtr->socket = infoPtr->socket;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
}
/*
*--------------------------------------------------------------
*
* WaitForSocketEvent --
*
* Waits for one of the specified events to occur on the
* socket.
*
* Results:
* None
*
* Side effects:
* Blocks until event happens.
*
*--------------------------------------------------------------
*/
int
WaitForSocketEvent(infoPtr, events, errorCodePtr)
SocketInfo *infoPtr; /* Information about this socket. */
int events; /* Events to look for. */
int *errorCodePtr; /* Where to store errors? */
{
MSG msg;
int result = 1;
int oldMode;
/*
* Be sure to disable event servicing so we are truly modal.
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
while (!(infoPtr->readyEvents & events)) {
if (infoPtr->flags & SOCKET_ASYNC) {
if (!PeekMessage(&msg, hwnd, SOCKET_MESSAGE,
SOCKET_MESSAGE, PM_REMOVE)) {
*errorCodePtr = EWOULDBLOCK;
result = 0;
break;
}
} else {
/*
* Look for a socket event. Note that we will be getting
* events for all of Tcl's sockets, not just the one we wanted.
*/
result = GetMessage(&msg, hwnd, SOCKET_MESSAGE,
SOCKET_MESSAGE);
if (result == -1) {
TclWinConvertError(GetLastError());
*errorCodePtr = Tcl_GetErrno();
result = 0;
break;
}
/*
* I don't think we can get a WM_QUIT during a tight modal
* loop, but just in case...
*/
if (result == 0) {
panic("WaitForSocketEvent: Got WM_QUIT during modal loop!");
}
}
/*
* Dispatch the message and then check for an error on the socket.
*/
infoPtr->lastError = 0;
DispatchMessage(&msg);
if (infoPtr->lastError) {
*errorCodePtr = infoPtr->lastError;
result = 0;
break;
}
}
(void) Tcl_SetServiceMode(oldMode);
return result;
}
/*
*--------------------------------------------------------------
*
* SocketEventProc --
*
* Translates the Windows socket event into a Tcl
* channel event and notifies the channel.
*
* Results:
* None
*
* Side effects:
* Channel handler will execute.
*
*--------------------------------------------------------------
*/
int
SocketEventProc(evPtr, flags)
Tcl_Event *evPtr; /* Event to service. */
int flags; /* Flags that indicate what events to
* handle, such as TCL_FILE_EVENTS. */
{
SocketInfo *infoPtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
int mask = 0;
u_long nBytes;
int status, events;
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
}
/*
* Find the specified socket on the socket list.
*/
for (infoPtr = dpSocketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->socket == eventPtr->socket) {
break;
}
}
/*
* Discard events that have gone stale.
*/
if (!infoPtr) {
return 1;
}
infoPtr->flags &= ~SOCKET_PENDING;
/*
* Handle connection requests directly.
*
*/
if (infoPtr->readyEvents & FD_ACCEPT) {
mask |= TCL_READABLE;
Tcl_NotifyChannel(infoPtr->channel, mask);
return 1;
}
/*
* Mask off unwanted events and compute the read/write mask so
* we can notify the channel.
*/
events = infoPtr->readyEvents & infoPtr->watchEvents;
if (events & FD_CLOSE) {
/*
* If the socket was closed and the channel is still interested
* in read events, then we need to ensure that we keep polling
* for this event until someone does something with the channel.
* Note that we do this before calling Tcl_NotifyChannel so we don't
* have to watch out for the channel being deleted out from under
* us. This may cause a redundant trip through the event loop, but
* it's simpler than trying to do unwind protection.
*/
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
mask |= TCL_READABLE;
} else if (events & FD_READ) {
/*
* We must check to see if data is really available, since someone
* could have consumed the data in the meantime.
*/
status = ioctlsocket(infoPtr->socket, FIONREAD, &nBytes);
if (status != SOCKET_ERROR && nBytes > 0) {
mask |= TCL_READABLE;
} else {
/*
* We are in a strange state, probably because someone
* besides Tcl is reading from this socket. Try to
* recover by clearing the read event.
*/
infoPtr->readyEvents &= ~(FD_READ);
/*
* Re-issue WSAAsyncSelect() since we are gobbling up an
* event, without letting the reader do any I/O to re-enable
* the notification.
*/
(void) WSAAsyncSelect(infoPtr->socket, hwnd,
SOCKET_MESSAGE, infoPtr->selectEvents);
}
}
if (events & FD_WRITE) {
mask |= TCL_WRITABLE;
}
if (mask) {
infoPtr->readyEvents &= ~FD_WRITE;
Tcl_NotifyChannel(infoPtr->channel, mask);
}
return 1;
}
/*
*--------------------------------------------------------------
*
* SocketExitHandler --
*
* Cleans up the entire DP socket subsystem.
*
* Results:
* None
*
* Side effects:
* Sockets are no longer viable.
*
*--------------------------------------------------------------
*/
void
SocketExitHandler(clientData)
ClientData clientData; /* Not used. */
{
DestroyWindow(hwnd);
UnregisterClass("DpSocket", TclWinGetTclInstance());
Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
/*
*--------------------------------------------------------------
*
* SocketProc --
*
* This is the Windows callback which recv's
* notification of socket events. It marks the
* socket and tells Tcl to service events.
*
* Results:
* None
*
* Side effects:
* Event handling will commence.
*
*--------------------------------------------------------------
*/
LRESULT CALLBACK
SocketProc(hwnd, message, wParam, lParam)
HWND hwnd;
UINT message;
WPARAM wParam;
LPARAM lParam;
{
int event, error;
SOCKET socket;
SocketInfo *infoPtr;
if (message != SOCKET_MESSAGE) {
return DefWindowProc(hwnd, message, wParam, lParam);
}
event = WSAGETSELECTEVENT(lParam);
error = WSAGETSELECTERROR(lParam);
socket = (SOCKET) wParam;
/*
* Find the specified socket on the socket list and update its
* eventState flag.
*/
for (infoPtr = dpSocketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->socket == socket) {
/*
* Update the socket state.
*/
if (event & FD_CLOSE) {
infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
}
if (event & FD_CONNECT) {
/*
* The socket is now connected, so clear the async connect
* flag.
*/
infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
/*
* Remember any error that occurred so we can report
* connection failures.
*/
if (error != ERROR_SUCCESS) {
TclWinConvertWSAError(error);
infoPtr->lastError = Tcl_GetErrno();
}
}
infoPtr->readyEvents |= event;
break;
}
}
/*
* Flush the Tcl event queue before returning to the event loop.
*/
Tcl_ServiceAll();
return 0;
}
/*
*--------------------------------------------------------------
*
* InitDpSockets --
*
* Initializes DP's socket subsystem.
*
* Results:
* None
*
* Side effects:
* A hidden window is created and a window class
* is registered.
*
*--------------------------------------------------------------
*/
void
InitDpSockets()
{
WNDCLASS class;
Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
/*
* Create the async notification window with a new class. We
* must create a new class to avoid a Windows 95 bug that causes
* us to get the wrong message number for socket events if the
* message window is a subclass of a static control.
*/
class.style = 0;
class.cbClsExtra = 0;
class.cbWndExtra = 0;
class.hInstance = TclWinGetTclInstance();
class.hbrBackground = NULL;
class.lpszMenuName = NULL;
class.lpszClassName = "DpSocket";
class.lpfnWndProc = SocketProc;
class.hIcon = NULL;
class.hCursor = NULL;
if (RegisterClass(&class)) {
hwnd = CreateWindow("DpSocket", "DpSocket", WS_TILED, 0, 0,
0, 0, NULL, NULL, class.hInstance, NULL);
} else {
hwnd = NULL;
}
if (hwnd == NULL) {
TclWinConvertError(GetLastError());
return;
}
Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
return;
}
/*
*--------------------------------------------------------------
*
* SockWatch --
*
* Sets up which events to watch for on this socket.
*
* Results:
* None
*
* Side effects:
* Events on this socket are now watched for.
*
*--------------------------------------------------------------
*/
void
SockWatch (instanceData, mask)
ClientData instanceData;
int mask;
{
SocketState *statePtr = (SocketState *) instanceData;
SocketInfo *infoPtr = (SocketInfo *) instanceData;
/*
* Update the watch events mask.
*/
infoPtr->watchEvents = 0;
if (mask & TCL_READABLE) {
infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
}
if (mask & TCL_WRITABLE) {
infoPtr->watchEvents |= (FD_WRITE);
}
/*
* If there are any conditions already set, then tell
* the notifier to poll rather than block.
*/
if (infoPtr->readyEvents & infoPtr->watchEvents) {
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
}
}
/*
*--------------------------------------------------------------
*
* SockBlockMode --
*
* Sets the socket to blocking or non-blocking.
*
* Results:
* Zero always.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
SockBlockMode (instanceData, mode)
ClientData instanceData; /* Pointer to SocketState struct */
int mode; /* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */
{
SocketState *statePtr = (SocketState *)instanceData;
SocketInfo *infoPtr = statePtr->sockInfo;
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= SOCKET_ASYNC;
} else {
infoPtr->flags &= ~(SOCKET_ASYNC);
}
return 0;
}
/*
*--------------------------------------------------------------
*
* SockClose --
*
* This function is called by the Tcl channel driver when the
* caller want to close the socket. It releases the instanceData
* and closes the socket. All queued output will have been flushed
* to the device before this function is called.
*
* Results:
* Zero for success, otherwise a nonzero POSIX error code and,
* if interp is not NULL, an error message in interp->result
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
SockClose (instanceData, interp)
ClientData instanceData; /* (in) Pointer to tcpState struct */
Tcl_Interp *interp; /* (in) For error reporting */
{
SocketState *statePtr = (SocketState *)instanceData;
SocketInfo *infoPtr = statePtr->sockInfo;
SocketInfo **nextPtrPtr;
int result;
result = closesocket(statePtr->sock);
if ((result != 0) && (interp != NULL)) {
DppGetErrno();
Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_STATIC);
}
for (nextPtrPtr = &dpSocketList; (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
(*nextPtrPtr) = infoPtr->nextPtr;
break;
}
}
/*
* IPM only
*/
if (statePtr->flags & SOCKET_IPM) {
Tcl_DStringFree(&statePtr->groupList);
}
ckfree((char *) infoPtr);
ckfree((char *) statePtr);
return result;
}
/*
*--------------------------------------------------------------
*
* SockGetFile --
*
* Called from Tcl_GetChannelFile to retrieve the handle
* from inside a socket based channel.
*
* Results:
* TCL_OK
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
SockGetFile(instanceData, direction, handlePtr)
ClientData instanceData;
int direction;
FileHandle *handlePtr;
{
SocketState *statePtr = (SocketState *)instanceData;
*handlePtr = statePtr->sockFile;
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* UdpIpmOutput --
*
* This function is called by the Tcl channel driver whenever
* the user wants to send output to a UDP/IPM socket.
* The function writes toWrite bytes from buf to the socket.
*
* Results:
* A nonnegative integer indicating how many bytes were written
* to the socket. The return value is normally the same as toWrite,
* but may be less in some cases such as if the output operation
* is interrupted by a signal.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
UdpIpmOutput(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* (in) Pointer to udpState struct */
char *buf; /* (in) Buffer to write */
int toWrite; /* (in) Number of bytes to write */
int *errorCodePtr; /* (out) POSIX error code (if any) */
{
SocketState *statePtr = (SocketState *) instanceData;
SocketInfo *infoPtr = statePtr->sockInfo;
int result;
int error;
while (1) {
#ifdef UDPDEBUG
{
char msg[1024];
memcpy(msg, buf, toWrite);
msg[toWrite] = '\0';
printf("Sending UDP data: %s\n", msg);
}
#endif
result = sendto(statePtr->sock, buf, toWrite, 0,
(struct sockaddr *) &statePtr->sockaddr,
sizeof(statePtr->sockaddr));
if (result != SOCKET_ERROR) {
/*
* Since Windows won't generate a new write event until we hit
* an overflow condition, we need to force the event loop to
* poll until the condition changes.
*/
if (infoPtr->watchEvents & FD_WRITE) {
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
}
break;
}
/*
* Check for error condition or overflow. In the event of overflow, we
* need to clear the FD_WRITE flag so we can detect the next writable
* event. Note that Windows only sends a new writable event after a
* send fails with WSAEWOULDBLOCK.
*/
error = WSAGetLastError();
if (error == WSAEWOULDBLOCK) {
infoPtr->readyEvents &= ~(FD_WRITE);
if (infoPtr->flags & SOCKET_ASYNC) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
} else {
TclWinConvertWSAError(error);
*errorCodePtr = Tcl_GetErrno();
return -1;
}
/*
* In the blocking case, wait until the file becomes writable
* or closed and try again.
*/
if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
return -1;
}
}
return result;
}
#endif
/*
*--------------------------------------------------------------
*
* DppSetBlock --
*
* Put the socket into a blocking or non-blocking state.
* Note that the way Microsoft phrases it, turning off
* blocking requires a "1" (enabling non-blocking mode...)
* <sigh>
*
* Results:
* None
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
DppSetBlock (sock, block)
DpSocket sock;
int block;
{
int result;
u_long val = 0;
if (block) {
/* Set blocking mode */
result = ioctlsocket(sock, FIONBIO, &val);
} else {
/* Set non-blocking mode */
val = 1;
result = ioctlsocket(sock, FIONBIO, &val);
}
return result;
}
/*
*--------------------------------------------------------------
*
* DppCloseSocket --
*
* Closes the Windows socket.
*
* Results:
* None
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int DppCloseSocket(sock)
DpSocket sock;
{
return closesocket(sock);
}
/*
*--------------------------------------------------------------
*
* DppGetErrno --
*
* Returns the value of the errno variable for the last error
* that occurred.
*
* Results:
* POSIX error number.
*
* Side effects:
* Changes the Tcl global variable errno.
*
*--------------------------------------------------------------
*/
int
DppGetErrno ()
{
int err;
int posix;
err = WSAGetLastError();
TclWinConvertWSAError(err);
posix = Tcl_GetErrno();
return posix;
}

848
tcl-dp/win/dpWinIPM.c Normal file
View File

@@ -0,0 +1,848 @@
/*
* dpIPM.c --
*
* This file implements the generic code for an IP multicasting
* channel driver. These are channels that are created by
* evaluating "dp_connect ipm".
*
* Copyright (c) 1995-1996 Cornell University.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
#include "generic/dpInt.h"
#ifndef IN_MULTICAST
/*
* This just checks to make sure the IP address is a valid
* IP multicast address: 224.0.0.0 < addr < 239.255.255.255
*/
#define IN_MULTICAST(i) (((i) & 0xf0000000) == 0xe0000000)
#endif
/*
* The default send and receive buffer size.
*/
#define DP_IPM_SENDBUFSIZE 8192
#define DP_IPM_RECVBUFSIZE 8192
typedef SocketState IpmState;
#define PEEK_MODE (1<<1) /* Read without consuming? */
#define ASYNC_CONNECT (1<<2) /* Asynchronous connection? */
#define IS_SERVER (1<<3) /* Is this a server Ipm socket? */
/*
* Procedures that are used in this file only.
*/
static IpmState * CreateIPMSocket _ANSI_ARGS_((Tcl_Interp *interp,
int ipAddr, int port, int ttl));
static int IpmInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int bufSize, int *errorCodePtr));
static int IpmOutput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCodePtr));
static int IpmSetOption _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
char *optionValue));
static int IpmGetOption _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
Tcl_DString *dsPtr));
static Tcl_ChannelType ipmChannelType = {
"ipm", /* Name of channel */
SockBlockMode, /* Proc to set blocking mode on socket */
SockClose, /* Proc to close a socket */
IpmInput, /* Proc to get input from a socket */
UdpIpmOutput, /* Proc to send output to a socket */
NULL, /* Can't seek on a socket! */
IpmSetOption, /* Proc to set a socket option */
IpmGetOption, /* Proc to set a socket option */
SockWatch, /* Proc called to set event loop wait params */
SockGetFile /* Proc to return a handle assoc with socket */
};
static int ipmCount = 0; /* Number of ipm files opened -- used to
* generate unique ids for channels */
/*
*--------------------------------------------------------------
*
* DpOpenIpmChannel --
*
* Opens a new channel that uses the IPM protocol.
*
* Results:
* Returns a pointer to the newly created Tcl_Channel. This
* is the structure with all the function pointers Tcl needs
* to communicate with (read, write, close, etc) the channel.
*
* Side effects:
* A socket is created with the specified port. No other
* socket can use that port until this channel is closed.
*
*--------------------------------------------------------------
*/
Tcl_Channel
DpOpenIpmChannel(interp, argc, argv)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
#ifdef NO_MULTICAST_DEF
Tcl_AppendResult(interp, "IP multicast is not available on this system",
NULL);
return NULL;
#else
Tcl_Channel chan;
IpmState *statePtr = NULL;
char channelName[20];
char *groupName, *str;
char **av;
int i, ac;
/*
* The default values for the value-option pairs
*/
int ipAddr = 0;
int port = 0;
int ttl = 1;
/*
* Flags to indicate that a certain option has been set by the
* command line
*/
int setGroup = 0;
int setPort = 0;
if (!initd) {
InitDpSockets();
initd = TRUE;
}
for (i=0; i<argc; i+=2) {
int v = i+1;
size_t len = strlen(argv[i]);
if (strncmp(argv[i], "-group", len)==0) {
if (v==argc) {goto arg_missing;}
if (!DpHostToIpAddr(argv[v], &ipAddr)) {
Tcl_AppendResult (interp, "Illegal value for -group \"",
argv[v], "\"", NULL);
return NULL;
}
groupName = argv[v];
setGroup = 1;
} else if (strncmp(argv[i], "-myport", len)==0) {
if (v==argc) {goto arg_missing;}
if (Tcl_GetInt(interp, argv[v], &port) != TCL_OK) {
return NULL;
}
if (port < 0) {
Tcl_AppendResult(interp, "expected non-negative integer ",
"but got \"", argv[v], "\"", NULL);
return NULL;
}
setPort = 1;
} else if (strncmp(argv[i], "-ttl", len)==0) {
if (v==argc) {goto arg_missing;}
if (Tcl_GetInt(interp, argv[v], &ttl) != TCL_OK) {
return NULL;
}
} else {
Tcl_AppendResult(interp, "unknown option \"",
argv[i], "\", must be -group, ",
"-myport or -ttl", NULL);
return NULL;
}
}
/*
* Check the options that must or must not be specified, depending on
* the -server option.
*/
if (!setGroup) {
Tcl_AppendResult(interp, "option -group must be specified",
NULL);
return NULL;
}
if (!setPort) {
Tcl_AppendResult(interp, "option -myport must be specified",
NULL);
return NULL;
}
/*
* Create a new socket and wrap it in a channel.
*/
statePtr = CreateIPMSocket(interp, ipAddr, port, ttl);
if (statePtr == NULL) {
return NULL;
}
sprintf(channelName, "ipm%d", ipmCount++);
chan = Tcl_CreateChannel(&ipmChannelType, channelName,
(ClientData)statePtr, TCL_READABLE|TCL_WRITABLE);
Tcl_RegisterChannel(interp, chan);
DppSetupSocketEvents(statePtr, statePtr->sock, 0, 0);
statePtr->sockInfo->channel = chan;
ac = 1;
av = &groupName;
str = Tcl_Merge(ac, av);
Tcl_DStringAppendElement(&statePtr->groupList, str);
ckfree(str);
if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
if (Tcl_SetChannelOption(interp, chan, "-blocking", "1") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
if (Tcl_SetChannelOption(interp, chan, "-buffering", "none") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
return chan;
arg_missing:
Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", NULL);
return NULL;
#endif
}
/*
*----------------------------------------------------------------------
*
* CreateIPMSocket --
*
* This function opens a new socket in client mode
* and initializes the IpmState structure.
*
* Results:
* Returns a new IpmState, or NULL with an error in interp->result,
* if interp is not NULL.
*
* Side effects:
* Opens a socket.
*
*----------------------------------------------------------------------
*/
static IpmState *
CreateIPMSocket(interp, group, port, ttl)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int group; /* IP address of the multicast group. */
int port; /* Port number. */
int ttl; /* Time to live value. */
{
IpmState * statePtr = NULL;
DpSocket sock;
if (!IN_MULTICAST(group)) {
Tcl_AppendResult(interp, "No such IP multicast group", NULL);
return NULL;
}
/*
* Create the socket
*/
sock = socket(AF_INET, SOCK_DGRAM, 0);
if (sock == DP_SOCKET_ERROR) {
goto error;
}
statePtr = (IpmState *)ckalloc(sizeof(IpmState));
statePtr->interp = interp;
statePtr->groupPort = port;
statePtr->groupAddr = group;
statePtr->sock = sock;
statePtr->sockFile = (ClientData)sock;
Tcl_DStringInit(&statePtr->groupList);
/*
* Bind the socket
*/
memset(&statePtr->sockaddr, 0, sizeof(statePtr->sockaddr));
statePtr->sockaddr.sin_family = AF_INET;
statePtr->sockaddr.sin_port = htons((unsigned short) port);
statePtr->sockaddr.sin_addr.s_addr = htonl(INADDR_ANY);
if (DpIpmSetSocketOption(statePtr, DP_REUSEADDR, 1) != 0) {
goto error;
}
if (bind(sock, (struct sockaddr *) &statePtr->sockaddr,
sizeof(statePtr->sockaddr)) != 0) {
goto error;
}
statePtr->sockaddr.sin_addr.s_addr = htonl(group);
statePtr->groupPort = (int) ntohs(statePtr->sockaddr.sin_port);
/*
* On some older machines, we need to ask for multicast
* permission.
*/
if (DpIpmSetSocketOption(statePtr, DP_BROADCAST, 1) != 0) {
goto error;
}
/*
* Make this an IPM socket by setting the socket options. Also, set
* other default options of this socket, such as buffer size.
*/
if (DpIpmSetSocketOption(statePtr, DP_ADD_MEMBERSHIP, group) != 0) {
goto error;
}
if (DpIpmSetSocketOption(statePtr, DP_MULTICAST_TTL, ttl) != 0) {
goto error;
}
if (DpIpmSetSocketOption(statePtr, DP_MULTICAST_LOOP, 1) != 0) {
goto error;
}
if (DpIpmSetSocketOption(statePtr, DP_RECV_BUFFER_SIZE,
DP_IPM_RECVBUFSIZE) != 0) {
goto error;
}
if (DpIpmSetSocketOption(statePtr, DP_SEND_BUFFER_SIZE,
DP_IPM_SENDBUFSIZE) != 0) {
goto error;
}
return statePtr;
error:
/*
* Translate Windows Socket error to POSIX errorcode
*/
DppGetErrno();
Tcl_AppendResult(interp, "Error creating IPM socket: ",
Tcl_PosixError(interp), NULL);
if (statePtr) {
if (statePtr->sock != DP_SOCKET_ERROR) {
DppCloseSocket(statePtr->sock);
}
ckfree((char*)statePtr);
}
return NULL;
}
/*
*--------------------------------------------------------------
*
* IpmInput --
*
* This function is called by the Tcl channel driver whenever the
* user wants to get input from the IPM socket. If the socket
* has some data available but less than requested by the bufSize
* argument, we only read as much data as is available and return
* without blocking. If the socket has no data available
* whatsoever and is blocking, we block until at least one byte
* of data can be read from the socket.
*
* Results:
* A nonnegative integer indicating how many bytes were read, or
* DP_SOCKET_ERROR in case of error (with errorCodePtr set to the
* POSIX error code).
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
static int
IpmInput(instanceData, buf, bufSize, errorCodePtr)
ClientData instanceData; /* (in) Pointer to ipmState struct */
char *buf; /* (in/out) Buffer to fill */
int bufSize; /* (in) Size of buffer */
int *errorCodePtr; /* (out) POSIX error code (if any) */
{
IpmState *statePtr = (IpmState *)instanceData;
SocketInfo *infoPtr = statePtr->sockInfo;
DpSocketAddressIP fromAddr;
int bytesRead, fromLen;
unsigned int fromHost, fromPort;
char str[64];
while (1) {
if (infoPtr->readyEvents & (FD_CLOSE|FD_READ)) {
fromLen = sizeof(fromAddr);
bytesRead = recvfrom(statePtr->sock, buf, bufSize, 0,
(DpSocketAddress *)&fromAddr, &fromLen);
statePtr->sockInfo->readyEvents &= ~(FD_READ);
if (bytesRead < 0) {
int error;
error = WSAGetLastError();
TclWinConvertWSAError(error);
if ((infoPtr->flags & SOCKET_ASYNC) ||
(error != WSAEWOULDBLOCK)) {
*errorCodePtr = Tcl_GetErrno();
return -1;
}
}
break;
} else if (infoPtr->flags & SOCKET_ASYNC) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
/*
* In the blocking case, wait until the file becomes readable
* or closed and try again.
*/
if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
return -1;
}
}
if (statePtr->interp != NULL) {
fromHost = ntohl(fromAddr.sin_addr.s_addr);
fromPort = ntohs(fromAddr.sin_port);
sprintf (str, "{%d.%d.%d.%d %d}", (fromHost>>24),
(fromHost>>16) & 0xFF, (fromHost>>8) & 0xFF,
fromHost & 0xFF, fromPort);
Tcl_SetVar(statePtr->interp, "dp_from", str, TCL_GLOBAL_ONLY);
}
return bytesRead;
}
/*
*--------------------------------------------------------------
*
* IpmSetOption --
*
* This function is called by the Tcl channel driver
* whenever Tcl evaluates and fconfigure call to set
* some property of the ipm socket (e.g., the buffer
* size). The valid options are "sendBuffer" and
* "recvBuffer"
*
* Results:
* Standard Tcl return value.
*
* Side effects:
* Depends on the option. Generally changes the maximum
* message size that can be sent/received.
*
*--------------------------------------------------------------
*/
static int
IpmSetOption (instanceData, interp, optionName, optionValue)
ClientData instanceData;
Tcl_Interp *interp;
char *optionName;
char *optionValue;
{
int option;
int value;
char c;
int rc;
IpmState *statePtr = (IpmState *)instanceData;
/*
* Set the option specified by optionName
*/
if (optionName[0] == '-') {
option = DpTranslateOption(optionName+1);
} else {
option = -1;
}
switch (option) {
case DP_REUSEADDR:
if (Tcl_GetBoolean(interp, optionValue, &value) != TCL_OK) {
return TCL_ERROR;
}
return DpIpmSetSocketOption(statePtr, option, value);
case DP_RECV_BUFFER_SIZE:
case DP_SEND_BUFFER_SIZE:
if (Tcl_GetInt(interp, optionValue, &value) != TCL_OK) {
return TCL_ERROR;
}
if (value <=0) {
Tcl_AppendResult(interp, "Buffer size must be > 0", NULL);
return TCL_ERROR;
}
return DpIpmSetSocketOption(statePtr, option, value);
case DP_GROUP:
c = optionValue[0];
if (c != '+' && c != '-') {
Tcl_AppendResult (interp, "Expected an add/drop token. ",
"Please see docs on how to add/drop a group.", NULL);
return TCL_ERROR;
}
if (DpHostToIpAddr (&optionValue[1], &value) == 0) {
Tcl_AppendResult (interp,
"Expected IP address or hostname but got \"",
optionValue, "\"", NULL);
return TCL_ERROR;
}
if (c == '+') {
option = DP_ADD_MEMBERSHIP;
} else {
option = DP_DROP_MEMBERSHIP;
}
rc = DpIpmSetSocketOption(statePtr, option, value);
if (rc == 0) {
/*
* Update the group list
*/
if (option == DP_ADD_MEMBERSHIP) {
Tcl_DStringAppendElement(&statePtr->groupList,
&optionValue[1]);
} else {
int argc, i, j = 0;
char **argv;
Tcl_SplitList(interp,
Tcl_DStringValue(&statePtr->groupList),
&argc, &argv);
for (i=0;i<argc;i++) {
if (!strcmp(argv[i], &optionValue[1])) {
while (i<argc) {
argv[i] = argv[i+1];
i++;
}
j = 1;
break;
}
}
if (!j) {
Tcl_AppendResult(interp, "Group address not found",
"in list", NULL);
return TCL_ERROR;
} else {
Tcl_DStringFree(&statePtr->groupList);
Tcl_DStringInit(&statePtr->groupList);
Tcl_DStringAppend(&statePtr->groupList,
Tcl_Merge(argc-1, argv), -1);
}
}
}
return rc;
case DP_MULTICAST_LOOP:
Tcl_AppendResult(interp, "Loopback may not be turned off in Windows.",
NULL);
return TCL_ERROR;
case DP_MYPORT:
Tcl_AppendResult(interp, "Port may not be changed",
" after creation.", NULL);
return TCL_ERROR;
default:
Tcl_AppendResult (interp, "bad option \"", optionName,
"\": must be -recvBuffer, -reuseAddr, -group, ",
"-sendBuffer or a standard fconfigure option", NULL);
return TCL_ERROR;
}
}
/*
*--------------------------------------------------------------
*
* IpmGetOption --
*
* This function is called by the Tcl channel code to
* retrieve a parameter of the socket (e.g., a buffer size).
* The valid options are "sendBuffer" and "recvBuffer"
*
* Results:
* A standard Tcl result
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
static int
IpmGetOption (instanceData,
interp,
optionName, dsPtr)
ClientData instanceData;
Tcl_Interp *interp;
char *optionName;
Tcl_DString *dsPtr;
{
int option;
unsigned int value = 0xFFFFFFFF;
char str[256];
IpmState *statePtr = (IpmState *)instanceData;
/*
* If optionName is NULL, then return all options in option-value
* pairs.
*/
if (optionName == NULL) {
Tcl_DStringAppend (dsPtr, " -recvBuffer ", -1);
IpmGetOption(instanceData, interp, "-recvBuffer", dsPtr);
Tcl_DStringAppend (dsPtr, " -reuseAddr ", -1);
IpmGetOption(instanceData, interp, "-reuseAddr", dsPtr);
Tcl_DStringAppend (dsPtr, " -sendBuffer ", -1);
IpmGetOption(instanceData, interp, "-sendBuffer", dsPtr);
Tcl_DStringAppend (dsPtr, " -loopback ", -1);
IpmGetOption(instanceData, interp, "-loopback", dsPtr);
Tcl_DStringAppend (dsPtr, " -group ", -1);
IpmGetOption(instanceData, interp, "-group", dsPtr);
Tcl_DStringAppend (dsPtr, " -myport ", -1);
IpmGetOption(instanceData, interp, "-myport", dsPtr);
return TCL_OK;
}
/*
* Retrive the value of the option specified by optionName
*/
if (optionName[0] == '-') {
option = DpTranslateOption(&optionName[1]);
} else {
option = -1;
}
switch (option) {
case DP_RECV_BUFFER_SIZE:
case DP_SEND_BUFFER_SIZE:
if (DpIpmGetSocketOption(statePtr, option, &value) != 0) {
return TCL_ERROR;
}
sprintf (str, "%d", value);
Tcl_DStringAppend(dsPtr, str, -1);
break;
case DP_REUSEADDR:
if (DpIpmGetSocketOption(statePtr, option, &value) != 0) {
return TCL_ERROR;
}
if (value) {
/*
* Some systems returns a non-zero value (not necessarily 1)
* to indicate "true".
*/
value = 1;
}
sprintf (str, "%d", value);
Tcl_DStringAppend(dsPtr, str, -1);
break;
case DP_GROUP:
Tcl_DStringAppend(dsPtr, Tcl_DStringValue(&statePtr->groupList),
Tcl_DStringLength(&statePtr->groupList));
break;
case DP_MYPORT:
sprintf(str, "%d", statePtr->groupPort);
Tcl_DStringAppend(dsPtr, str, -1);
break;
case DP_MULTICAST_LOOP:
Tcl_DStringAppend(dsPtr, "1", -1);
break;
default:
Tcl_AppendResult(interp,
"bad option \"", optionName,"\": must be -blocking,",
" -buffering, -buffersize, -eofchar, -translation,"
" or a channel type specific option", NULL);
Tcl_SetErrno (EINVAL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* DpIpmSetSocketOption --
*
* Sets a socket option. The allowable options for Ipm
* sockets are
* DP_SEND_BUFFER_SIZE (int)
* DP_RECV_BUFFER_SIZE (int)
* DP_BLOCK (T/F)
*
* Results:
* Zero if the operation was successful, or a nonzero POSIX
* error code if the operation failed.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
DpIpmSetSocketOption(statePtr, option, value)
IpmState *statePtr; /* (in) IpmState structure */
int option; /* (in) Option to set */
int value; /* (in) new value for option */
{
int sock, result = -2;
struct ip_mreq mreq;
struct linger l;
/*
* NT 3.5 seems to have a bug when passing a size of char down.
* It comes back with an error indicating a segfault. When
* increased to the size of an int, everything seems to be OK.
* Pad on both sides of the value so NT doesn't segfault.
*/
unsigned char buf[8], *p;
p = buf+sizeof(int);
*p = (unsigned char)value;
sock = statePtr->sock;
switch (option) {
case DP_ADD_MEMBERSHIP:
if (!IN_MULTICAST(value)) {
Tcl_SetErrno(EINVAL);
return -1;
}
mreq.imr_multiaddr.s_addr = htonl(value);
mreq.imr_interface.s_addr = htonl(INADDR_ANY);
result = setsockopt(sock, IPPROTO_IP, IP_ADD_MEMBERSHIP,
(char *)&mreq, sizeof(mreq));
break;
case DP_DROP_MEMBERSHIP:
mreq.imr_multiaddr.s_addr = htonl(value);
mreq.imr_interface.s_addr = htonl(INADDR_ANY);
result = setsockopt(sock, IPPROTO_IP, IP_DROP_MEMBERSHIP,
(char *)&mreq, sizeof(mreq));
break;
case DP_BLOCK:
result = DppSetBlock (sock, value);
break;
case DP_BROADCAST:
result = setsockopt(sock, SOL_SOCKET, SO_BROADCAST,
(char *)&value, sizeof(value));
break;
case DP_MULTICAST_TTL:
result = setsockopt(sock, IPPROTO_IP, IP_MULTICAST_TTL,
(char *)&value, sizeof(int));
break;
case DP_MULTICAST_LOOP:
result = 0;
break;
case DP_RECV_BUFFER_SIZE:
result = setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&value,
sizeof(value));
break;
case DP_REUSEADDR:
result = setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *)&value,
sizeof(value));
break;
case DP_SEND_BUFFER_SIZE:
result = setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&value,
sizeof(value));
break;
default:
return EINVAL;
}
if (result != 0) {
return DppGetErrno();
}
return 0;
}
/*
*--------------------------------------------------------------
*
* DpIpmGetSocketOption --
*
* Sets a socket option. The allowable options for Ipm
* sockets are
* DP_SEND_BUFFER_SIZE (int)
* DP_RECV_BUFFER_SIZE (int)
* Note that we can't determine whether a socket is blocking,
* so DP_BLOCK is not allowed.
*
* Results:
* Zero if the operation was successful, or a nonzero POSIX
* error code if the operation failed.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
DpIpmGetSocketOption (statePtr, option, valuePtr)
IpmState *statePtr; /* (in) IpmState structure */
int option; /* (in) Option to set */
int *valuePtr; /* (out) current value of option */
{
int sock, result, len;
struct linger l;
char p;
sock = statePtr->sock;
len = sizeof(int);
switch (option) {
case DP_RECV_BUFFER_SIZE:
result = getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)valuePtr,
&len);
break;
case DP_REUSEADDR:
result = getsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *)valuePtr,
&len);
break;
case DP_SEND_BUFFER_SIZE:
result = getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)valuePtr,
&len);
break;
case DP_MULTICAST_LOOP:
/*
* This call should only happen in Unix since it is invalid
* under Windows. IpmGetOption should have caught it.
*/
printf("DpIpmGetSocketOption panic.\n");
exit(-1);
break;
default:
return EINVAL;
}
if (result != 0) {
return DppGetErrno();
}
return 0;
}

1289
tcl-dp/win/dpWinTcp.c Normal file
View File

File diff suppressed because it is too large Load Diff

716
tcl-dp/win/dpWinUDP.c Normal file
View File

@@ -0,0 +1,716 @@
/*
* generic/dpUdp.c --
*
* This file implements the generic code for a udp channel driver. These
* are channels that are created by evaluating "dp_connect udp".
*
* The architecture consists of a generic layer and a platform specific
* layer. The rational is that platform specific code goes in its layer,
* while platform independent code goes in its layer. However, most
* socket implementations use the Berkeley sockets interface, which is
* similar across platforms with a few annoying differences. These are
* separated into two files, dpSockUdp.c contains the generic socket code,
* which makes calls on routines in win/dpSock.c, which contains the
* platform specific code. We retain the two level architecture, though,
* so non-Berkeley socket interfaces can be built (if any still exist).
*
* Copyright (c) 1995-1996 Cornell University.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
#include "generic/dpInt.h"
#include "generic/dpPort.h"
static int UdpInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int bufSize,
int *errorCodePtr));
static int UdpOutput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite,
int *errorCodePtr));
static int UdpSetOption _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
char *optionValue));
static int UdpGetOption _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
Tcl_DString *dsPtr));
typedef SocketState UdpState;
static Tcl_ChannelType udpChannelType = {
"udp", /* Name of channel */
SockBlockMode, /* Proc to set blocking mode on socket */
SockClose, /* Proc to close a socket */
UdpInput, /* Proc to get input from a socket */
UdpIpmOutput, /* Proc to send output to a socket */
NULL, /* Can't seek on a socket! */
UdpSetOption, /* Proc to set a socket option */
UdpGetOption, /* Proc to set a socket option */
SockWatch, /* Proc called to set event loop wait params */
SockGetFile /* Proc to return a handle assoc with socket */
};
#define PEEK_MODE (1<<1) /* Read without consuming? */
static int udpCount = 0; /* Number of udp files opened -- used to
* generate unique ids for channels */
/*
*--------------------------------------------------------------
*
* DpOpenUdpChannel --
*
* Opens a new channel that uses the UDP protocol.
*
* Results:
* Returns a pointer to the newly created Tcl_Channel. This
* is the structure with all the function pointers Tcl needs
* to communicate with (read, write, close, etc) the channel.
*
* Side effects:
* A socket is created with the specified port. No other
* socket can use that port until this channel is closed.
*
*--------------------------------------------------------------
*/
Tcl_Channel
DpOpenUdpChannel(interp, argc, argv)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
Tcl_Channel chan;
UdpState *statePtr;
char channelName[20];
int i, result;
/*
* The default values for the value-option pairs
*/
int hostIp = 0;
int port = 0;
int myIpAddr = DP_INADDR_ANY;
int myport = 0;
if (!initd) {
InitDpSockets();
initd = TRUE;
}
for (i=0; i<argc; i+=2) {
int v = i+1;
size_t len = strlen(argv[i]);
if (strncmp(argv[i], "-host", len)==0) {
if (v==argc) {goto arg_missing;}
if (!DpHostToIpAddr (argv[v], &hostIp)) {
Tcl_AppendResult (interp, "Unknown host \"", argv[v],
"\"", NULL);
return NULL;
}
} else if (strncmp(argv[i], "-port", len)==0) {
if (v==argc) {goto arg_missing;}
if (Tcl_GetInt(interp, argv[v], &port) != TCL_OK) {
return NULL;
}
if (port <= 0) {
Tcl_AppendResult (interp, "Port number must be > 0", NULL);
return NULL;
}
} else if (strncmp(argv[i], "-myaddr", len)==0) {
if (v==argc) {goto arg_missing;}
if (strcmp (argv[v], "any") == 0) {
myIpAddr = DP_INADDR_ANY;
} else if (!DpHostToIpAddr (argv[v], &myIpAddr)) {
Tcl_AppendResult (interp, "Illegal value for -myaddr \"",
argv[v], "\"", NULL);
return NULL;
}
} else if (strncmp(argv[i], "-myport", len)==0) {
if (v==argc) {goto arg_missing;}
if (Tcl_GetInt(interp, argv[v], &myport) != TCL_OK) {
return NULL;
}
if (myport <= 0) {
Tcl_AppendResult (interp,
"Port number for -myport must be > 0", NULL);
return NULL;
}
} else {
Tcl_AppendResult(interp, "unknown option \"",
argv[i], "\", must be -host, -myaddr, -myport ",
"or -port", NULL);
return NULL;
}
}
/*
* Create a new socket and wrap it in a channel.
*/
statePtr = (UdpState *)ckalloc(sizeof(UdpState));
memset(statePtr, 0, sizeof(UdpState));
statePtr->flags = 0;
statePtr->interp = interp;
statePtr->myPort = myport;
result = CreateUdpSocket(interp, myIpAddr, statePtr);
statePtr->sockaddr.sin_port = htons((unsigned short)port);
statePtr->sockaddr.sin_family = AF_INET;
statePtr->sockaddr.sin_addr.s_addr = htonl(hostIp);
if (result != TCL_OK) {
ckfree((char *)statePtr);
return NULL;
}
sprintf(channelName, "udp%d", udpCount++);
chan = Tcl_CreateChannel(&udpChannelType, channelName,
(ClientData)statePtr, TCL_READABLE|TCL_WRITABLE);
DppSetupSocketEvents(statePtr, statePtr->sock, 0, 0);
Tcl_RegisterChannel(interp, chan);
statePtr->sockInfo->channel = chan;
/*
* Set the initial state of the channel.
* Make sure the socket's blocking, set the default buffer sizes,
* set the destination address as specified, disable Tcl buffering
* and translation.
*/
DpUdpSetSocketOption(statePtr, DP_SEND_BUFFER_SIZE, 8192);
DpUdpSetSocketOption(statePtr, DP_RECV_BUFFER_SIZE, 8192);
DpUdpGetSocketOption(statePtr, DP_RECV_BUFFER_SIZE,
&statePtr->recvBufSize);
if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
if (Tcl_SetChannelOption(interp, chan, "-blocking", "1") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
if (Tcl_SetChannelOption(interp, chan, "-buffering", "none") !=
TCL_OK) {
DpClose(interp, chan);
ckfree((char *)statePtr);
return NULL;
}
return chan;
arg_missing:
Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing", NULL);
return NULL;
}
/*
*--------------------------------------------------------------
*
* DpCreateUdpSocket --
*
* Create a udp socket.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
CreateUdpSocket(interp, myIpAddr, statePtr)
Tcl_Interp *interp; /* (in) For error reporting. */
int myIpAddr; /* (in) IP addr of interface to use.
* DP_INADDR_ANY = default port */
UdpState *statePtr; /* (out) Pointer to local structure */
{
DpSocketAddressIP sockAddr;
DpSocket sock;
int len;
sock = socket(PF_INET, SOCK_DGRAM, 0);
if (sock == DP_SOCKET_ERROR) {
goto socketError;
}
statePtr->sock = sock;
/*
* Bind the socket.
* This is a bit of a mess, but it's Berkeley sockets. The sin_family
* is set to AF_INET, indicating IP addressing. The sin_addr.s_addr
* field says what interface to use. It can be INADDR_ANY to let
* the system choose a default interface. The port number can be
* zero (which tells the system to choose a port number) or > 1024,
* which is then used as the port number
*/
memset(&statePtr->sockaddr, 0, sizeof(statePtr->sockaddr));
statePtr->sockaddr.sin_family = AF_INET;
statePtr->sockaddr.sin_port =
htons((unsigned short) statePtr->myPort);
statePtr->sockaddr.sin_addr.s_addr =
(myIpAddr == DP_INADDR_ANY ? INADDR_ANY : htonl(myIpAddr));
if (bind(sock, (DpSocketAddress *)&statePtr->sockaddr,
sizeof(statePtr->sockaddr)) == DP_SOCKET_ERROR) {
goto bindError;
}
/*
* Figure out what port number we got if we let the system chose it.
*/
if (statePtr->myPort == 0) {
len = sizeof(sockAddr);
getsockname (sock, (DpSocketAddress *)&sockAddr, &len);
statePtr->myPort = ntohs(sockAddr.sin_port);
}
statePtr->sockFile = (ClientData)statePtr->sock;
return TCL_OK;
bindError:
DppGetErrno();
Tcl_AppendResult(interp, "Error binding UDP socket to port: ",
Tcl_PosixError(interp), NULL);
DppCloseSocket (sock);
return TCL_ERROR;
socketError:
DppGetErrno();
Tcl_AppendResult(interp, "Error creating UDP socket: ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
* UdpInput --
*
* This function is called by the Tcl channel driver whenever
* the user wants to get input from the UDP socket.
* If the socket has some data available but
* less than requested by the bufSize argument, we only read
* as much data as is available and return without blocking.
* If the socket has no data available whatsoever and is
* blocking, we block until at least one byte of data can be
* read from the socket.
*
* Results:
* A nonnegative integer indicating how many bytes were read,
* or -1 in case of error (with errorCodePtr set to the POSIX
* error code).
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
static int
UdpInput (instanceData, buf, bufSize, errorCodePtr)
ClientData instanceData; /* (in) Pointer to udpState struct */
char *buf; /* (in/out) Buffer to fill */
int bufSize; /* (in) Size of buffer */
int *errorCodePtr; /* (out) POSIX error code (if any) */
{
UdpState *statePtr = (UdpState *)instanceData;
SocketInfo *infoPtr = statePtr->sockInfo;
int peek;
int fromHost, fromPort;
char str[256];
DpSocketAddressIP fromAddr;
int bytesRead, flags = 0, fromLen;
peek = (statePtr->flags & PEEK_MODE);
if (peek) {
flags = MSG_PEEK;
} else {
flags = 0;
}
while (1) {
if (infoPtr->readyEvents & (FD_CLOSE|FD_READ)) {
fromLen = sizeof(fromAddr);
bytesRead = recvfrom(statePtr->sock, buf, bufSize, flags,
(DpSocketAddress *)&fromAddr, &fromLen);
#ifdef UDPDEBUG
{
char msg[1024];
memcpy(msg, buf, bytesRead);
msg[bytesRead] = '\0';
printf("Received UDP data: %s\n", msg);
}
#endif
statePtr->sockInfo->readyEvents &= ~(FD_READ);
if (bytesRead < 0) {
int error;
error = WSAGetLastError();
TclWinConvertWSAError(error);
if ((infoPtr->flags & SOCKET_ASYNC) ||
(error != WSAEWOULDBLOCK)) {
*errorCodePtr = Tcl_GetErrno();
return -1;
}
}
break;
} else if (infoPtr->flags & SOCKET_ASYNC) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
/*
* In the blocking case, wait until the file becomes readable
* or closed and try again.
*/
if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
return -1;
}
}
if (statePtr->interp != NULL) {
fromHost = ntohl(fromAddr.sin_addr.s_addr);
fromPort = ntohs(fromAddr.sin_port);
sprintf (str, "{%d.%d.%d.%d %d}", (fromHost>>24),
(fromHost>>16) & 0xFF, (fromHost>>8) & 0xFF,
fromHost & 0xFF, fromPort);
Tcl_SetVar(statePtr->interp, "dp_from", str, TCL_GLOBAL_ONLY);
}
return bytesRead;
}
/*
*--------------------------------------------------------------
*
* UdpSetOption --
*
* This function is called by the Tcl channel driver
* whenever Tcl evaluates and fconfigure call to set
* some property of the udp socket (e.g., the buffer
* size). The valid options are "sendBuffer" and
* "recvBuffer"
*
* Results:
* Standard Tcl return value.
*
* Side effects:
* Depends on the option. Generally changes the maximum
* message size that can be sent/received.
*
*--------------------------------------------------------------
*/
static int
UdpSetOption (instanceData, interp, optionName, optionValue)
ClientData instanceData;
Tcl_Interp *interp;
char *optionName;
char *optionValue;
{
int option;
int value;
UdpState *statePtr = (UdpState *)instanceData;
/*
* Set the option specified by optionName
*/
if (optionName[0] == '-') {
option = DpTranslateOption(optionName+1);
} else {
option = -1;
}
switch (option) {
case DP_SEND_BUFFER_SIZE:
case DP_RECV_BUFFER_SIZE:
if (Tcl_GetInt(interp, optionValue, &value) != TCL_OK) {
return TCL_ERROR;
}
if (value <=0) {
Tcl_AppendResult (interp, "Buffer size must be > 0", NULL);
return TCL_ERROR;
}
return DpUdpSetSocketOption (statePtr, option, value);
case DP_PEEK:
if (Tcl_GetBoolean(interp, optionValue, &value) != TCL_OK) {
return TCL_ERROR;
}
if (value == 0) {
statePtr->flags &= ~PEEK_MODE;
} else {
statePtr->flags |= PEEK_MODE;
}
break;
case DP_HOST:
if (DpHostToIpAddr (optionValue, &value) == 0) {
Tcl_AppendResult (interp,
"Expected IP address or hostname but got \"",
optionValue, "\"", NULL);
return TCL_ERROR;
}
statePtr->sockaddr.sin_addr.s_addr = htonl(value);
break;
case DP_PORT:
if (Tcl_GetInt(interp, optionValue, &value) != TCL_OK) {
return TCL_ERROR;
}
if (value <= 0) {
Tcl_AppendResult (interp, "Port number must be > 0", NULL);
return TCL_ERROR;
}
statePtr->sockaddr.sin_port = htons((unsigned short) value);
break;
case DP_MYPORT:
Tcl_AppendResult (interp, "Can't set port after socket is opened",
NULL);
return TCL_ERROR;
default:
Tcl_AppendResult (interp, "Illegal option \"", optionName,
"\" -- must be sendBuffer, recvBuffer, peek, ",
"host, port, or a standard fconfigure option", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* UdpGetOption --
*
* This function is called by the Tcl channel code to
* retrieve a parameter of the socket (e.g., a buffer size).
* The valid options are "sendBuffer" and "recvBuffer"
*
* Results:
* A standard Tcl result
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
static int
UdpGetOption (instanceData,
interp,
optionName, dsPtr)
ClientData instanceData;
Tcl_Interp *interp;
char *optionName;
Tcl_DString *dsPtr;
{
int option;
int size;
unsigned int addr;
char str[256];
UdpState *statePtr = (UdpState *)instanceData;
/*
* If optionName is NULL, then store an alternating list of
* all supported options and their current values in dsPtr
*/
if (optionName == NULL) {
Tcl_DStringAppend (dsPtr, " -sendBuffer ", -1);
UdpGetOption(instanceData, interp, "-sendBuffer", dsPtr);
Tcl_DStringAppend (dsPtr, " -recvBuffer ", -1);
UdpGetOption(instanceData, interp, "-recvBuffer", dsPtr);
Tcl_DStringAppend (dsPtr, " -peek ", -1);
UdpGetOption(instanceData, interp, "-peek", dsPtr);
Tcl_DStringAppend (dsPtr, " -host ", -1);
UdpGetOption(instanceData, interp, "-host", dsPtr);
Tcl_DStringAppend (dsPtr, " -port ", -1);
UdpGetOption(instanceData, interp, "-port", dsPtr);
Tcl_DStringAppend (dsPtr, " -myport ", -1);
UdpGetOption(instanceData, interp, "-myport", dsPtr);
return TCL_OK;
}
/*
* Retrive the value of the option specified by optionName
*/
if (optionName[0] == '-') {
option = DpTranslateOption(optionName+1);
} else {
option = -1;
}
switch (option) {
case DP_SEND_BUFFER_SIZE:
case DP_RECV_BUFFER_SIZE:
DpUdpGetSocketOption (statePtr, option, &size);
sprintf (str, "%d", size);
Tcl_DStringAppend (dsPtr, str, -1);
break;
case DP_PEEK:
if (statePtr->flags & PEEK_MODE) {
Tcl_DStringAppend (dsPtr, "1", -1);
} else {
Tcl_DStringAppend (dsPtr, "0", -1);
}
break;
case DP_HOST:
addr = ntohl(statePtr->sockaddr.sin_addr.s_addr);
sprintf (str, "%d.%d.%d.%d",
(addr >>24), (addr >>16) & 0xff,
(addr >> 8) & 0xff, (addr) & 0xff);
Tcl_DStringAppend (dsPtr, str, -1);
break;
case DP_PORT:
sprintf (str, "%d", ntohs(statePtr->sockaddr.sin_port));
Tcl_DStringAppend (dsPtr, str, -1);
break;
case DP_MYPORT:
sprintf (str, "%d", (unsigned short) statePtr->myPort);
Tcl_DStringAppend (dsPtr, str, -1);
break;
default:
Tcl_AppendResult(interp,
"bad option \"", optionName,"\": must be -blocking,",
" -buffering, -buffersize, -eofchar, -translation,"
" or a channel type specific option", NULL);
Tcl_SetErrno (EINVAL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* DpUdpSetSocketOption --
*
* Sets a socket option. The allowable options for UDP
* sockets are
* DP_SEND_BUFFER_SIZE (int)
* DP_RECV_BUFFER_SIZE (int)
* DP_BLOCK (T/F)
*
* Results:
* Zero if the operation was successful, or a nonzero POSIX
* error code if the operation failed.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
DpUdpSetSocketOption (clientData, option, value)
ClientData clientData; /* (in) UdpState structure */
int option; /* (in) Option to set */
int value; /* (in) new value for option */
{
UdpState *statePtr = (UdpState *)clientData;
int sock, result;
sock = statePtr->sock;
switch (option) {
case DP_SEND_BUFFER_SIZE:
result = setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&value,
sizeof(value));
break;
case DP_RECV_BUFFER_SIZE:
result = setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&value,
sizeof(value));
break;
case DP_BLOCK:
result = DppSetBlock (sock, value);
break;
default:
return EINVAL;
}
if (result != 0) {
return Tcl_GetErrno();
}
return 0;
}
/*
*--------------------------------------------------------------
*
* DpUdpGetSocketOption --
*
* Sets a socket option. The allowable options for UDP
* sockets are
* DP_SEND_BUFFER_SIZE (int)
* DP_RECV_BUFFER_SIZE (int)
* Note that we can't determine whether a socket is blocking,
* so DP_BLOCK is not allowed.
*
* Results:
* Zero if the operation was successful, or a nonzero POSIX
* error code if the operation failed.
*
* Side effects:
* None
*
*--------------------------------------------------------------
*/
int
DpUdpGetSocketOption (clientData, option, valuePtr)
ClientData clientData; /* (in) UdpState structure */
int option; /* (in) Option to set */
int *valuePtr; /* (out) current value of option */
{
UdpState *statePtr = (UdpState *)clientData;
int sock, result, len;
sock = statePtr->sock;
len = sizeof(int);
switch (option) {
case DP_SEND_BUFFER_SIZE:
result = getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)valuePtr,
&len);
break;
case DP_RECV_BUFFER_SIZE:
result = getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)valuePtr,
&len);
break;
default:
return EINVAL;
}
if (result != 0) {
return Tcl_GetErrno();
}
return 0;
}

199
tcl-dp/win/makefile.76 Normal file
View File

@@ -0,0 +1,199 @@
# Makefile
#
# This makefile builds dp.dll, the dynamically linked library for Tcl-DP.
# This makefile is suitable for use with Microsoft Visual C++ 2.x and 4.0.
#
# Copyright (c) 1995-1996 Cornell University.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# SCCS: @(#) makefile.vc 1.3 96/04/24 13:28:08
#
#
# Project directories -- these may need to be customized for your site
#
# ROOT -- location of the example files.
# GENERIC_DIR -- location for platform independent files.
# WIN_DIR -- location for Windows specific files.
# OBJ_DIR -- location for compiler's object files
# QUIET -- if uncommented, there is virtually no output during compile
#
ROOT = ..
GENERIC_DIR = $(ROOT)\generic
WIN_DIR = .
OBJ_DIR = .\objs
DEBUG_INFO = 1
QUIET = @
#
# The following definitions can be set in the DOS window to suit
# your local configuration.
#
# TOOLS32 location of VC++ compiler installation.
# TCL_GENERIC_DIR location of the Tcl 7.6 "generic" directory.
# DEBUG_INFO if defined, will compile with debug info.
#
# E.g., if your installed VC++ in some other drives, do this in DOS
# window ( or with the help of a batch file):
#
# set TOOLS32=d:\msdev
# nmake -f makefile
#
!IFNDEF TOOLS32
TOOLS32 = c:\msdev
!ENDIF
!IFNDEF TCL_ROOT_DIR
TCL_ROOT_DIR = ..\..\tcl7.6
!ENDIF
!IFNDEF TCL_GENERIC_DIR
TCL_GENERIC_DIR = $(TCL_ROOT_DIR)\generic
!ENDIF
!IFNDEF DEBUG_INFO
NODEBUG=1
!ENDIF
#
# Visual C++ tools
#
PATH=$(TOOLS32)\bin;$(PATH)
cc32 = $(QUIET)$(TOOLS32)\bin\cl
CP = copy
RM = del
INCLUDES = -I$(TOOLS32)\include -I$(TCL_GENERIC_DIR) -I$(ROOT)
DEFINES = -nologo $(DEBUGDEFINES) -D_TCL76
!include <ntwin32.mak>
#
# Global makefile settings
#
OBJS = $(OBJ_DIR)\dpChan.obj \
$(OBJ_DIR)\dpCmds.obj \
$(OBJ_DIR)\dpInit.obj \
$(OBJ_DIR)\dpIPM.obj \
$(OBJ_DIR)\dpUdp.obj \
$(OBJ_DIR)\dpFilters.obj \
$(OBJ_DIR)\dpPlugF.obj \
$(OBJ_DIR)\dpIdentity.obj \
$(OBJ_DIR)\dpPackOff.obj \
$(OBJ_DIR)\dpSerial.obj \
$(OBJ_DIR)\dpSock.obj \
$(OBJ_DIR)\dpTcp.obj \
$(OBJ_DIR)\dpRPC.obj \
$(OBJ_DIR)\dpWinSock.obj \
$(OBJ_DIR)\dpWinSerial.obj \
$(OBJ_DIR)\dpWinInit.obj
DPDLL = dp40.dll
DPSH = dpsh40
# Targets
$(DPDLL): $(OBJ_DIR) $(OBJS)
@set LIB=$(TOOLS32)\lib
$(QUIET)$(link) $(linkdebug) $(dlllflags) $(TCL_ROOT_DIR)\win\tcl76.lib \
Wsock32.lib $(guilibsdll) -out:$(DPDLL) $(OBJS)
$(OBJ_DIR):
-@if not exist .\objs\nul mkdir .\objs
$(DPSH): $(OBJS) $(OBJ_DIR)\dpAppInit.obj
@set LIB=$(TOOLS32)\lib
$(QUIET)$(link) $(linkdebug) $(conlflags) \
-out:$(DPSH).exe $(conlibsdll) $(OBJ_DIR)\dpAppInit.obj \
dp40.lib $(TCL_ROOT_DIR)\win\tcl76.lib
$(OBJ_DIR)\dpAppInit.obj: $(WIN_DIR)\dpAppInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpAppInit.obj $(WIN_DIR)\dpAppInit.c
$(OBJ_DIR)\dpChan.obj: $(GENERIC_DIR)\dpChan.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpChan.obj $(GENERIC_DIR)\dpChan.c
$(OBJ_DIR)\dpCmds.obj: $(GENERIC_DIR)\dpCmds.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpCmds.obj $(GENERIC_DIR)\dpCmds.c
$(OBJ_DIR)\dpFilters.obj: $(GENERIC_DIR)\dpFilters.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpFilters.obj $(GENERIC_DIR)\dpFilters.c
$(OBJ_DIR)\dpPlugF.obj: $(GENERIC_DIR)\dpPlugF.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpPlugF.obj $(GENERIC_DIR)\dpPlugF.c
$(OBJ_DIR)\dpPackOff.obj: $(GENERIC_DIR)\dpPackOff.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpPackOff.obj $(GENERIC_DIR)\dpPackOff.c
$(OBJ_DIR)\dpIdentity.obj: $(GENERIC_DIR)\dpIdentity.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpidentity.obj $(GENERIC_DIR)\dpIdentity.c
$(OBJ_DIR)\dpIPM.obj: $(GENERIC_DIR)\dpIPM.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpIPM.obj $(GENERIC_DIR)\dpIPM.c
$(OBJ_DIR)\dpInit.obj: $(GENERIC_DIR)\dpInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpInit.obj $(GENERIC_DIR)\dpInit.c
$(OBJ_DIR)\dpTcp.obj: $(GENERIC_DIR)\dpTcp.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpTcp.obj $(GENERIC_DIR)\dpTcp.c
$(OBJ_DIR)\dpRPC.obj: $(GENERIC_DIR)\dpRPC.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpRPC.obj $(GENERIC_DIR)\dpRPC.c
$(OBJ_DIR)\dpUdp.obj: $(GENERIC_DIR)\dpUdp.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpUdp.obj $(GENERIC_DIR)\dpUdp.c
$(OBJ_DIR)\dpWinInit.obj: $(WIN_DIR)\dpInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinInit.obj $(WIN_DIR)\dpInit.c
$(OBJ_DIR)\dpSock.obj: $(GENERIC_DIR)\dpSock.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpSock.obj $(GENERIC_DIR)\dpSock.c
$(OBJ_DIR)\dpWinSock.obj: $(WIN_DIR)\dpSock.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinSock.obj $(WIN_DIR)\dpSock.c
$(OBJ_DIR)\dpWinSerial.obj: $(WIN_DIR)\dpSerial.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinSerial.obj $(WIN_DIR)\dpSerial.c
$(OBJ_DIR)\dpSerial.obj: $(GENERIC_DIR)\dpSerial.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpSerial.obj $(GENERIC_DIR)\dpSerial.c
clean:
-@if exist $(OBJ_DIR)\*.obj $(RM) $(OBJ_DIR)\*.obj
-@if exist $(DPDLL) $(RM) $(DPDLL)
-@if exist dp40.lib $(RM) dp40.lib
-@if exist dp40.exp $(RM) dp40.exp
-@if exist pkgIndex.tcl $(RM) pkgIndex.tcl
-@if exist $(DPSH).exe $(RM) $(DPSH).exe
tests: $(DPDLL)
SET DP_TEST_VERBOSE=1
cd ..\tests
$(TCL_ROOT_DIR)\win\tclsh76.exe rpc.test

200
tcl-dp/win/makefile.80 Normal file
View File

@@ -0,0 +1,200 @@
# Makefile
#
# This makefile builds dp.dll, the dynamically linked library for Tcl-DP.
# This makefile is suitable for use with Microsoft Visual C++ 2.x, 4.x and
# 5.x.
#
# Copyright (c) 1995-1996 Cornell University.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# SCCS: @(#) makefile.vc 1.3 96/04/24 13:28:08
#
#
# Project directories -- these may need to be customized for your site
#
# ROOT -- location of the example files.
# GENERIC_DIR -- location for platform independent files.
# WIN_DIR -- location for Windows specific files.
# OBJ_DIR -- location for compiler's object files
# QUIET -- if uncommented, there is virtually no output during compile
#
ROOT = ..
GENERIC_DIR = $(ROOT)\generic
WIN_DIR = .
OBJ_DIR = .\objs
#DEBUG_INFO = 1
#QUIET = @
#
# The following definitions can be set in the DOS window to suit
# your local configuration.
#
# TOOLS32 location of VC++ compiler installation.
# TCL_GENERIC_DIR location of the Tcl 8.0 "generic" directory.
# DEBUG_INFO if defined, will compile with debug info.
#
# E.g., if your installed VC++ in some other drives, do this in DOS
# window ( or with the help of a batch file):
#
# set TOOLS32=d:\msdev
# nmake -f makefile
#
!IFNDEF TOOLS32
TOOLS32 = c:\msdev
!ENDIF
!IFNDEF TCL_ROOT_DIR
TCL_ROOT_DIR = ..\..\tcl8.0
!ENDIF
!IFNDEF TCL_GENERIC_DIR
TCL_GENERIC_DIR = $(TCL_ROOT_DIR)\generic
!ENDIF
!IFNDEF DEBUG_INFO
NODEBUG=1
!ENDIF
#
# Visual C++ tools
#
PATH=$(TOOLS32)\bin;$(PATH)
cc32 = $(QUIET)$(TOOLS32)\bin\cl
CP = copy
RM = del
INCLUDES = -I$(TOOLS32)\include -I$(TCL_GENERIC_DIR) -I$(ROOT)
DEFINES = -nologo $(DEBUGDEFINES) -D_TCL80
!include <ntwin32.mak>
#
# Global makefile settings
#
OBJS = $(OBJ_DIR)\dpChan.obj \
$(OBJ_DIR)\dpCmds.obj \
$(OBJ_DIR)\dpInit.obj \
$(OBJ_DIR)\dpWinIPM.obj \
$(OBJ_DIR)\dpWinUdp.obj \
$(OBJ_DIR)\dpFilters.obj \
$(OBJ_DIR)\dpPlugF.obj \
$(OBJ_DIR)\dpSerial.obj \
$(OBJ_DIR)\dpSock.obj \
$(OBJ_DIR)\dpWinTcp.obj \
$(OBJ_DIR)\dpRPC.obj \
$(OBJ_DIR)\dpIdentity.obj \
$(OBJ_DIR)\dpPackOff.obj \
$(OBJ_DIR)\dpWinSock.obj \
$(OBJ_DIR)\dpWinSerial.obj \
$(OBJ_DIR)\dpWinInit.obj
DPDLL = dp40.dll
DPSH = dpsh40
# Targets
$(DPDLL): $(OBJ_DIR) $(OBJS)
@set LIB=$(TOOLS32)\lib
$(QUIET)$(link) $(linkdebug) $(dlllflags) $(TCL_ROOT_DIR)\win\tcl80.lib \
Wsock32.lib $(guilibsdll) -out:$(DPDLL) $(OBJS)
$(OBJ_DIR):
-@if not exist .\objs\nul mkdir .\objs
$(DPSH): $(OBJS) $(OBJ_DIR)\dpAppInit.obj
@set LIB=$(TOOLS32)\lib
$(QUIET)$(link) $(linkdebug) $(conlflags) \
-out:$(DPSH).exe $(conlibsdll) $(OBJ_DIR)\dpAppInit.obj \
dp40.lib $(TCL_ROOT_DIR)\win\tcl80.lib
$(OBJ_DIR)\dpAppInit.obj: $(WIN_DIR)\dpAppInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpAppInit.obj $(WIN_DIR)\dpAppInit.c
$(OBJ_DIR)\dpChan.obj: $(GENERIC_DIR)\dpChan.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpChan.obj $(GENERIC_DIR)\dpChan.c
$(OBJ_DIR)\dpCmds.obj: $(GENERIC_DIR)\dpCmds.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpCmds.obj $(GENERIC_DIR)\dpCmds.c
$(OBJ_DIR)\dpFilters.obj: $(GENERIC_DIR)\dpFilters.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpFilters.obj $(GENERIC_DIR)\dpFilters.c
$(OBJ_DIR)\dpPlugF.obj: $(GENERIC_DIR)\dpPlugF.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpPlugF.obj $(GENERIC_DIR)\dpPlugF.c
$(OBJ_DIR)\dpWinIPM.obj: $(WIN_DIR)\dpWinIPM.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinIPM.obj $(WIN_DIR)\dpWinIPM.c
$(OBJ_DIR)\dpInit.obj: $(GENERIC_DIR)\dpInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpInit.obj $(GENERIC_DIR)\dpInit.c
$(OBJ_DIR)\dpWinTcp.obj: $(WIN_DIR)\dpWinTcp.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinTcp.obj $(WIN_DIR)\dpWinTcp.c
$(OBJ_DIR)\dpRPC.obj: $(GENERIC_DIR)\dpRPC.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpRPC.obj $(GENERIC_DIR)\dpRPC.c
$(OBJ_DIR)\dpWinUDP.obj: $(WIN_DIR)\dpWinUDP.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinUDP.obj $(WIN_DIR)\dpWinUDP.c
$(OBJ_DIR)\dpIdentity.obj: $(GENERIC_DIR)\dpIdentity.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpIdentity.obj $(GENERIC_DIR)\dpIdentity.c
$(OBJ_DIR)\dpPackOff.obj: $(GENERIC_DIR)\dpPackOff.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpPackOff.obj $(GENERIC_DIR)\dpPackOff.c
$(OBJ_DIR)\dpWinInit.obj: $(WIN_DIR)\dpInit.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinInit.obj $(WIN_DIR)\dpInit.c
$(OBJ_DIR)\dpSock.obj: $(GENERIC_DIR)\dpSock.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpSock.obj $(GENERIC_DIR)\dpSock.c
$(OBJ_DIR)\dpWinSock.obj: $(WIN_DIR)\dpSock.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinSock.obj $(WIN_DIR)\dpSock.c
$(OBJ_DIR)\dpWinSerial.obj: $(WIN_DIR)\dpSerial.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpWinSerial.obj $(WIN_DIR)\dpSerial.c
$(OBJ_DIR)\dpSerial.obj: $(GENERIC_DIR)\dpSerial.c
$(cc32) $(cdebug) -c $(cvarsdll) $(INCLUDES) \
$(DEFINES) /Fo$(OBJ_DIR)\dpSerial.obj $(GENERIC_DIR)\dpSerial.c
clean:
-@if exist $(OBJ_DIR)\*.obj $(RM) $(OBJ_DIR)\*.obj
-@if exist $(DPDLL) $(RM) $(DPDLL)
-@if exist dp40.lib $(RM) dp40.lib
-@if exist dp40.exp $(RM) dp40.exp
-@if exist pkgIndex.tcl $(RM) pkgIndex.tcl
-@if exist $(DPSH).exe $(RM) $(DPSH).exe
tests: $(DPDLL)
SET DP_TEST_VERBOSE=1
cd ..\tests
$(TCL_ROOT_DIR)\win\tclsh80.exe all