Tcl Source Code

Changes On Branch tip-456
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-456 Excluding Merge-Ins

This is equivalent to a diff from 40163c3c57 to 78d4429e3b

2017-04-10
11:01
Merge "tip-468" branch. Add new function Tcl_OpenTcpClientEx() with same change as Tcl_OpenTcpServer... Leaf check-in: 97a181d1d6 user: jan.nijtmans tags: tip-468-bis
2017-01-11
14:10
Merge core-8-6-branch. Do gcc-compiles with the option -Wwrite-strings, so we can detect mis-usage ... check-in: 81fb7a2a5e user: jan.nijtmans tags: trunk
2017-01-10
14:35
Further experimental follow-up: Add internal function TclOpenTcpClientEx(), as companion to Tcl_Open... Closed-Leaf check-in: 78d4429e3b user: jan.nijtmans tags: tip-456
13:56
Experimental follow-up: Change internal TclCreateSocketAddress() signature, from using "int port" to... check-in: 3b3fac1cee user: jan.nijtmans tags: tip-456
2017-01-09
19:09
New performance measurement routine "timerate" in opposition to "time" the execution limited by fixe... check-in: 886773ba3b user: sebres tags: sebres-trunk-timerate
18:28
Merge fix clock test-cases from 8.6: Make test clock-67.5 time zone independent - execution fails in... check-in: 40163c3c57 user: sebres tags: trunk
18:23
Fix clock test-cases: Make test clock-67.5 time zone independent - execution fails in the time zones... check-in: 77e3007f1a user: sebres tags: core-8-6-branch
17:53
Merge bug_b87ad7e914 check-in: ea80926604 user: sebres tags: trunk

Changes to generic/tclIOCmd.c.

  1488   1488   	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
  1489   1489   	NULL
  1490   1490       };
  1491   1491       enum socketOptions {
  1492   1492   	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
  1493   1493   	SKT_SERVER
  1494   1494       };
  1495         -    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
         1495  +    int optionIndex, a, server = 0, async = 0, reusep = -1,
  1496   1496   	reusea = -1;
  1497   1497       unsigned int flags = 0;
  1498         -    const char *host, *port, *myaddr = NULL;
         1498  +    const char *host, *port, *myaddr = NULL, *myport = NULL;
  1499   1499       Tcl_Obj *script = NULL;
  1500   1500       Tcl_Channel chan;
  1501   1501   
  1502   1502       if (TclpHasSockets(interp) != TCL_OK) {
  1503   1503   	return TCL_ERROR;
  1504   1504       }
  1505   1505   
................................................................................
  1528   1528   		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1529   1529   			"no argument given for -myaddr option", -1));
  1530   1530   		return TCL_ERROR;
  1531   1531   	    }
  1532   1532   	    myaddr = TclGetString(objv[a]);
  1533   1533   	    break;
  1534   1534   	case SKT_MYPORT: {
  1535         -	    const char *myPortName;
  1536         -
  1537   1535   	    a++;
  1538   1536   	    if (a >= objc) {
  1539   1537   		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1540   1538   			"no argument given for -myport option", -1));
  1541   1539   		return TCL_ERROR;
  1542   1540   	    }
  1543         -	    myPortName = TclGetString(objv[a]);
  1544         -	    if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
  1545         -		return TCL_ERROR;
  1546         -	    }
         1541  +	    myport = TclGetString(objv[a]);
  1547   1542   	    break;
  1548   1543   	}
  1549   1544   	case SKT_SERVER:
  1550   1545   	    if (async == 1) {
  1551   1546   		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1552   1547   			"cannot set -async option for server sockets", -1));
  1553   1548   		return TCL_ERROR;
................................................................................
  1666   1661   	 * Register a close callback. This callback will inform the
  1667   1662   	 * interpreter (if it still exists) that this channel does not need to
  1668   1663   	 * be informed when the interpreter is deleted.
  1669   1664   	 */
  1670   1665   
  1671   1666   	Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
  1672   1667       } else {
  1673         -	int portNum;
  1674         -
  1675         -	if (TclSockGetPort(interp, port, "tcp", &portNum) != TCL_OK) {
  1676         -	    return TCL_ERROR;
  1677         -	}
  1678         -
  1679         -	chan = Tcl_OpenTcpClient(interp, portNum, host, myaddr, myport, async);
         1668  +	chan = TclOpenTcpClientEx(interp, port, host, myaddr, myport, async);
  1680   1669   	if (chan == NULL) {
  1681   1670   	    return TCL_ERROR;
  1682   1671   	}
  1683   1672       }
  1684   1673   
  1685   1674       Tcl_RegisterChannel(interp, chan);
  1686   1675       Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));

Changes to generic/tclIOSock.c.

   154    154   
   155    155   int
   156    156   TclCreateSocketAddress(
   157    157       Tcl_Interp *interp,		/* Interpreter for querying the desired socket
   158    158   				 * family */
   159    159       struct addrinfo **addrlist,	/* Socket address list */
   160    160       const char *host,		/* Host. NULL implies INADDR_ANY */
   161         -    int port,			/* Port number */
          161  +    const char *service,	/* Service */
   162    162       int willBind,		/* Is this an address to bind() to or to
   163    163   				 * connect() to? */
   164    164       const char **errorMsgPtr)	/* Place to store the error message detail, if
   165    165   				 * available. */
   166    166   {
   167    167       struct addrinfo hints;
   168    168       struct addrinfo *p;
   169    169       struct addrinfo *v4head = NULL, *v4ptr = NULL;
   170    170       struct addrinfo *v6head = NULL, *v6ptr = NULL;
   171         -    char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
          171  +    char *native = NULL;
   172    172       const char *family = NULL;
   173    173       Tcl_DString ds;
   174    174       int result;
   175    175   
   176    176       if (host != NULL) {
   177    177   	native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
   178    178       }
   179    179   
   180    180       /*
   181    181        * Workaround for OSX's apparent inability to resolve "localhost", "0"
   182    182        * when the loopback device is the only available network interface.
   183    183        */
   184    184   
   185         -    if (host != NULL && port == 0) {
   186         -	portstring = NULL;
   187         -    } else {
   188         -	TclFormatInt(portbuf, port);
   189         -	portstring = portbuf;
          185  +    if (host != NULL && service != NULL && !strcmp(service, "0")) {
          186  +       service = NULL;
   190    187       }
   191    188   
   192    189       (void) memset(&hints, 0, sizeof(hints));
   193    190       hints.ai_family = AF_UNSPEC;
   194    191   
   195    192       /*
   196    193        * Magic variable to enforce a certain address family; to be superseded
................................................................................
   227    224   #endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
   228    225   #endif /* 0 */
   229    226   
   230    227       if (willBind) {
   231    228   	hints.ai_flags |= AI_PASSIVE;
   232    229       }
   233    230   
   234         -    result = getaddrinfo(native, portstring, &hints, addrlist);
          231  +    result = getaddrinfo(native, service, &hints, addrlist);
   235    232   
   236    233       if (host != NULL) {
   237    234   	Tcl_DStringFree(&ds);
   238    235       }
   239    236   
   240    237       if (result != 0) {
   241    238   	*errorMsgPtr =

Changes to generic/tclInt.h.

  3064   3064   MODULE_SCOPE int	TclpDeleteFile(const void *path);
  3065   3065   MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
  3066   3066   MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
  3067   3067   MODULE_SCOPE void	TclpFinalizePipes(void);
  3068   3068   MODULE_SCOPE void	TclpFinalizeSockets(void);
  3069   3069   MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
  3070   3070   			    struct addrinfo **addrlist,
  3071         -			    const char *host, int port, int willBind,
         3071  +			    const char *host, const char *service, int willBind,
  3072   3072   			    const char **errorMsgPtr);
         3073  +Tcl_Channel		TclOpenTcpClientEx(Tcl_Interp *interp,
         3074  +			    const char *service, const char *host,
         3075  +			    const char *myaddr,	const char *myservice,
         3076  +			    unsigned int flags);
  3073   3077   MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
  3074   3078   			    Tcl_ThreadCreateProc *proc, ClientData clientData,
  3075   3079   			    int stackSize, int flags);
  3076   3080   MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
  3077   3081   MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
  3078   3082   			    size_t *lengthPtr, Tcl_Encoding *encodingPtr);
  3079   3083   MODULE_SCOPE void	TclpInitLock(void);

Changes to unix/tclUnixSock.c.

  1278   1278       int port,			/* Port number to open. */
  1279   1279       const char *host,		/* Host on which to open port. */
  1280   1280       const char *myaddr,		/* Client-side address */
  1281   1281       int myport,			/* Client-side port */
  1282   1282       int async)			/* If nonzero, attempt to do an asynchronous
  1283   1283   				 * connect. Otherwise we do a blocking
  1284   1284   				 * connect. */
         1285  +{
         1286  +    char service[TCL_INTEGER_SPACE], myservice[TCL_INTEGER_SPACE];
         1287  +
         1288  +    TclFormatInt(service, port);
         1289  +    TclFormatInt(myservice, myport);
         1290  +
         1291  +    return TclOpenTcpClientEx(interp, service, host, myaddr, myservice, async!=0);
         1292  +}
         1293  +
         1294  +Tcl_Channel
         1295  +TclOpenTcpClientEx(
         1296  +    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
         1297  +    const char *service,	/* Port number to open. */
         1298  +    const char *host,		/* Host on which to open port. */
         1299  +    const char *myaddr,		/* Client-side address */
         1300  +    const char *myservice,	/* Client-side port */
         1301  +    unsigned int flags)		/* If nonzero, attempt to do an asynchronous
         1302  +				 * connect. Otherwise we do a blocking
         1303  +				 * connect. */
  1285   1304   {
  1286   1305       TcpState *statePtr;
  1287   1306       const char *errorMsg = NULL;
  1288   1307       struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
  1289   1308       char channelName[SOCK_CHAN_LENGTH];
  1290   1309   
  1291         -    /*
  1292         -     * Do the name lookups for the local and remote addresses.
  1293         -     */
  1294         -
  1295         -    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
  1296         -            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
         1310  +    if (!TclCreateSocketAddress(interp, &addrlist, host, service, 0, &errorMsg)
         1311  +            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myservice, 1,
  1297   1312                       &errorMsg)) {
  1298   1313           if (addrlist != NULL) {
  1299   1314               freeaddrinfo(addrlist);
  1300   1315           }
  1301   1316           if (interp != NULL) {
  1302   1317               Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  1303   1318                       "couldn't open socket: %s", errorMsg));
................................................................................
  1306   1321       }
  1307   1322   
  1308   1323       /*
  1309   1324        * Allocate a new TcpState for this socket.
  1310   1325        */
  1311   1326       statePtr = ckalloc(sizeof(TcpState));
  1312   1327       memset(statePtr, 0, sizeof(TcpState));
  1313         -    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
         1328  +    statePtr->flags = (flags&1) ? TCP_ASYNC_CONNECT : 0;
  1314   1329       statePtr->cachedBlocking = TCL_MODE_BLOCKING;
  1315   1330       statePtr->addrlist = addrlist;
  1316   1331       statePtr->myaddrlist = myaddrlist;
  1317   1332       statePtr->fds.fd = -1;
  1318   1333   
  1319   1334       /*
  1320   1335        * Create a new client socket and wrap it in a channel.
................................................................................
  1477   1492       chosenport = 0;
  1478   1493   
  1479   1494       if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
  1480   1495   	errorMsg = "invalid port number";
  1481   1496   	goto error;
  1482   1497       }
  1483   1498   
  1484         -    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
         1499  +    if (!TclCreateSocketAddress(interp, &addrlist, myHost, service, 1, &errorMsg)) {
  1485   1500   	my_errno = errno;
  1486   1501   	goto error;
  1487   1502       }
  1488   1503   
  1489   1504       for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
  1490   1505   	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
  1491   1506                   addrPtr->ai_protocol);

Changes to win/tclWinSock.c.

  1869   1869       }
  1870   1870       return TCL_OK;
  1871   1871   }
  1872   1872   
  1873   1873   /*
  1874   1874    *----------------------------------------------------------------------
  1875   1875    *
  1876         - * Tcl_OpenTcpClient --
         1876  + * Tcl_OpenTcpClient, TclOpenTcpClientEx --
  1877   1877    *
  1878   1878    *	Opens a TCP client socket and creates a channel around it.
  1879   1879    *
  1880   1880    * Results:
  1881   1881    *	The channel or NULL if failed. An error message is returned in the
  1882   1882    *	interpreter on failure.
  1883   1883    *
................................................................................
  1893   1893       int port,			/* Port number to open. */
  1894   1894       const char *host,		/* Host on which to open port. */
  1895   1895       const char *myaddr,		/* Client-side address */
  1896   1896       int myport,			/* Client-side port */
  1897   1897       int async)			/* If nonzero, attempt to do an asynchronous
  1898   1898   				 * connect. Otherwise we do a blocking
  1899   1899   				 * connect. */
         1900  +{
         1901  +    char service[TCL_INTEGER_SPACE], myservice[TCL_INTEGER_SPACE];
         1902  +
         1903  +    TclFormatInt(service, port);
         1904  +    TclFormatInt(myservice, myport);
         1905  +
         1906  +    return TclOpenTcpClientEx(interp, service, host, myaddr, myservice, async!=0);
         1907  +}
         1908  +
         1909  +Tcl_Channel
         1910  +TclOpenTcpClientEx(
         1911  +    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
         1912  +    const char *service,	/* Port number to open. */
         1913  +    const char *host,		/* Host on which to open port. */
         1914  +    const char *myaddr,		/* Client-side address */
         1915  +    const char *myservice,	/* Client-side port */
         1916  +    unsigned int flags)		/* If nonzero, attempt to do an asynchronous
         1917  +				 * connect. Otherwise we do a blocking
         1918  +				 * connect. */
  1900   1919   {
  1901   1920       TcpState *statePtr;
  1902   1921       const char *errorMsg = NULL;
  1903   1922       struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
  1904   1923       char channelName[SOCK_CHAN_LENGTH];
  1905   1924   
  1906   1925       if (TclpHasSockets(interp) != TCL_OK) {
................................................................................
  1917   1936   	return NULL;
  1918   1937       }
  1919   1938   
  1920   1939       /*
  1921   1940        * Do the name lookups for the local and remote addresses.
  1922   1941        */
  1923   1942   
  1924         -    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
  1925         -            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
         1943  +    if (!TclCreateSocketAddress(interp, &addrlist, host, service, 0, &errorMsg)
         1944  +            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myservice, 1,
  1926   1945                       &errorMsg)) {
  1927   1946           if (addrlist != NULL) {
  1928   1947               freeaddrinfo(addrlist);
  1929   1948           }
  1930   1949           if (interp != NULL) {
  1931   1950               Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  1932   1951                       "couldn't open socket: %s", errorMsg));
................................................................................
  1933   1952           }
  1934   1953           return NULL;
  1935   1954       }
  1936   1955   
  1937   1956       statePtr = NewSocketInfo(INVALID_SOCKET);
  1938   1957       statePtr->addrlist = addrlist;
  1939   1958       statePtr->myaddrlist = myaddrlist;
  1940         -    if (async) {
         1959  +    if (flags&1) {
  1941   1960   	statePtr->flags |= TCP_ASYNC_CONNECT;
  1942   1961       }
  1943   1962   
  1944   1963       /*
  1945   1964        * Create a new client socket and wrap it in a channel.
  1946   1965        */
  1947   1966       if (TcpConnect(interp, statePtr) != TCL_OK) {
................................................................................
  2074   2093        */
  2075   2094   
  2076   2095       if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
  2077   2096   	errorMsg = "invalid port number";
  2078   2097   	goto error;
  2079   2098       }
  2080   2099   
  2081         -    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
         2100  +    if (!TclCreateSocketAddress(interp, &addrlist, myHost, service, 1, &errorMsg)) {
  2082   2101   	goto error;
  2083   2102       }
  2084   2103   
  2085   2104       for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
  2086   2105   	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
  2087   2106                   addrPtr->ai_protocol);
  2088   2107   	if (sock == INVALID_SOCKET) {