tclmacsock.c

tcl是工具命令语言

 * 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 exi