summaryrefslogtreecommitdiffstats
path: root/mac/tclMacSock.c
diff options
context:
space:
mode:
Diffstat (limited to 'mac/tclMacSock.c')
-rw-r--r--mac/tclMacSock.c2788
1 files changed, 0 insertions, 2788 deletions
diff --git a/mac/tclMacSock.c b/mac/tclMacSock.c
deleted file mode 100644
index 35ecf9a..0000000
--- a/mac/tclMacSock.c
+++ /dev/null
@@ -1,2788 +0,0 @@
-/*
- * tclMacSock.c
- *
- * Channel drivers for Macintosh sockets.
- *
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-#include "tclPort.h"
-#include "tclMacInt.h"
-#include <AddressXlation.h>
-#include <Aliases.h>
-#undef Status
-#include <Devices.h>
-#include <Errors.h>
-#include <Events.h>
-#include <Files.h>
-#include <Gestalt.h>
-#include <MacTCP.h>
-#include <Processes.h>
-#include <Strings.h>
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
-
-/*
- * If debugging is on we may drop into the debugger to handle certain cases
- * that are not supposed to happen. Otherwise, we change ignore the error
- * and most code should handle such errors ok.
- */
-
-#ifdef NDEBUG
- #define Debugger()
-#endif
-
-/*
- * The preferred buffer size for Macintosh channels.
- */
-
-#define CHANNEL_BUF_SIZE 8192
-
-/*
- * Port information structure. Used to match service names
- * to a Tcp/Ip port number.
- */
-
-typedef struct {
- char *name; /* Name of service. */
- int port; /* Port number. */
-} PortInfo;
-
-/*
- * This structure describes per-instance state of a tcp based channel.
- */
-
-typedef struct TcpState {
- TCPiopb pb; /* Parameter block used by this stream.
- * This must be in the first position. */
- ProcessSerialNumber psn; /* PSN used to wake up process. */
- StreamPtr tcpStream; /* Macintosh tcp stream pointer. */
- int port; /* The port we are connected to. */
- int flags; /* Bit field comprised of the flags
- * described below. */
- int checkMask; /* OR'ed combination of TCL_READABLE and
- * TCL_WRITABLE as set by an asynchronous
- * event handler. */
- int watchMask; /* OR'ed combination of TCL_READABLE and
- * TCL_WRITABLE as set by TcpWatch. */
- Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
- ClientData acceptProcData; /* The data for the accept proc. */
- wdsEntry dataSegment[2]; /* List of buffers to be written async. */
- rdsEntry rdsarray[5+1]; /* Array used when cleaning out recieve
- * buffers on a closing socket. */
- Tcl_Channel channel; /* Channel associated with this socket. */
- int writeBufferSize; /* Size of buffer to hold data for
- * asynchronous writes. */
- void *writeBuffer; /* Buffer for async write data. */
- struct TcpState *nextPtr; /* The next socket on the global socket
- * list. */
-} TcpState;
-
-/*
- * This structure is used by domain name resolver callback.
- */
-
-typedef struct DNRState {
- struct hostInfo hostInfo; /* Data structure used by DNR functions. */
- int done; /* Flag to determine when we are done. */
- ProcessSerialNumber psn; /* Process to wake up when we are done. */
-} DNRState;
-
-/*
- * The following macros may be used to set the flags field of
- * a TcpState structure.
- */
-
-#define TCP_ASYNC_SOCKET (1<<0) /* The socket is in async mode. */
-#define TCP_ASYNC_CONNECT (1<<1) /* The socket is trying to connect. */
-#define TCP_CONNECTED (1<<2) /* The socket is connected. */
-#define TCP_PENDING (1<<3) /* A SocketEvent is on the queue. */
-#define TCP_LISTENING (1<<4) /* This socket is listening for
- * a connection. */
-#define TCP_LISTEN_CONNECT (1<<5) /* Someone has connect to the
- * listening port. */
-#define TCP_REMOTE_CLOSED (1<<6) /* The remote side has closed
- * the connection. */
-#define TCP_RELEASE (1<<7) /* The socket may now be released. */
-#define TCP_WRITING (1<<8) /* A background write is in progress. */
-#define TCP_SERVER_ZOMBIE (1<<9) /* The server can no longer accept connects. */
-
-/*
- * The following structure is what is added to the Tcl event queue when
- * a socket event occurs.
- */
-
-typedef struct SocketEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- TcpState *statePtr; /* Socket descriptor that is ready. */
- StreamPtr tcpStream; /* Low level Macintosh stream. */
-} SocketEvent;
-
-/*
- * Static routines for this file:
- */
-
-static pascal void CleanUpExitProc _ANSI_ARGS_((void));
-static void ClearZombieSockets _ANSI_ARGS_((void));
-static void CloseCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
-static TcpState * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
- int port, CONST char *host, CONST char *myAddr,
- int myPort, int server, int async));
-static pascal void DNRCompletionRoutine _ANSI_ARGS_((
- struct hostInfo *hostinfoPtr,
- DNRState *dnrStatePtr));
-static void FreeSocketInfo _ANSI_ARGS_((TcpState *statePtr));
-static long GetBufferSize _ANSI_ARGS_((void));
-static OSErr GetHostFromString _ANSI_ARGS_((CONST char *name,
- ip_addr *address));
-static OSErr GetLocalAddress _ANSI_ARGS_((unsigned long *addr));
-static void IOCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
-static void InitMacTCPParamBlock _ANSI_ARGS_((TCPiopb *pBlock,
- int csCode));
-static void InitSockets _ANSI_ARGS_((void));
-static TcpState * NewSocketInfo _ANSI_ARGS_((StreamPtr stream));
-static OSErr ResolveAddress _ANSI_ARGS_((ip_addr tcpAddress,
- Tcl_DString *dsPtr));
-static void SocketCheckProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static int SocketEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
- int flags));
-static void SocketFreeProc _ANSI_ARGS_((ClientData clientData));
-static int SocketReady _ANSI_ARGS_((TcpState *statePtr));
-static void SocketSetupProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static void TcpAccept _ANSI_ARGS_((TcpState *statePtr));
-static int TcpBlockMode _ANSI_ARGS_((ClientData instanceData, int mode));
-static int TcpClose _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp));
-static int TcpGetHandle _ANSI_ARGS_((ClientData instanceData,
- int direction, ClientData *handlePtr));
-static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, CONST char *optionName,
- Tcl_DString *dsPtr));
-static int TcpInput _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCodePtr));
-static int TcpOutput _ANSI_ARGS_((ClientData instanceData,
- CONST char *buf, int toWrite, int *errorCodePtr));
-static void TcpWatch _ANSI_ARGS_((ClientData instanceData,
- int mask));
-static int WaitForSocketEvent _ANSI_ARGS_((TcpState *infoPtr,
- int mask, int *errorCodePtr));
-
-pascal void NotifyRoutine (
- StreamPtr tcpStream,
- unsigned short eventCode,
- Ptr userDataPtr,
- unsigned short terminReason,
- struct ICMPReport *icmpMsg);
-
-/*
- * This structure describes the channel type structure for TCP socket
- * based IO:
- */
-
-static Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- (Tcl_ChannelTypeVersion)TcpBlockMode, /* Set blocking or
- * non-blocking mode.*/
- TcpClose, /* Close proc. */
- TcpInput, /* Input proc. */
- TcpOutput, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatch, /* Initialize notifier. */
- TcpGetHandle /* Get handles out of channel. */
-};
-
-/*
- * Universal Procedure Pointers (UPP) for various callback
- * routines used by MacTcp code.
- */
-
-ResultUPP resultUPP = NULL;
-TCPIOCompletionUPP completeUPP = NULL;
-TCPIOCompletionUPP closeUPP = NULL;
-TCPNotifyUPP notifyUPP = NULL;
-
-/*
- * Built-in commands, and the procedures associated with them:
- */
-
-static PortInfo portServices[] = {
- {"echo", 7},
- {"discard", 9},
- {"systat", 11},
- {"daytime", 13},
- {"netstat", 15},
- {"chargen", 19},
- {"ftp-data", 20},
- {"ftp", 21},
- {"telnet", 23},
- {"telneto", 24},
- {"smtp", 25},
- {"time", 37},
- {"whois", 43},
- {"domain", 53},
- {"gopher", 70},
- {"finger", 79},
- {"hostnames", 101},
- {"sunrpc", 111},
- {"nntp", 119},
- {"exec", 512},
- {"login", 513},
- {"shell", 514},
- {"printer", 515},
- {"courier", 530},
- {"uucp", 540},
- {NULL, 0},
-};
-
-typedef struct ThreadSpecificData {
- /*
- * Every open socket has an entry on the following list.
- */
-
- TcpState *socketList;
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * Globals for holding information about OS support for sockets.
- */
-
-static int socketsTestInited = false;
-static int hasSockets = false;
-static short driverRefNum = 0;
-static int socketNumber = 0;
-static int socketBufferSize = CHANNEL_BUF_SIZE;
-static ProcessSerialNumber applicationPSN;
-
-/*
- *----------------------------------------------------------------------
- *
- * InitSockets --
- *
- * Load the MacTCP driver and open the name resolver. We also
- * create several UPP's used by our code. Lastly, we install
- * a patch to ExitToShell to clean up socket connections if
- * we are about to exit.
- *
- * Results:
- * 1 if successful, 0 on failure.
- *
- * Side effects:
- * Creates a new event source, loads the MacTCP driver,
- * registers an exit to shell callback.
- *
- *----------------------------------------------------------------------
- */
-
-#define gestaltMacTCPVersion 'mtcp'
-static void
-InitSockets()
-{
- ParamBlockRec pb;
- OSErr err;
- long response;
- ThreadSpecificData *tsdPtr;
-
- if (! initialized) {
- /*
- * Do process wide initialization.
- */
-
- initialized = 1;
-
- if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
- hasSockets = true;
- } else {
- hasSockets = false;
- }
-
- if (!hasSockets) {
- return;
- }
-
- /*
- * Load MacTcp driver and name server resolver.
- */
-
-
- pb.ioParam.ioCompletion = 0L;
- pb.ioParam.ioNamePtr = "\p.IPP";
- pb.ioParam.ioPermssn = fsCurPerm;
- err = PBOpenSync(&pb);
- if (err != noErr) {
- hasSockets = 0;
- return;
- }
- driverRefNum = pb.ioParam.ioRefNum;
-
- socketBufferSize = GetBufferSize();
- err = OpenResolver(NULL);
- if (err != noErr) {
- hasSockets = 0;
- return;
- }
-
- GetCurrentProcess(&applicationPSN);
- /*
- * Create UPP's for various callback routines.
- */
-
- resultUPP = NewResultProc(DNRCompletionRoutine);
- completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
- closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
- notifyUPP = NewTCPNotifyProc(NotifyRoutine);
-
- /*
- * Install an ExitToShell patch. We use this patch instead
- * of the Tcl exit mechanism because we need to ensure that
- * these routines are cleaned up even if we crash or are forced
- * to quit. There are some circumstances when the Tcl exit
- * handlers may not fire.
- */
-
- TclMacInstallExitToShellPatch(CleanUpExitProc);
- }
-
- /*
- * Do per-thread initialization.
- */
-
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->socketList = NULL;
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeSockets --
- *
- * Invoked during exit clean up to deinitialize the socket module.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removed event source.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizeSockets()
-{
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr != NULL) {
- Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpHasSockets --
- *
- * This function determines whether sockets are available on the
- * current system and returns an error in interp if they are not.
- * Note that interp may be NULL.
- *
- * Results:
- * Returns TCL_OK if the system supports sockets, or TCL_ERROR with
- * an error in interp.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpHasSockets(
- Tcl_Interp *interp) /* Interp for error messages. */
-{
- InitSockets();
-
- if (hasSockets) {
- return TCL_OK;
- }
- if (interp != NULL) {
- Tcl_AppendResult(interp, "sockets are not available on this system",
- NULL);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketSetupProc --
- *
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SocketSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- TcpState *statePtr;
- Tcl_Time blockTime = { 0, 0 };
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Check to see if there is a ready socket. If so, poll.
- */
-
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->flags & TCP_RELEASE) {
- continue;
- }
- if (SocketReady(statePtr)) {
- Tcl_SetMaxBlockTime(&blockTime);
- break;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketCheckProc --
- *
- * This procedure is called by Tcl_DoOneEvent to check the socket
- * event source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SocketCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- TcpState *statePtr;
- SocketEvent *evPtr;
- TcpState dummyState;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- 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 (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- /*
- * Check to see if this socket is dead and needs to be cleaned
- * up. We use a dummy statePtr whose only valid field is the
- * nextPtr to allow the loop to continue even if the element
- * is deleted.
- */
-
- if (statePtr->flags & TCP_RELEASE) {
- if (!(statePtr->flags & TCP_PENDING)) {
- dummyState.nextPtr = statePtr->nextPtr;
- SocketFreeProc(statePtr);
- statePtr = &dummyState;
- }
- continue;
- }
-
- if (!(statePtr->flags & TCP_PENDING) && SocketReady(statePtr)) {
- statePtr->flags |= TCP_PENDING;
- evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
- evPtr->header.proc = SocketEventProc;
- evPtr->statePtr = statePtr;
- evPtr->tcpStream = statePtr->tcpStream;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketReady --
- *
- * This function checks the current state of a socket to see
- * if any interesting conditions are present.
- *
- * Results:
- * Returns 1 if an event that someone is watching is present, else
- * returns 0.
- *
- * Side effects:
- * Updates the checkMask for the socket to reflect any newly
- * detected events.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SocketReady(
- TcpState *statePtr)
-{
- TCPiopb statusPB;
- int foundSomething = 0;
- int didStatus = 0;
- int amount;
- OSErr err;
-
- if (statePtr->flags & TCP_LISTEN_CONNECT) {
- foundSomething = 1;
- statePtr->checkMask |= TCL_READABLE;
- }
- if (statePtr->watchMask & TCL_READABLE) {
- if (statePtr->checkMask & TCL_READABLE) {
- foundSomething = 1;
- } else if (statePtr->flags & TCP_CONNECTED) {
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = statePtr->tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- didStatus = 1;
-
- /*
- * We make the fchannel readable if 1) we get an error,
- * 2) there is more data available, or 3) we detect
- * that a close from the remote connection has arrived.
- */
-
- if ((err != noErr) ||
- (statusPB.csParam.status.amtUnreadData > 0) ||
- (statusPB.csParam.status.connectionState == 14)) {
- statePtr->checkMask |= TCL_READABLE;
- foundSomething = 1;
- }
- }
- }
- if (statePtr->watchMask & TCL_WRITABLE) {
- if (statePtr->checkMask & TCL_WRITABLE) {
- foundSomething = 1;
- } else if (statePtr->flags & TCP_CONNECTED) {
- if (!didStatus) {
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = statePtr->tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- }
-
- /*
- * If there is an error or there if there is room to
- * send more data we make the channel writeable.
- */
-
- amount = statusPB.csParam.status.sendWindow -
- statusPB.csParam.status.amtUnackedData;
- if ((err != noErr) || (amount > 0)) {
- statePtr->checkMask |= TCL_WRITABLE;
- foundSomething = 1;
- }
- }
- }
- return foundSomething;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitMacTCPParamBlock--
- *
- * Initialize a MacTCP parameter block.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Initializes the parameter block.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-InitMacTCPParamBlock(
- TCPiopb *pBlock, /* Tcp parmeter block. */
- int csCode) /* Tcp operation code. */
-{
- memset(pBlock, 0, sizeof(TCPiopb));
- pBlock->ioResult = 1;
- pBlock->ioCRefNum = driverRefNum;
- pBlock->csCode = (short) csCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpBlockMode --
- *
- * Set blocking or non-blocking mode on channel.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpBlockMode(
- ClientData instanceData, /* Channel state. */
- int mode) /* The mode to set. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
-
- if (mode == TCL_MODE_BLOCKING) {
- statePtr->flags &= ~TCP_ASYNC_SOCKET;
- } else {
- statePtr->flags |= TCP_ASYNC_SOCKET;
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpClose --
- *
- * Close the socket.
- *
- * Results:
- * 0 if successful, the value of errno if failed.
- *
- * Side effects:
- * Closes the socket.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpClose(
- ClientData instanceData, /* The socket to close. */
- Tcl_Interp *interp) /* Interp for error messages. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
- StreamPtr tcpStream;
- TCPiopb closePB;
- OSErr err;
-
- tcpStream = statePtr->tcpStream;
- statePtr->flags &= ~TCP_CONNECTED;
-
- /*
- * If this is a server socket we can't use the statePtr
- * param block because it is in use. However, we can
- * close syncronously.
- */
-
- if ((statePtr->flags & TCP_LISTENING) ||
- (statePtr->flags & TCP_LISTEN_CONNECT)) {
- InitMacTCPParamBlock(&closePB, TCPClose);
- closePB.tcpStream = tcpStream;
- closePB.ioCompletion = NULL;
- closePB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
- closePB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
- closePB.csParam.close.validityFlags = timeoutValue | timeoutAction;
- err = PBControlSync((ParmBlkPtr) &closePB);
- if (err != noErr) {
- Debugger();
- goto afterRelease;
- /* panic("error closing server socket"); */
- }
- statePtr->flags |= TCP_RELEASE;
-
- /*
- * Server sockets are closed sync. Therefor, we know it is OK to
- * release the socket now.
- */
-
- InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- err = PBControlSync((ParmBlkPtr) &statePtr->pb);
- if (err != noErr) {
- panic("error releasing server socket");
- }
-
- /*
- * Free the buffer space used by the socket and the
- * actual socket state data structure.
- */
- afterRelease:
-
- /*
- * Have to check whether the pointer is NULL, since we could get here
- * on a failed socket open, and then the rcvBuff would never have been
- * allocated.
- */
-
- if (err == noErr) {
- ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
- }
- FreeSocketInfo(statePtr);
- return 0;
- }
-
- /*
- * If this socket is in the midddle on async connect we can just
- * abort the connect and release the stream right now.
- */
-
- if (statePtr->flags & TCP_ASYNC_CONNECT) {
- InitMacTCPParamBlock(&closePB, TCPClose);
- closePB.tcpStream = tcpStream;
- closePB.ioCompletion = NULL;
- err = PBControlSync((ParmBlkPtr) &closePB);
- if (err == noErr) {
- statePtr->flags |= TCP_RELEASE;
-
- InitMacTCPParamBlock(&closePB, TCPRelease);
- closePB.tcpStream = tcpStream;
- closePB.ioCompletion = NULL;
-
- err = PBControlSync((ParmBlkPtr) &closePB);
- }
-
- /*
- * Free the buffer space used by the socket and the
- * actual socket state data structure. However, if the
- * RELEASE returns an error, then the rcvBuff is usually
- * bad, so we can't release it. I think this means we will
- * leak the buffer, so in the future, we may want to track the
- * buffers separately, and nuke them on our own (or just not
- * use MacTCP!).
- */
-
- if (err == noErr) {
- ckfree((char *) closePB.csParam.create.rcvBuff);
- }
-
- FreeSocketInfo(statePtr);
- return err;
- }
-
- /*
- * Client sockets:
- * If a background write is in progress, don't close
- * the socket yet. The completion routine for the
- * write will take care of it.
- */
-
- if (!(statePtr->flags & TCP_WRITING)) {
- InitMacTCPParamBlock(&statePtr->pb, TCPClose);
- statePtr->pb.tcpStream = tcpStream;
- statePtr->pb.ioCompletion = closeUPP;
- statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
- err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
- if (err != noErr) {
- Debugger();
- statePtr->flags |= TCP_RELEASE;
- /* return 0; */
- }
- }
-
- SocketFreeProc(instanceData);
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CloseCompletionRoutine --
- *
- * Handles the close protocol for a Tcp socket. This will do
- * a series of calls to release all data currently buffered for
- * the socket. This is important to do to as it allows the remote
- * connection to recieve and issue it's own close on the socket.
- * Note that this function is running at interupt time and can't
- * allocate memory or do much else except set state.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The buffers for the socket are flushed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-CloseCompletionRoutine(
- TCPiopb *pbPtr) /* Tcp parameter block. */
-{
- TcpState *statePtr;
- OSErr err;
-
- if (pbPtr->csCode == TCPClose) {
- statePtr = (TcpState *) (pbPtr->csParam.close.userDataPtr);
- } else {
- statePtr = (TcpState *) (pbPtr->csParam.receive.userDataPtr);
- }
-
- /*
- * It's very bad if the statePtr is nNULL - we should probably panic...
- */
-
- if (statePtr == NULL) {
- Debugger();
- return;
- }
-
- WakeUpProcess(&statePtr->psn);
-
- /*
- * If there is an error we assume the remote side has already
- * close. We are done closing as soon as we decide that the
- * remote connection has closed.
- */
-
- if (pbPtr->ioResult != noErr) {
- statePtr->flags |= TCP_RELEASE;
- return;
- }
- if (statePtr->flags & TCP_REMOTE_CLOSED) {
- statePtr->flags |= TCP_RELEASE;
- return;
- }
-
- /*
- * If we just did a recieve we need to return the buffers.
- * Otherwise, attempt to recieve more data until we recieve an
- * error (usually because we have no more data).
- */
-
- if (statePtr->pb.csCode == TCPNoCopyRcv) {
- InitMacTCPParamBlock(&statePtr->pb, TCPRcvBfrReturn);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- statePtr->pb.ioCompletion = closeUPP;
- statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
- statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
- err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
- } else {
- InitMacTCPParamBlock(&statePtr->pb, TCPNoCopyRcv);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- statePtr->pb.ioCompletion = closeUPP;
- statePtr->pb.csParam.receive.commandTimeoutValue = 1;
- statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
- statePtr->pb.csParam.receive.rdsLength = 5;
- statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
- err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
- }
-
- if (err != noErr) {
- statePtr->flags |= TCP_RELEASE;
- }
-}
-/*
- *----------------------------------------------------------------------
- *
- * SocketFreeProc --
- *
- * This callback is invoked in order to delete
- * the notifier data associated with a file handle.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the SocketInfo from the global socket list.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SocketFreeProc(
- ClientData clientData) /* Channel state. */
-{
- TcpState *statePtr = (TcpState *) clientData;
- OSErr err;
- TCPiopb statusPB;
-
- /*
- * Get the status of this connection. We need to do a
- * few tests to see if it's OK to release the stream now.
- */
-
- if (!(statePtr->flags & TCP_RELEASE)) {
- return;
- }
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = statePtr->tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- if ((statusPB.csParam.status.connectionState == 0) ||
- (statusPB.csParam.status.connectionState == 2)) {
- /*
- * If the conection state is 0 then this was a client
- * connection and it's closed. If it is 2 then this a
- * server client and we may release it. If it isn't
- * one of those values then we return and we'll try to
- * clean up later.
- */
-
- } else {
- return;
- }
-
- /*
- * The Close request is made async. We know it's
- * OK to release the socket when the TCP_RELEASE flag
- * gets set.
- */
-
- InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- err = PBControlSync((ParmBlkPtr) &statePtr->pb);
- if (err != noErr) {
- Debugger(); /* Ignoreing leaves stranded stream. Is there an
- alternative? */
- }
-
- /*
- * Free the buffer space used by the socket and the
- * actual socket state data structure.
- */
-
- ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
- FreeSocketInfo(statePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpInput --
- *
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error
- * indication.
- *
- * Results:
- * A count of how many bytes were read is returned. A value of -1
- * implies an error occured. A value of zero means we have reached
- * the end of data (EOF).
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TcpInput(
- ClientData instanceData, /* Channel state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available
- * in the buffer? */
- int *errorCodePtr) /* Where to store error code. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
- StreamPtr tcpStream;
- OSErr err;
- TCPiopb statusPB;
- int toRead, dataAvail;
-
- *errorCodePtr = 0;
- errno = 0;
- tcpStream = statePtr->tcpStream;
-
- if (bufSize == 0) {
- return 0;
- }
- toRead = bufSize;
-
- /*
- * First check to see if EOF was already detected, to prevent
- * calling the socket stack after the first time EOF is detected.
- */
-
- if (statePtr->flags & TCP_REMOTE_CLOSED) {
- return 0;
- }
-
- /*
- * If an asynchronous connect is in progress, attempt to wait for it
- * to complete before reading.
- */
-
- if ((statePtr->flags & TCP_ASYNC_CONNECT)
- && ! WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
- return -1;
- }
-
- /*
- * No EOF, and it is connected, so try to read more from the socket.
- * If the socket is blocking, we keep trying until there is data
- * available or the socket is closed.
- */
-
- while (1) {
-
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- if (err != noErr) {
- Debugger();
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return 0; /* EOF */
- }
- dataAvail = statusPB.csParam.status.amtUnreadData;
- if (dataAvail < bufSize) {
- toRead = dataAvail;
- } else {
- toRead = bufSize;
- }
- if (toRead != 0) {
- /*
- * Try to read the data.
- */
-
- InitMacTCPParamBlock(&statusPB, TCPRcv);
- statusPB.tcpStream = tcpStream;
- statusPB.csParam.receive.rcvBuff = buf;
- statusPB.csParam.receive.rcvBuffLen = toRead;
- err = PBControlSync((ParmBlkPtr) &statusPB);
-
- statePtr->checkMask &= ~TCL_READABLE;
- switch (err) {
- case noErr:
- /*
- * The channel remains readable only if this read succeds
- * and we had more data then the size of the buffer we were
- * trying to fill. Use the info from the call to status to
- * determine this.
- */
-
- if (dataAvail > bufSize) {
- statePtr->checkMask |= TCL_READABLE;
- }
- return statusPB.csParam.receive.rcvBuffLen;
- case connectionClosing:
- *errorCodePtr = errno = ESHUTDOWN;
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return 0;
- case connectionDoesntExist:
- case connectionTerminated:
- *errorCodePtr = errno = ENOTCONN;
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return 0;
- case invalidStreamPtr:
- default:
- *errorCodePtr = EINVAL;
- return -1;
- }
- }
-
- /*
- * No data is available, so check the connection state to
- * see why this is the case.
- */
-
- if (statusPB.csParam.status.connectionState == 14) {
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return 0;
- }
- if (statusPB.csParam.status.connectionState != 8) {
- Debugger();
- }
- statePtr->checkMask &= ~TCL_READABLE;
- if (statePtr->flags & TCP_ASYNC_SOCKET) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
-
- /*
- * In the blocking case, wait until the file becomes readable
- * or closed and try again.
- */
-
- if (!WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
- return -1;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetHandle --
- *
- * Called from Tcl_GetChannelHandle to retrieve handles from inside
- * a file based channel.
- *
- * Results:
- * The appropriate handle or NULL if not present.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpGetHandle(
- ClientData instanceData, /* The file state. */
- int direction, /* Which handle to retrieve? */
- ClientData *handlePtr)
-{
- TcpState *statePtr = (TcpState *) instanceData;
-
- *handlePtr = (ClientData) statePtr->tcpStream;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpOutput--
- *
- * Writes the given output on the IO channel. Returns count of how
- * many characters were actually written, and an error indication.
- *
- * Results:
- * A count of how many characters were written is returned and an
- * error indication is returned in an output argument.
- *
- * Side effects:
- * Writes output on the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpOutput(
- ClientData instanceData, /* Channel state. */
- CONST char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCodePtr) /* Where to store error code. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
- StreamPtr tcpStream;
- OSErr err;
- int amount;
- TCPiopb statusPB;
-
- *errorCodePtr = 0;
- tcpStream = statePtr->tcpStream;
-
- /*
- * If an asynchronous connect is in progress, attempt to wait for it
- * to complete before writing.
- */
-
- if ((statePtr->flags & TCP_ASYNC_CONNECT)
- && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
- return -1;
- }
-
- /*
- * Loop until we have written some data, or an error occurs.
- */
-
- while (1) {
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- if ((err == connectionDoesntExist) || ((err == noErr) &&
- (statusPB.csParam.status.connectionState == 14))) {
- /*
- * The remote connection is gone away. Report an error
- * and don't write anything.
- */
-
- *errorCodePtr = errno = EPIPE;
- return -1;
- } else if (err != noErr) {
- return -1;
- }
- amount = statusPB.csParam.status.sendWindow
- - statusPB.csParam.status.amtUnackedData;
-
- /*
- * Attempt to write the data to the socket if a background
- * write isn't in progress and there is room in the output buffers.
- */
-
- if (!(statePtr->flags & TCP_WRITING) && amount > 0) {
- if (toWrite < amount) {
- amount = toWrite;
- }
-
- /* We need to copy the data, otherwise the caller may overwrite
- * the buffer in the middle of our asynchronous call
- */
-
- if (amount > statePtr->writeBufferSize) {
- /*
- * need to grow write buffer
- */
-
- if (statePtr->writeBuffer != (void *) NULL) {
- ckfree(statePtr->writeBuffer);
- }
- statePtr->writeBuffer = (void *) ckalloc(amount);
- statePtr->writeBufferSize = amount;
- }
- memcpy(statePtr->writeBuffer, buf, amount);
- statePtr->dataSegment[0].ptr = statePtr->writeBuffer;
-
- statePtr->dataSegment[0].length = amount;
- statePtr->dataSegment[1].length = 0;
- InitMacTCPParamBlock(&statePtr->pb, TCPSend);
- statePtr->pb.ioCompletion = completeUPP;
- statePtr->pb.tcpStream = tcpStream;
- statePtr->pb.csParam.send.wdsPtr = (Ptr) statePtr->dataSegment;
- statePtr->pb.csParam.send.pushFlag = 1;
- statePtr->pb.csParam.send.userDataPtr = (Ptr) statePtr;
- statePtr->flags |= TCP_WRITING;
- err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
- switch (err) {
- case noErr:
- return amount;
- case connectionClosing:
- *errorCodePtr = errno = ESHUTDOWN;
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return -1;
- case connectionDoesntExist:
- case connectionTerminated:
- *errorCodePtr = errno = ENOTCONN;
- statePtr->flags |= TCP_REMOTE_CLOSED;
- return -1;
- case invalidStreamPtr:
- default:
- return -1;
- }
-
- }
-
- /*
- * The socket wasn't writable. In the non-blocking case, return
- * immediately, otherwise wait until the file becomes writable
- * or closed and try again.
- */
-
- if (statePtr->flags & TCP_ASYNC_SOCKET) {
- statePtr->checkMask &= ~TCL_WRITABLE;
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- } else if (!WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
- return -1;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetOptionProc --
- *
- * Computes an option value for a TCP socket based channel, or a
- * list of all options and their values.
- *
- * Note: This code is based on code contributed by John Haxby.
- *
- * Results:
- * A standard Tcl result. The value of the specified option or a
- * list of all options and their values is returned in the
- * supplied DString.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpGetOptionProc(
- ClientData instanceData, /* Socket state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL.*/
- CONST char *optionName, /* Name of the option to
- * retrieve the value for, or
- * NULL to get all options and
- * their values. */
- Tcl_DString *dsPtr) /* Where to store the computed
- * value; initialized by caller. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
- int doPeerName = false, doSockName = false, doError = false, doAll = false;
- ip_addr tcpAddress;
- char buffer[128];
- OSErr err;
- Tcl_DString dString;
- TCPiopb statusPB;
- int errorCode;
- size_t len = 0;
-
- /*
- * If an asynchronous connect is in progress, attempt to wait for it
- * to complete before accessing the socket state.
- */
-
- if ((statePtr->flags & TCP_ASYNC_CONNECT)
- && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, &errorCode)) {
- if (interp) {
- /*
- * fix the error message.
- */
-
- Tcl_AppendResult(interp, "connect is in progress and can't wait",
- NULL);
- }
- return TCL_ERROR;
- }
-
- /*
- * Determine which options we need to do. Do all of them
- * if optionName is NULL.
- */
-
- if (optionName == (CONST char *) NULL || optionName[0] == '\0') {
- doAll = true;
- } else {
- len = strlen(optionName);
- if (!strncmp(optionName, "-peername", len)) {
- doPeerName = true;
- } else if (!strncmp(optionName, "-sockname", len)) {
- doSockName = true;
- } else if (!strncmp(optionName, "-error", len)) {
- /* SF Bug #483575 */
- doError = true;
- } else {
- return Tcl_BadChannelOption(interp, optionName,
- "error peername sockname");
- }
- }
-
- /*
- * SF Bug #483575
- *
- * Return error information. Currently we ignore
- * this option. IOW, we always return the empty
- * string, signaling 'no error'.
- *
- * FIXME: Get a mac/socket expert to write a correct
- * FIXME: implementation.
- */
-
- if (doAll || doError) {
- if (doAll) {
- Tcl_DStringAppendElement(dsPtr, "-error");
- Tcl_DStringAppendElement(dsPtr, "");
- } else {
- Tcl_DStringAppend (dsPtr, "", -1);
- return TCL_OK;
- }
- }
-
- /*
- * Get status on the stream. Make sure to use a new pb struct because
- * the struct in the statePtr may be part of an asyncronous call.
- */
-
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = statePtr->tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- if ((err == connectionDoesntExist) ||
- ((err == noErr) && (statusPB.csParam.status.connectionState == 14))) {
- /*
- * The socket was probably closed on the other side of the connection.
- */
-
- if (interp) {
- Tcl_AppendResult(interp, "can't access socket info: ",
- "connection reset by peer", NULL);
- }
- return TCL_ERROR;
- } else if (err != noErr) {
- if (interp) {
- Tcl_AppendResult(interp, "unknown socket error", NULL);
- }
- Debugger();
- return TCL_ERROR;
- }
-
-
- /*
- * Get the sockname for the socket.
- */
-
- Tcl_DStringInit(&dString);
- if (doAll || doSockName) {
- if (doAll) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- tcpAddress = statusPB.csParam.status.localHost;
- sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
- tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
- tcpAddress & 0xff);
- Tcl_DStringAppendElement(dsPtr, buffer);
- if (ResolveAddress(tcpAddress, &dString) == noErr) {
- Tcl_DStringAppendElement(dsPtr, dString.string);
- } else {
- Tcl_DStringAppendElement(dsPtr, "<unknown>");
- }
- sprintf(buffer, "%d", statusPB.csParam.status.localPort);
- Tcl_DStringAppendElement(dsPtr, buffer);
- if (doAll) {
- Tcl_DStringEndSublist(dsPtr);
- }
- }
-
- /*
- * Get the peername for the socket.
- */
-
- if ((doAll || doPeerName) && (statePtr->flags & TCP_CONNECTED)) {
- if (doAll) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringStartSublist(dsPtr);
- }
- tcpAddress = statusPB.csParam.status.remoteHost;
- sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
- tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
- tcpAddress & 0xff);
- Tcl_DStringAppendElement(dsPtr, buffer);
- Tcl_DStringSetLength(&dString, 0);
- if (ResolveAddress(tcpAddress, &dString) == noErr) {
- Tcl_DStringAppendElement(dsPtr, dString.string);
- } else {
- Tcl_DStringAppendElement(dsPtr, "<unknown>");
- }
- sprintf(buffer, "%d", statusPB.csParam.status.remotePort);
- Tcl_DStringAppendElement(dsPtr, buffer);
- if (doAll) {
- Tcl_DStringEndSublist(dsPtr);
- }
- }
-
- Tcl_DStringFree(&dString);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpWatch --
- *
- * Initialize the notifier to watch this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the watchMask for the channel.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TcpWatch(instanceData, mask)
- ClientData instanceData; /* The file state. */
- int mask; /* Events of interest; an OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
-{
- TcpState *statePtr = (TcpState *) instanceData;
-
- statePtr->watchMask = mask;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NewSocketInfo --
- *
- * This function allocates and initializes a new SocketInfo
- * structure.
- *
- * Results:
- * Returns a newly allocated SocketInfo.
- *
- * Side effects:
- * Adds the socket to the global socket list, allocates memory.
- *
- *----------------------------------------------------------------------
- */
-
-static TcpState *
-NewSocketInfo(
- StreamPtr tcpStream)
-{
- TcpState *statePtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
- statePtr->tcpStream = tcpStream;
- statePtr->psn = applicationPSN;
- statePtr->flags = 0;
- statePtr->checkMask = 0;
- statePtr->watchMask = 0;
- statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
- statePtr->acceptProcData = (ClientData) NULL;
- statePtr->writeBuffer = (void *) NULL;
- statePtr->writeBufferSize = 0;
- statePtr->nextPtr = tsdPtr->socketList;
- tsdPtr->socketList = statePtr;
- return statePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeSocketInfo --
- *
- * This function deallocates a SocketInfo structure that is no
- * longer needed.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the socket from the global socket list, frees memory.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeSocketInfo(
- TcpState *statePtr) /* The state pointer to free. */
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (statePtr == tsdPtr->socketList) {
- tsdPtr->socketList = statePtr->nextPtr;
- } else {
- TcpState *p;
- for (p = tsdPtr->socketList; p != NULL; p = p->nextPtr) {
- if (p->nextPtr == statePtr) {
- p->nextPtr = statePtr->nextPtr;
- break;
- }
- }
- }
-
- if (statePtr->writeBuffer != (void *) NULL) {
- ckfree(statePtr->writeBuffer);
- }
-
- ckfree((char *) statePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MakeTcpClientChannel --
- *
- * Creates a Tcl_Channel from an existing client TCP socket.
- *
- * Results:
- * The Tcl_Channel wrapped around the preexisting TCP socket.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_MakeTcpClientChannel(
- ClientData sock) /* The socket to wrap up into a channel. */
-{
- TcpState *statePtr;
- char channelName[20];
-
- if (TclpHasSockets(NULL) != TCL_OK) {
- return NULL;
- }
-
- statePtr = NewSocketInfo((StreamPtr) sock);
- /* TODO: do we need to set the port??? */
-
- sprintf(channelName, "sock%d", socketNumber++);
-
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
- Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CreateSocket --
- *
- * This function opens a new socket and initializes the
- * SocketInfo structure.
- *
- * Results:
- * Returns a new SocketInfo, or NULL with an error in interp.
- *
- * Side effects:
- * Adds a new socket to the socketList.
- *
- *----------------------------------------------------------------------
- */
-
-static TcpState *
-CreateSocket(
- Tcl_Interp *interp, /* For error reporting; can be NULL. */
- int port, /* Port number to open. */
- CONST char *host, /* Name of host on which to open port. */
- CONST char *myaddr, /* Optional client-side address */
- int myport, /* Optional client-side port */
- int server, /* 1 if socket should be a server socket,
- * else 0 for a client socket. */
- int async) /* 1 create async, 0 do sync. */
-{
- ip_addr macAddr;
- OSErr err;
- TCPiopb pb;
- StreamPtr tcpStream;
- TcpState *statePtr;
- char * buffer;
-
- /*
- * Figure out the ip address from the host string.
- */
-
- if (host == NULL) {
- err = GetLocalAddress(&macAddr);
- } else {
- err = GetHostFromString(host, &macAddr);
- }
- if (err != noErr) {
- Tcl_SetErrno(EHOSTUNREACH);
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- return (TcpState *) NULL;
- }
-
- /*
- * Create a MacTCP stream and create the state used for socket
- * transactions from here on out.
- */
-
- ClearZombieSockets();
- buffer = ckalloc(socketBufferSize);
- InitMacTCPParamBlock(&pb, TCPCreate);
- pb.csParam.create.rcvBuff = buffer;
- pb.csParam.create.rcvBuffLen = socketBufferSize;
- pb.csParam.create.notifyProc = nil /* notifyUPP */;
- err = PBControlSync((ParmBlkPtr) &pb);
- if (err != noErr) {
- Tcl_SetErrno(0); /* TODO: set to ENOSR - maybe?*/
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- return (TcpState *) NULL;
- }
-
- tcpStream = pb.tcpStream;
- statePtr = NewSocketInfo(tcpStream);
- statePtr->port = port;
-
- if (server) {
- /*
- * Set up server connection.
- */
-
- InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
- statePtr->pb.tcpStream = tcpStream;
- statePtr->pb.csParam.open.localPort = statePtr->port;
- statePtr->pb.ioCompletion = completeUPP;
- statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
- statePtr->pb.csParam.open.ulpTimeoutValue = 100;
- statePtr->pb.csParam.open.ulpTimeoutAction = 1 /* 1:abort 0:report */;
- statePtr->pb.csParam.open.commandTimeoutValue = 0 /* infinity */;
-
- statePtr->flags |= TCP_LISTENING;
- err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
-
- /*
- * If this is a server on port 0 then we need to wait until
- * the dynamic port allocation is made by the MacTcp driver.
- */
-
- if (statePtr->port == 0) {
- EventRecord dummy;
-
- while (statePtr->pb.csParam.open.localPort == 0) {
- WaitNextEvent(0, &dummy, 1, NULL);
- if (statePtr->pb.ioResult != 0) {
- break;
- }
- }
- statePtr->port = statePtr->pb.csParam.open.localPort;
- }
- Tcl_SetErrno(EINPROGRESS);
- } else {
- /*
- * Attempt to connect. The connect may fail at present with an
- * EINPROGRESS but at a later time it will complete. The caller
- * will set up a file handler on the socket if she is interested in
- * being informed when the connect completes.
- */
-
- InitMacTCPParamBlock(&statePtr->pb, TCPActiveOpen);
-
- statePtr->pb.tcpStream = tcpStream;
- statePtr->pb.csParam.open.remoteHost = macAddr;
- statePtr->pb.csParam.open.remotePort = port;
- statePtr->pb.csParam.open.localHost = 0;
- statePtr->pb.csParam.open.localPort = myport;
- statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
- statePtr->pb.csParam.open.validityFlags = timeoutValue | timeoutAction;
- statePtr->pb.csParam.open.ulpTimeoutValue = 60 /* seconds */;
- statePtr->pb.csParam.open.ulpTimeoutAction = 1 /* 1:abort 0:report */;
- statePtr->pb.csParam.open.commandTimeoutValue = 0;
-
- statePtr->pb.ioCompletion = completeUPP;
- if (async) {
- statePtr->flags |= TCP_ASYNC_CONNECT;
- err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
- Tcl_SetErrno(EINPROGRESS);
- } else {
- err = PBControlSync((ParmBlkPtr) &(statePtr->pb));
- }
- }
-
- switch (err) {
- case noErr:
- if (!async) {
- statePtr->flags |= TCP_CONNECTED;
- }
- return statePtr;
- case duplicateSocket:
- Tcl_SetErrno(EADDRINUSE);
- break;
- case openFailed:
- case connectionTerminated:
- Tcl_SetErrno(ECONNREFUSED);
- break;
- case invalidStreamPtr:
- case connectionExists:
- default:
- /*
- * These cases should never occur. However, we will fail
- * gracefully and hope Tcl can resume. The alternative is to panic
- * which is probably a bit drastic.
- */
-
- Debugger();
- Tcl_SetErrno(err);
- }
-
- /*
- * We had error during the connection. Release the stream
- * and file handle. Also report to the interp.
- */
-
- pb.ioCRefNum = driverRefNum;
- pb.csCode = TCPRelease;
- pb.tcpStream = tcpStream;
- pb.ioCompletion = NULL;
- err = PBControlSync((ParmBlkPtr) &pb);
-
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
-
- ckfree(buffer);
- FreeSocketInfo(statePtr);
- return (TcpState *) NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_OpenTcpClient --
- *
- * Opens a TCP client socket and creates a channel around it.
- *
- * Results:
- * The channel or NULL if failed. On failure, the routine also
- * sets the output argument errorCodePtr to the error code.
- *
- * Side effects:
- * Opens a client socket and creates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_OpenTcpClient(
- Tcl_Interp *interp, /* For error reporting; can be NULL. */
- int port, /* Port number to open. */
- CONST char *host, /* Host on which to open port. */
- CONST char *myaddr, /* Client-side address */
- int myport, /* Client-side port */
- int async) /* If nonzero, attempt to do an
- * asynchronous connect. Otherwise
- * we do a blocking connect.
- * - currently ignored */
-{
- TcpState *statePtr;
- char channelName[20];
-
- if (TclpHasSockets(interp) != TCL_OK) {
- return NULL;
- }
-
- /*
- * Create a new client socket and wrap it in a channel.
- */
-
- statePtr = CreateSocket(interp, port, host, myaddr, myport, 0, async);
- if (statePtr == NULL) {
- return NULL;
- }
-
- sprintf(channelName, "sock%d", socketNumber++);
-
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
- Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_OpenTcpServer --
- *
- * Opens a TCP server socket and creates a channel around it.
- *
- * Results:
- * The channel or NULL if failed.
- *
- * Side effects:
- * Opens a server socket and creates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_OpenTcpServer(
- Tcl_Interp *interp, /* For error reporting - may be
- * NULL. */
- int port, /* Port number to open. */
- CONST char *host, /* Name of local host. */
- Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections
- * from new clients. */
- ClientData acceptProcData) /* Data for the callback. */
-{
- TcpState *statePtr;
- char channelName[20];
-
- if (TclpHasSockets(interp) != TCL_OK) {
- return NULL;
- }
-
- /*
- * Create a new client socket and wrap it in a channel.
- */
-
- statePtr = CreateSocket(interp, port, host, NULL, 0, 1, 1);
- if (statePtr == NULL) {
- return NULL;
- }
-
- statePtr->acceptProc = acceptProc;
- statePtr->acceptProcData = acceptProcData;
-
- sprintf(channelName, "sock%d", socketNumber++);
-
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, 0);
- Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
- Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketEventProc --
- *
- * This procedure is called by Tcl_ServiceEvent when a socket event
- * reaches the front of the event queue. This procedure is
- * responsible for notifying the generic channel code.
- *
- * Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
- *
- * Side effects:
- * Whatever the channel callback procedures do.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SocketEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
-{
- TcpState *statePtr;
- SocketEvent *eventPtr = (SocketEvent *) evPtr;
- int mask = 0;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * Find the specified socket on the socket list.
- */
-
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if ((statePtr == eventPtr->statePtr) &&
- (statePtr->tcpStream == eventPtr->tcpStream)) {
- break;
- }
- }
-
- /*
- * Discard events that have gone stale.
- */
-
- if (!statePtr) {
- return 1;
- }
- statePtr->flags &= ~(TCP_PENDING);
- if (statePtr->flags & TCP_RELEASE) {
- SocketFreeProc(statePtr);
- return 1;
- }
-
-
- /*
- * Handle connection requests directly.
- */
-
- if (statePtr->flags & TCP_LISTEN_CONNECT) {
- if (statePtr->checkMask & TCL_READABLE) {
- TcpAccept(statePtr);
- }
- return 1;
- }
-
- /*
- * Mask off unwanted events then notify the channel.
- */
-
- mask = statePtr->checkMask & statePtr->watchMask;
- if (mask) {
- Tcl_NotifyChannel(statePtr->channel, mask);
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WaitForSocketEvent --
- *
- * Waits until one of the specified events occurs on a socket.
- *
- * Results:
- * Returns 1 on success or 0 on failure, with an error code in
- * errorCodePtr.
- *
- * Side effects:
- * Processes socket events off the system queue.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WaitForSocketEvent(
- TcpState *statePtr, /* Information about this socket. */
- int mask, /* Events to look for. */
- int *errorCodePtr) /* Where to store errors? */
-{
- OSErr err;
- TCPiopb statusPB;
- EventRecord dummy;
-
- /*
- * Loop until we get the specified condition, unless the socket is
- * asynchronous.
- */
-
- do {
- statusPB.ioCRefNum = driverRefNum;
- statusPB.tcpStream = statePtr->tcpStream;
- statusPB.csCode = TCPStatus;
- err = PBControlSync((ParmBlkPtr) &statusPB);
- if (err != noErr) {
- /*
- * I am not sure why it is right to return 1 - indicating success
- * for synchronous sockets when an attempt to get status on the
- * driver yeilds an error. But it is CERTAINLY wrong for async
- * sockect which have not yet connected.
- */
-
- if (statePtr->flags & TCP_ASYNC_CONNECT) {
- *errorCodePtr = EWOULDBLOCK;
- return 0;
- } else {
- statePtr->checkMask |= (TCL_READABLE | TCL_WRITABLE);
- return 1;
- }
- }
- statePtr->checkMask = 0;
-
- /*
- * The "6" below is the "connection being established" flag. I couldn't
- * find a define for this in MacTCP.h, but that's what the programmer's
- * guide says.
- */
-
- if ((statusPB.csParam.status.connectionState != 0)
- && (statusPB.csParam.status.connectionState != 4)
- && (statusPB.csParam.status.connectionState != 6)) {
- if (statusPB.csParam.status.amtUnreadData > 0) {
- statePtr->checkMask |= TCL_READABLE;
- }
- if (!(statePtr->flags & TCP_WRITING)
- && (statusPB.csParam.status.sendWindow -
- statusPB.csParam.status.amtUnackedData) > 0) {
- statePtr->flags &= ~(TCP_ASYNC_CONNECT);
- statePtr->checkMask |= TCL_WRITABLE;
- }
- if (mask & statePtr->checkMask) {
- return 1;
- }
- } else {
- break;
- }
-
- /*
- * Call the system to let other applications run while we
- * are waiting for this event to occur.
- */
-
- WaitNextEvent(0, &dummy, 1, NULL);
- } while (!(statePtr->flags & TCP_ASYNC_SOCKET));
- *errorCodePtr = EWOULDBLOCK;
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpAccept --
- * Accept a TCP socket connection. This is called by the event
- * loop, and it in turns calls any registered callbacks for this
- * channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Evals the Tcl script associated with the server socket.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TcpAccept(
- TcpState *statePtr)
-{
- TcpState *newStatePtr;
- StreamPtr tcpStream;
- char remoteHostname[255];
- OSErr err;
- ip_addr remoteAddress;
- long remotePort;
- char channelName[20];
-
- statePtr->flags &= ~TCP_LISTEN_CONNECT;
- statePtr->checkMask &= ~TCL_READABLE;
-
- /*
- * Transfer sever stream to new connection.
- */
-
- tcpStream = statePtr->tcpStream;
- newStatePtr = NewSocketInfo(tcpStream);
- newStatePtr->tcpStream = tcpStream;
- sprintf(channelName, "sock%d", socketNumber++);
-
-
- newStatePtr->flags |= TCP_CONNECTED;
- newStatePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) newStatePtr, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelBufferSize(newStatePtr->channel, socketBufferSize);
- Tcl_SetChannelOption(NULL, newStatePtr->channel, "-translation",
- "auto crlf");
-
- remoteAddress = statePtr->pb.csParam.open.remoteHost;
- remotePort = statePtr->pb.csParam.open.remotePort;
-
- /*
- * Reopen passive connect. Make new tcpStream the server.
- */
-
- ClearZombieSockets();
- InitMacTCPParamBlock(&statePtr->pb, TCPCreate);
- statePtr->pb.csParam.create.rcvBuff = ckalloc(socketBufferSize);
- statePtr->pb.csParam.create.rcvBuffLen = socketBufferSize;
- err = PBControlSync((ParmBlkPtr) &statePtr->pb);
- if (err != noErr) {
- /*
- * Hmmm... We can't reopen the server. We'll go ahead
- * an continue - but we are kind of broken now...
- */
- Debugger();
- statePtr->tcpStream = -1;
- statePtr->flags |= TCP_SERVER_ZOMBIE;
- }
-
- tcpStream = statePtr->tcpStream = statePtr->pb.tcpStream;
-
- InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
- statePtr->pb.tcpStream = tcpStream;
- statePtr->pb.csParam.open.localHost = 0;
- statePtr->pb.csParam.open.localPort = statePtr->port;
- statePtr->pb.ioCompletion = completeUPP;
- statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
- statePtr->flags |= TCP_LISTENING;
- err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
- /*
- * TODO: deal with case where we can't recreate server socket...
- */
-
- /*
- * Finally we run the accept procedure. We must do this last to make
- * sure we are in a nice clean state. This Tcl code can do anything
- * including closing the server or client sockets we've just delt with.
- */
-
- if (statePtr->acceptProc != NULL) {
- sprintf(remoteHostname, "%d.%d.%d.%d", remoteAddress>>24,
- remoteAddress>>16 & 0xff, remoteAddress>>8 & 0xff,
- remoteAddress & 0xff);
-
- (statePtr->acceptProc)(statePtr->acceptProcData, newStatePtr->channel,
- remoteHostname, remotePort);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetHostName --
- *
- * Returns the name of the local host.
- *
- * Results:
- * A string containing the network name for this machine, or
- * an empty string if we can't figure out the name. The caller
- * must not modify or free this string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-CONST char *
-Tcl_GetHostName()
-{
- static int hostnameInited = 0;
- static char hostname[255];
- ip_addr ourAddress;
- Tcl_DString dString;
- OSErr err;
-
- if (hostnameInited) {
- return hostname;
- }
-
- if (TclpHasSockets(NULL) == TCL_OK) {
- err = GetLocalAddress(&ourAddress);
- if (err == noErr) {
- /*
- * Search for the doman name and return it if found. Otherwise,
- * just print the IP number to a string and return that.
- */
-
- Tcl_DStringInit(&dString);
- err = ResolveAddress(ourAddress, &dString);
- if (err == noErr) {
- strcpy(hostname, dString.string);
- } else {
- sprintf(hostname, "%d.%d.%d.%d", ourAddress>>24, ourAddress>>16 & 0xff,
- ourAddress>>8 & 0xff, ourAddress & 0xff);
- }
- Tcl_DStringFree(&dString);
-
- hostnameInited = 1;
- return hostname;
- }
- }
-
- hostname[0] = '\0';
- hostnameInited = 1;
- return hostname;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ResolveAddress --
- *
- * This function is used to resolve an ip address to it's full
- * domain name address.
- *
- * Results:
- * An os err value.
- *
- * Side effects:
- * Treats client data as int we set to true.
- *
- *----------------------------------------------------------------------
- */
-
-static OSErr
-ResolveAddress(
- ip_addr tcpAddress, /* Address to resolve. */
- Tcl_DString *dsPtr) /* Returned address in string. */
-{
- int i;
- EventRecord dummy;
- DNRState dnrState;
- OSErr err;
-
- /*
- * Call AddrToName to resolve our ip address to our domain name.
- * The call is async, so we must wait for a callback to tell us
- * when to continue.
- */
-
- for (i = 0; i < NUM_ALT_ADDRS; i++) {
- dnrState.hostInfo.addr[i] = 0;
- }
- dnrState.done = 0;
- GetCurrentProcess(&(dnrState.psn));
- err = AddrToName(tcpAddress, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
- if (err == cacheFault) {
- while (!dnrState.done) {
- WaitNextEvent(0, &dummy, 1, NULL);
- }
- }
-
- /*
- * If there is no error in finding the domain name we set the
- * result into the dynamic string. We also work around a bug in
- * MacTcp where an extranious '.' may be found at the end of the name.
- */
-
- if (dnrState.hostInfo.rtnCode == noErr) {
- i = strlen(dnrState.hostInfo.cname) - 1;
- if (dnrState.hostInfo.cname[i] == '.') {
- dnrState.hostInfo.cname[i] = '\0';
- }
- Tcl_DStringAppend(dsPtr, dnrState.hostInfo.cname, -1);
- }
-
- return dnrState.hostInfo.rtnCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DNRCompletionRoutine --
- *
- * This function is called when the Domain Name Server is done
- * seviceing our request. It just sets a flag that we can poll
- * in functions like Tcl_GetHostName to let them know to continue.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Treats client data as int we set to true.
- *
- *----------------------------------------------------------------------
- */
-
-static pascal void
-DNRCompletionRoutine(
- struct hostInfo *hostinfoPtr, /* Host infor struct. */
- DNRState *dnrStatePtr) /* Completetion state. */
-{
- dnrStatePtr->done = true;
- WakeUpProcess(&(dnrStatePtr->psn));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CleanUpExitProc --
- *
- * This procedure is invoked as an exit handler when ExitToShell
- * is called. It aborts any lingering socket connections. This
- * must be called or the Mac OS will more than likely crash.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static pascal void
-CleanUpExitProc()
-{
- TCPiopb exitPB;
- TcpState *statePtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- while (tsdPtr->socketList != NULL) {
- statePtr = tsdPtr->socketList;
- tsdPtr->socketList = statePtr->nextPtr;
-
- /*
- * Close and Release the connection.
- */
-
- exitPB.ioCRefNum = driverRefNum;
- exitPB.csCode = TCPClose;
- exitPB.tcpStream = statePtr->tcpStream;
- exitPB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
- exitPB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
- exitPB.csParam.close.validityFlags = timeoutValue | timeoutAction;
- exitPB.ioCompletion = NULL;
- PBControlSync((ParmBlkPtr) &exitPB);
-
- exitPB.ioCRefNum = driverRefNum;
- exitPB.csCode = TCPRelease;
- exitPB.tcpStream = statePtr->tcpStream;
- exitPB.ioCompletion = NULL;
- PBControlSync((ParmBlkPtr) &exitPB);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetHostFromString --
- *
- * Looks up the passed in domain name in the domain resolver. It
- * can accept strings of two types: 1) the ip number in string
- * format, or 2) the domain name.
- *
- * Results:
- * We return a ip address or 0 if there was an error or the
- * domain does not exist.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static OSErr
-GetHostFromString(
- CONST char *name, /* Host in string form. */
- ip_addr *address) /* Returned IP address. */
-{
- OSErr err;
- int i;
- EventRecord dummy;
- DNRState dnrState;
-
- if (TclpHasSockets(NULL) != TCL_OK) {
- return 0;
- }
-
- /*
- * Call StrToAddr to get the ip number for the passed in domain
- * name. The call is async, so we must wait for a callback to
- * tell us when to continue.
- */
-
- for (i = 0; i < NUM_ALT_ADDRS; i++) {
- dnrState.hostInfo.addr[i] = 0;
- }
- dnrState.done = 0;
- GetCurrentProcess(&(dnrState.psn));
- err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
- if (err == cacheFault) {
- while (!dnrState.done) {
- WaitNextEvent(0, &dummy, 1, NULL);
- }
- }
-
- /*
- * For some reason MacTcp may return a cachFault a second time via
- * the hostinfo block. This seems to be a bug in MacTcp. In this case
- * we run StrToAddr again - which seems to then work just fine.
- */
-
- if (dnrState.hostInfo.rtnCode == cacheFault) {
- dnrState.done = 0;
- err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
- if (err == cacheFault) {
- while (!dnrState.done) {
- WaitNextEvent(0, &dummy, 1, NULL);
- }
- }
- }
-
- if (dnrState.hostInfo.rtnCode == noErr) {
- *address = dnrState.hostInfo.addr[0];
- }
-
- return dnrState.hostInfo.rtnCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IOCompletionRoutine --
- *
- * This function is called when an asynchronous socket operation
- * completes. Since this routine runs as an interrupt handler,
- * it will simply set state to tell the notifier that this socket
- * is now ready for action. Note that this function is running at
- * interupt time and can't allocate memory or do much else except
- * set state.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets some state in the socket state. May also wake the process
- * if we are not currently running.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-IOCompletionRoutine(
- TCPiopb *pbPtr) /* Tcp parameter block. */
-{
- TcpState *statePtr;
-
- if (pbPtr->csCode == TCPSend) {
- statePtr = (TcpState *) pbPtr->csParam.send.userDataPtr;
- } else {
- statePtr = (TcpState *) pbPtr->csParam.open.userDataPtr;
- }
-
- /*
- * Always wake the process in case it's in WaitNextEvent.
- * If an error has a occured - just return. We will deal
- * with the problem later.
- */
-
- WakeUpProcess(&statePtr->psn);
- if (pbPtr->ioResult != noErr) {
- return;
- }
-
- if (statePtr->flags & TCP_ASYNC_CONNECT) {
- statePtr->flags &= ~TCP_ASYNC_CONNECT;
- statePtr->flags |= TCP_CONNECTED;
- statePtr->checkMask |= TCL_READABLE & TCL_WRITABLE;
- } else if (statePtr->flags & TCP_LISTENING) {
- if (statePtr->port == 0) {
- Debugger();
- }
- statePtr->flags &= ~TCP_LISTENING;
- statePtr->flags |= TCP_LISTEN_CONNECT;
- statePtr->checkMask |= TCL_READABLE;
- } else if (statePtr->flags & TCP_WRITING) {
- statePtr->flags &= ~TCP_WRITING;
- statePtr->checkMask |= TCL_WRITABLE;
- if (!(statePtr->flags & TCP_CONNECTED)) {
- InitMacTCPParamBlock(&statePtr->pb, TCPClose);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- statePtr->pb.ioCompletion = closeUPP;
- statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
- if (PBControlAsync((ParmBlkPtr) &statePtr->pb) != noErr) {
- statePtr->flags |= TCP_RELEASE;
- }
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetLocalAddress --
- *
- * Get the IP address for this machine. The result is cached so
- * the result is returned quickly after the first call.
- *
- * Results:
- * Macintosh error code.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static OSErr
-GetLocalAddress(
- unsigned long *addr) /* Returns host IP address. */
-{
- struct GetAddrParamBlock pBlock;
- OSErr err = noErr;
- static unsigned long localAddress = 0;
-
- if (localAddress == 0) {
- memset(&pBlock, 0, sizeof(pBlock));
- pBlock.ioResult = 1;
- pBlock.csCode = ipctlGetAddr;
- pBlock.ioCRefNum = driverRefNum;
- err = PBControlSync((ParmBlkPtr) &pBlock);
-
- if (err != noErr) {
- return err;
- }
- localAddress = pBlock.ourAddress;
- }
-
- *addr = localAddress;
- return noErr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetBufferSize --
- *
- * Get the appropiate buffer size for our machine & network. This
- * value will be used by the rest of Tcl & the MacTcp driver for
- * the size of its buffers. If out method for determining the
- * optimal buffer size fails for any reason - we return a
- * reasonable default.
- *
- * Results:
- * Size of optimal buffer in bytes.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static long
-GetBufferSize()
-{
- UDPiopb iopb;
- OSErr err = noErr;
- long bufferSize;
-
- memset(&iopb, 0, sizeof(iopb));
- err = GetLocalAddress(&iopb.csParam.mtu.remoteHost);
- if (err != noErr) {
- return CHANNEL_BUF_SIZE;
- }
- iopb.ioCRefNum = driverRefNum;
- iopb.csCode = UDPMaxMTUSize;
- err = PBControlSync((ParmBlkPtr)&iopb);
- if (err != noErr) {
- return CHANNEL_BUF_SIZE;
- }
- bufferSize = (iopb.csParam.mtu.mtuSize * 4) + 1024;
- if (bufferSize < CHANNEL_BUF_SIZE) {
- bufferSize = CHANNEL_BUF_SIZE;
- }
- return bufferSize;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSockGetPort --
- *
- * Maps from a string, which could be a service name, to a port.
- * Used by socket creation code to get port numbers and resolve
- * registered service names to port numbers.
- *
- * Results:
- * A standard Tcl result. On success, the port number is
- * returned in portPtr. On failure, an error message is left in
- * the interp's result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclSockGetPort(
- Tcl_Interp *interp, /* Interp for error messages. */
- char *string, /* Integer or service name */
- char *proto, /* "tcp" or "udp", typically -
- * ignored on Mac - assumed to be tcp */
- int *portPtr) /* Return port number */
-{
- PortInfo *portInfoPtr = NULL;
-
- if (Tcl_GetInt(interp, string, portPtr) == TCL_OK) {
- if (*portPtr > 0xFFFF) {
- Tcl_AppendResult(interp, "couldn't open socket: port number too high",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (*portPtr < 0) {
- Tcl_AppendResult(interp, "couldn't open socket: negative port number",
- (char *) NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
- }
- for (portInfoPtr = portServices; portInfoPtr->name != NULL; portInfoPtr++) {
- if (!strcmp(portInfoPtr->name, string)) {
- break;
- }
- }
- if (portInfoPtr != NULL && portInfoPtr->name != NULL) {
- *portPtr = portInfoPtr->port;
- Tcl_ResetResult(interp);
- return TCL_OK;
- }
-
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ClearZombieSockets --
- *
- * This procedure looks through the socket list and removes the
- * first stream it finds that is ready for release. This procedure
- * should be called before we ever try to create new Tcp streams
- * to ensure we can least allocate one stream.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Tcp streams may be released.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ClearZombieSockets()
-{
- TcpState *statePtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->flags & TCP_RELEASE) {
- SocketFreeProc(statePtr);
- return;
- }
- }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * NotifyRoutine --
- *
- * This routine does nothing currently, and is not being used. But
- * it is useful if you want to experiment with what MacTCP thinks that
- * it is doing...
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-pascal void NotifyRoutine (
- StreamPtr tcpStream,
- unsigned short eventCode,
- Ptr userDataPtr,
- unsigned short terminReason,
- struct ICMPReport *icmpMsg)
-{
- StreamPtr localTcpStream;
- unsigned short localEventCode;
- unsigned short localTerminReason;
- struct ICMPReport localIcmpMsg;
-
- localTcpStream = tcpStream;
- localEventCode = eventCode;
- localTerminReason = terminReason;
- localIcmpMsg = *icmpMsg;
-
-}