Tcl Source Code

if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
    return
}

# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
testConstraint prlimit [expr {![catch { exec prlimit -n }]}]

# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} {
    # firstly try dynamic port via server-socket(0):
    set port 0x7fffffff
    catch {

	set done [gets $pipe]
    }
    variable done
    vwait [namespace which -variable done]
    close $pipe
    set done
} write
proc testSockOnFDExhaustion {{limitn {}}} {
    upvar localhost localhost
    set code {
	lassign $argv localhost wait
	if {$localhost eq ""} {
	   set localhost 127.0.0.1
	}
	if {$wait ne {} && $wait} {
	    # wait for go signal:
	    gets stdin
	}
	proc accept {sock addr port} { incr ::accept }
	#
	# flood sockets to cause descriptors exhaustion:
	set i 0
	catch { while 1 { set bs([incr i]) [socket -server accept -myaddr $localhost 0] } }
	# now we'll free 4 of them:
	time { close $bs([incr i -1]) } 4
	#
	# test connects shuld cause an error, no busy-wait:
	set ::accept 0
	set tout [after 2500 {set ::accept "TIMEOUT"}]
	set listener [socket -server accept -myaddr $localhost 0]
	set port [lindex [chan configure $listener -sockname] 2]
	puts [list [catch {
	    while {$::accept ne "TIMEOUT"} {
		set client [socket -async $localhost $port]
		vwait ::accept
	    }
	    set ::accept "UNEXPECTED: $::accept"
	} msg] $msg]
	#
	# free the descriptors to let "accept" working again:
	while {$i > 1} { close $bs([incr i -1]) }
	#
	# let check 10 connection are successful now:
        puts [list [catch {
	    set i 0
            while {$::accept ne "TIMEOUT" && [incr i] < 10} {
                set client [socket -async $localhost $port]
                vwait ::accept
            }
            set ::accept "READY: $i"
        } msg] $msg]
        # clean up:
        after cancel $tout
        # exit.
    }
    if {[singleProcess]} { # evaluate test in same process:
	set orglimitn {}
	if {$limitn ne {} && $limitn} {
	    if {[catch {
		set orglimitn [exec prlimit -n -o SOFT --noheadings]
		exec prlimit -p [pid] --nofile=${limitn}:
	    } msg]} {
		puts "set of limit ($limitn) is impossible: $msg"
	    }
	}
	interp create i
	i eval [list set argv [list $localhost]]
	i eval {
	    proc gets args {}
	    proc puts l {lappend ::done {*}$l}
	}
	i eval $code
	set done [i eval {set ::done}]
	interp delete i
	if {$orglimitn ne {}} {
	    exec prlimit -p [pid] --nofile=${orglimitn}:
	}
    } else { # evaluate test in child process:
	upvar path path
	set f [open $path(script) w]
	puts $f $code
	close $f
	set pipe [open |[list [interpreter] $path(script) $localhost $limitn] r+]
	chan configure $pipe -buffering line
	if {$limitn ne {} && $limitn} {
	    if {[catch {
		exec prlimit -p [pid $pipe] --nofile=$limitn
	    } msg]} {
		puts "set of limit ($limitn) is impossible: $msg"
	    }
	    puts $pipe "go"
	}
	set done {}
	while {[gets $pipe line] >= 0} {lappend done {*}$line}
	close $pipe
	file delete $path(script)
    }
    set done
}
test socket_$af-2.14 {accept on descriptors exhaustion (ENOBUFS/EMFILE), bug [c6897e6e6a]} \
-constraints {socket stdio macOrUnix} -body {
    testSockOnFDExhaustion
} -match regexp \
-result {1 \{couldn't open socket: (too many open|host is unreachable)[^\}]*\} 0 \{READY: 10\}}
test socket_$af-2.15 {accept on descriptors exhaustion (ENOBUFS/EMFILE), bug [c6897e6e6a]} \
-constraints {socket stdio macOrUnix prlimit} -body {
    # same as 2.14, but in state where limit of open files exceeds FD_SETSIZE,
    # so set limit for process larger as FD_SETSIZE (default 1024):
    testSockOnFDExhaustion [expr {2*1024}]
} -match regexp \
-result {1 \{couldn't open socket: (too many open|host is unreachable)[^\}]*\} 0 \{READY: 10\}}

test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	set f [socket -server accept -myaddr $localhost 0]

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    TcpFdList fds;		/* The file descriptors of the sockets. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    int interest;		/* Event types of interest */

    union {
	/*
	 * Only needed for server sockets
	 */
	struct {
	    Tcl_TcpAcceptProc *acceptProc;
	                                /* Proc to call on accept. */
	    ClientData acceptProcData;  /* The data for the accept proc. */

	    Tcl_TimerToken timer;	/* Handle to retard accept event. */
	} s;

	/*
	 * Only needed for client sockets
	 */
	struct {
	    struct addrinfo *addrlist;	/* Addresses to connect to. */
	    struct addrinfo *addr;	/* Iterator over addrlist. */
	    struct addrinfo *myaddrlist;/* Local address. */
	    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
	    int filehandlers;           /* Caches FileHandlers that get set up while
	                                 * an async socket is not yet connected. */
	    int connectError;           /* Cache SO_ERROR of async socket. */
	    int cachedBlocking;         /* Cache blocking mode of async socket. */
	} c;
    } u;
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define TCP_SERVER_STATE	(1<<2)	/* Marks state of server socket. */
#define TCP_ASYNC_PENDING	(1<<4)	/* TcpConnect was called to
					 * process an async connect. This
					 * flag indicates that reentry is
					 * still pending */
#define TCP_ASYNC_FAILED	(1<<5)	/* An async connect finally failed */

/*

/*
 * The following variable holds the network name of this host.
 */

static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName =
	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};

#define CHECK_FD_SETSIZE_LIMIT

#if defined(CHECK_FD_SETSIZE_LIMIT) && !defined(EBADFD)
#  define EBADFD EMFILE
#endif
const char * fdSetSizeViolationMsg = 
	"too many open descriptors, violation of the set-size limit";

#if 0
/* printf debugging */
void
printaddrinfo(
    struct addrinfo *addrlist,
    char *prefix)

    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
        statePtr->u.c.cachedBlocking = mode;
        return 0;
    }
    if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) {
	return errno;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * WaitForConnect --
 *
 *	Check the state of an async connect process. If a connection attempt
 *	terminated, process it, which may finalize it or may start the next
 *	attempt. If a connect error occures, it is saved in
 *	statePtr->u.c.connectError to be reported by 'fconfigure -error'.
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Blocks if the
 *	    socket is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message

         */
    } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT));

    if (errorCodePtr != NULL) {
        if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
            *errorCodePtr = EAGAIN;
            return -1;
        } else if (statePtr->u.c.connectError != 0) {
            *errorCodePtr = ENOTCONN;
            return -1;
        }
    }
    return 0;
}


    fds = statePtr->fds.next;
    while (fds != NULL) {
	TcpFdList *next = fds->next;

	ckfree(fds);
	fds = next;
    }
    if (statePtr->flags & TCP_SERVER_STATE) {
	/* state of server socket (listener) */
	if (statePtr->u.s.timer) {
	    Tcl_DeleteTimerHandler(statePtr->u.s.timer);
	    statePtr->u.s.timer = NULL;
	}
    } else {
	/* state of client socket */
	if (statePtr->u.c.addrlist != NULL) {
	    freeaddrinfo(statePtr->u.c.addrlist);
	}
	if (statePtr->u.c.myaddrlist != NULL) {
	    freeaddrinfo(statePtr->u.c.myaddrlist);
	}
    }

    ckfree(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *

        if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
            /*
             * Suppress errors as long as we are not done.
             */

            errno = 0;
        } else if (statePtr->u.c.connectError != 0) {
            errno = statePtr->u.c.connectError;
            statePtr->u.c.connectError = 0;
        } else {
            int err;

            getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err,
                    &optlen);
            errno = err;
        }

    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = instanceData;

    if (statePtr->flags & TCP_SERVER_STATE) {
        /*
         * Make sure we don't mess with server sockets since they will never
         * be readable or writable at the Tcl level. This keeps Tcl scripts
         * from interfering with the -accept behavior (bug #3394732).
         */

    	return;
    }

    if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
        /*
         * Async sockets use a FileHandler internally while connecting, so we
         * need to cache this request until the connection has succeeded.
         */

        statePtr->u.c.filehandlers = mask;
    } else if (mask) {

	/*
	 * Whether it is a bug or feature or otherwise, it is a fact of life
	 * that on at least some Linux kernels select() fails to report that a
	 * socket file descriptor is writable when the other end of the socket
	 * is closed.  This is in contrast to the guarantees Tcl makes that

    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    TcpState *statePtr)
{
    socklen_t optlen;
    int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
    int ret = -1, error = EHOSTUNREACH;
    int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    const char *errorMsg = NULL;
    int fd = statePtr->fds.fd;

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->u.c.addr = statePtr->u.c.addrlist;
         statePtr->u.c.addr != NULL;
         statePtr->u.c.addr = statePtr->u.c.addr->ai_next
    ) {
        for (statePtr->u.c.myaddr = statePtr->u.c.myaddrlist;
             statePtr->u.c.myaddr != NULL;
             statePtr->u.c.myaddr = statePtr->u.c.myaddr->ai_next
        ) {
            int reuseaddr = 1;

	    /*
	     * No need to try combinations of local and remote addresses of
	     * different families.
	     */

	    if (statePtr->u.c.myaddr->ai_family != statePtr->u.c.addr->ai_family) {
		continue;
	    }

            /*
             * Close the socket if it is still open from the last unsuccessful
             * iteration.
             */

            if (fd >= 0) {
		close(fd);
		fd = -1;
                errno = 0;
	    }

	    statePtr->fds.fd = fd = socket(
		statePtr->u.c.addr->ai_family, SOCK_STREAM, 0);
#ifdef CHECK_FD_SETSIZE_LIMIT
	    if (fd >= FD_SETSIZE) {
		close(fd);
		error = EBADFD;
		errorMsg = fdSetSizeViolationMsg;
		statePtr->fds.fd = fd = -1;
		goto out;
	    }
#endif
	    if (fd < 0) {
		if (errno == EMFILE) {
		    goto out;
		}
		continue;
	    }

	    /*
	     * Set the close-on-exec flag so that the socket will not get
	     * inherited by child processes.
	     */

	    fcntl(fd, F_SETFD, FD_CLOEXEC);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers(INT2PTR(fd), SOCKET_BUFSIZE);

	    if (async) {
                ret = TclUnixSetBlockingMode(fd, TCL_MODE_NONBLOCKING);

                if (ret < 0) {
                    continue;
                }
            }

            /*
             * Must reset the error variable here, before we use it for the
             * first time in this iteration.
             */

            error = 0;

            (void) setsockopt(fd, SOL_SOCKET, SO_REUSEADDR,
                    (char *) &reuseaddr, sizeof(reuseaddr));
            ret = bind(fd, statePtr->u.c.myaddr->ai_addr,
                    statePtr->u.c.myaddr->ai_addrlen);
            if (ret < 0) {
                error = errno;
                continue;
            }

	    /*
	     * 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.
	     */

	    ret = connect(fd, statePtr->u.c.addr->ai_addr,
                        statePtr->u.c.addr->ai_addrlen);
            if (ret < 0) {
                error = errno;
            }
	    if (ret < 0 && errno == EINPROGRESS) {
                Tcl_CreateFileHandler(fd,
                        TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback,
                        statePtr);
                errno = EWOULDBLOCK;
                SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                return TCL_OK;

            reenter:
                CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                Tcl_DeleteFileHandler(fd);

                /*
                 * Read the error state from the socket to see if the async
                 * connection has succeeded or failed. As this clears the
                 * error condition, we cache the status in the socket state
                 * struct for later retrieval by [fconfigure -error].
                 */

                optlen = sizeof(int);

                getsockopt(fd, SOL_SOCKET, SO_ERROR,
                        (char *) &error, &optlen);
                errno = error;
            }
	    if (error == 0) {
		goto out;
	    }
	}
    }

  out:
    statePtr->u.c.connectError = error;
    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    if (async_callback) {
        /*
         * An asynchonous connection has finally succeeded or failed.
         */

        TcpWatchProc(statePtr, statePtr->u.c.filehandlers);
        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->u.c.cachedBlocking);

        if (error != 0) {
            SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
        }

        /*
         * We need to forward the writable event that brought us here, bcasue
         * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
         * writable state from the socket, and so a subsequent select() on
         * behalf of a script level [fileevent] would not fire. It doesn't
         * hurt that this is also called in the successful case and will save
         * the event mechanism one roundtrip through select().
         */

	if (statePtr->u.c.cachedBlocking == TCL_MODE_NONBLOCKING) {
	    Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE);
	}
    }
    if (error != 0) {
        /*
         * Failure for either a synchronous connection, or an async one that
         * failed before it could enter background mode, e.g. because an
         * invalid -myaddr was given.
         */

        if (interp != NULL) {
            errno = error;
            if (errorMsg) {
                Tcl_SetErrorCode(interp, "POSIX", Tcl_ErrnoId(), errorMsg, NULL);
            } else {
                errorMsg = Tcl_PosixError(interp);
            }
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", errorMsg));
        }
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->u.c.cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->u.c.addrlist = addrlist;
    statePtr->u.c.myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;

    /*
     * Create a new client socket and wrap it in a channel.
     */

    if (TcpConnect(interp, statePtr) != TCL_OK) {

     */

    enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
    int my_errno = 0;

    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
	my_errno = errno;
	goto done;
    }

    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
                addrPtr->ai_protocol);
#ifdef CHECK_FD_SETSIZE_LIMIT
	if (sock >= FD_SETSIZE) {
	    my_errno = EBADFD;
	    errorMsg = fdSetSizeViolationMsg;
	    goto done;
	}
#endif
	if (sock == -1) {
	    if (howfar < SOCKET) {
		howfar = SOCKET;
		my_errno = errno;
	    }
	    continue;
	}

        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = ckalloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->flags = TCP_SERVER_STATE;
            statePtr->u.s.acceptProc = acceptProc;
            statePtr->u.s.acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
            newfds = &statePtr->fds;
        } else {
            newfds = ckalloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;

        /*
         * Set up the callback mechanism for accepting connections from new
         * clients.
         */

        Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds);
    }

  done:
    if (addrlist != NULL) {
	freeaddrinfo(addrlist);
    }
    if (statePtr != NULL) {
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	return statePtr->channel;
    }
    if (interp != NULL) {

        errno = my_errno;
        if (errorMsg) {

            Tcl_SetErrorCode(interp, "POSIX", Tcl_ErrnoId(), errorMsg, NULL);
        } else {
            errorMsg = Tcl_PosixError(interp);
        }
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", errorMsg));
    }
    if (sock != -1) {
	close(sock);
    }
    return NULL;
}

static void
RetardAccept(
    ClientData clientData)
{
    TcpFdList *fds = clientData;

    fds->statePtr->u.s.timer = NULL;
    Tcl_CreateFileHandler(fds->fd, TCL_READABLE, TcpAccept, fds);
}
/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *	Accept a TCP socket connection.	 This is called by the event loop.
 *
 * Results:

    address addr;		/* The remote address */
    socklen_t len;		/* For accept interface */
    char channelName[SOCK_CHAN_LENGTH];
    char host[NI_MAXHOST], port[NI_MAXSERV];

    len = sizeof(addr);
    newsock = accept(fds->fd, &addr.sa, &len);
#ifdef CHECK_FD_SETSIZE_LIMIT
    if (newsock >= FD_SETSIZE) {
	close(newsock);
	/* errorMsg = fdSetSizeViolationMsg; */
	newsock = -1;
    }
#endif
    if (newsock < 0) {
    	/* avoid busy wait: retard accept event */
    	len = 0;
	Tcl_DeleteFileHandler(fds->fd);
	fds->statePtr->u.s.timer = Tcl_CreateTimerHandler(1 /* SYNTHETIC_EVENT_TIME */,
		RetardAccept, fds);
    } else {
	/*
	 * Set close-on-exec flag to prevent the newly accepted socket from
	 * being inherited by child processes.
	 */

	(void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
    }

    newSockState = ckalloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);

    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
	    "auto crlf");

    if (newsock < 0) {
	SET_BITS(newSockState->flags, TCP_ASYNC_FAILED);
	newSockState->u.c.connectError = errno;
    }

    if (fds->statePtr->u.s.acceptProc != NULL) {
	if (!len || getnameinfo(&addr.sa, len, host, sizeof(host), 
		port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV) != 0
	) {
	    /* be sure in error case (e. g. no file descriptors) we'll still
	     * have a host arg. */
	    memcpy(host, "{}", 3);
	}
	fds->statePtr->u.s.acceptProc(fds->statePtr->u.s.acceptProcData,
                newSockState->channel, host, atoi(port));
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */