Tcl Source Code

Tcl_Channel
\fBTcl_MakeTcpClientChannel\fR(\fIsock\fR)
.sp
Tcl_Channel
\fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR)
.sp
Tcl_Channel
\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, backlog, proc, clientData\fR)
.sp
.SH ARGUMENTS
.AS Tcl_TcpAcceptProc clientData
.AP Tcl_Interp *interp in
Tcl interpreter to use for error reporting.  If non-NULL and an
error occurs, an error message is left in the interpreter's result.
.AP int port in

is allocated at random.
.AP "const char" *myaddr in
A string specifying the host name or address for network interface to use
for the local end of the connection.  If NULL, a default interface is
chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
.AP int backlog in
Length of OS listen backlog queue. Use -1 for default value.
.AP "unsigned int" flags in
ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
informations about the socket being created.
.AP ClientData sock in
Platform-specific handle for client TCP socket.
.AP Tcl_TcpAcceptProc *proc in
Pointer to a procedure to invoke each time a new connection is

# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
    Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName,
	    const char *modeString, int permissions)
}
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int flags)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
}
declare 201 {

declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #

# TIP #456/#468
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, int backlog,
	    Tcl_TcpAcceptProc *acceptProc, void *callbackData)
}

# TIP #430
declare 632 {
    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
	    const char *zipname, const char *passwd)
}

/* 630 */
EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags, int backlog,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 632 */
EXTERN int		TclZipfs_Mount(Tcl_Interp *interp,
				const char *mountPoint, const char *zipname,
				const char *passwd);
/* 633 */

    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, int backlog, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
    void (*tcl_FreeInternalRep) (Tcl_Obj *objPtr); /* 636 */
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, TCL_HASH_TYPE numBytes); /* 637 */
    Tcl_ObjInternalRep * (*tcl_FetchInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */

Tcl_SocketObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const socketOptions[] = {
	"-async", "-backlog", "-myaddr", "-myport", "-reuseaddr",
	"-reuseport", "-server", NULL
    };
    enum socketOptionsEnum {
	SKT_ASYNC, SKT_BACKLOG, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR,
	SKT_REUSEPORT, SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1, backlog = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseport option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case SKT_BACKLOG:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -backlog option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[a], &backlog) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */

	a++;
    } else {
	Interp *iPtr;

    wrongNumArgs:
	iPtr = (Interp *) interp;
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-async? ?-myaddr addr? ?-myport myport? host port");
	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv,
		"-server command ?-backlog count? ?-myaddr addr? "
		"?-reuseaddr boolean? ?-reuseport boolean? port");

	return TCL_ERROR;
    }

    if (!server && (reusea != -1 || reusep != -1 || backlog != -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"options -backlog, -reuseaddr, and -reuseport are only valid "
		"for servers", -1));
	return TCL_ERROR;
    }

    /*
     * Set the options to their default value if the user didn't override
     * their value.
     */

    if (server) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags, backlog,
		AcceptCallbackProc, acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    ckfree(acceptCallbackPtr);
	    return TCL_ERROR;
	}

    const char *host,
    Tcl_TcpAcceptProc *acceptProc,
    ClientData callbackData)
{
    char portbuf[TCL_INTEGER_SPACE];

    TclFormatInt(portbuf, port);
    return Tcl_OpenTcpServerEx(interp, portbuf, host, -1,
	    TCL_TCPSERVER_REUSEADDR, acceptProc, callbackData);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

# ----------------------------------------------------------------------

test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server
} -returnCodes error -result {no argument given for -server option}
test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo
} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"}
test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myaddr
} -returnCodes error -result {no argument given for -myaddr option}
test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myaddr $localhost
} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"}
test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport
} -returnCodes error -result {no argument given for -myport option}
test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport xxxx
} -returnCodes error -result {expected integer but got "xxxx"}
test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport 2522
} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"}
test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -froboz
} -returnCodes error -result {bad option "-froboz": must be -async, -backlog, -myaddr, -myport, -reuseaddr, -reuseport, or -server}
test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket host 2528 -junk
} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"}
test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server callback 2520 --
} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"}
test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket foo badport
} -returnCodes error -result {expected integer but got "badport"}
test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -async -server
} -returnCodes error -result {cannot set -async option for server sockets}
test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo -async
} -returnCodes error -result {cannot set -async option for server sockets}
test socket_$af-1.15 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr yes 4242
} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers}
test socket_$af-1.16 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr no 4242
} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers}
test socket_$af-1.17 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr
} -returnCodes error -result {no argument given for -reuseaddr option}
test socket_$af-1.18 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport yes 4242
} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers}
test socket_$af-1.19 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport no 4242
} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers}
test socket_$af-1.20 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport
} -returnCodes error -result {no argument given for -reuseport option}

set path(script) [makeFile {} script]

test socket_$af-2.1 {tcp connection} -constraints [list socket supported_$af stdio] -setup {

Tcl_Channel
Tcl_OpenTcpServerEx(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    int backlog,                /* Length of OS listen backlog queue. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    void *acceptProcData)	/* Data for the callback. */
{
    int status = 0, sock = -1, optvalue, port, chosenport;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */

             * addresses.
             */

            if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
                chosenport = ntohs(sockname.sa4.sin_port);
            }
        }
        if (backlog < 0) {
            backlog = SOMAXCONN;
        }
        status = listen(sock, backlog);
        if (status < 0) {
	    if (howfar < LISTEN) {
		howfar = LISTEN;
		my_errno = errno;
	    }
            close(sock);
            sock = -1;

Tcl_Channel
Tcl_OpenTcpServerEx(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    int backlog,                /* Length of OS listen backlog queue, or -1
                                 * for default. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    void *acceptProcData)	/* Data for the callback. */
{
    SOCKET sock = INVALID_SOCKET;
    unsigned short chosenport = 0;

	/*
	 * Set the maximum number of pending connect requests to the max
	 * value allowed on each platform (Win32 and Win32s may be
	 * different, and there may be differences between TCP/IP stacks).
	 */

        if (backlog < 0) {
            backlog = SOMAXCONN;
        }
	if (listen(sock, backlog) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    continue;
	}

	if (statePtr == NULL) {
	    /*