Tcl Source Code

Changes On Branch tip-428
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-428 Excluding Merge-Ins

This is equivalent to a diff from 44cb942486 to 1984d275c5

2014-10-18
20:03
[10dc6daa37] New fix for [gets] on non-blocking channel. This time properly accounts for the effects... check-in: 58e5b26f2a user: dgp tags: trunk
2014-10-17
15:30
[10dc6daa37] [gets] on a non-blocking channel must take care so that 1) At least one call to the cha... check-in: 1271c3edfe user: dgp tags: experiment
14:28
Merge trunk Closed-Leaf check-in: 1984d275c5 user: oehhar tags: tip-428
12:52
fconfigure -peername and -sockname return empty string while async connect running. check-in: 44cb942486 user: oehhar tags: trunk
12:28
New tests: 14.16: -peername empty while async connect running, 14.17: -sockname check-in: de0ebf629b user: oehhar tags: tip-427
2014-10-10
20:37
Resolve test conflicts over global vars check-in: 524b934ef0 user: dgp tags: trunk
2014-09-26
11:34
Win implementation of TIP 428 Rev 1.21: fconfigure channel -error ?errorDictVar? check-in: 2d27b66029 user: oehhar tags: tip-428

Changes to unix/tclUnixSock.c.

123
124
125
126
127
128
129



130
131
132
133
134
135
136
...
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
...
747
748
749
750
751
752
753




























754
755
756
757
758
759
760
...
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
static int		TcpBlockModeProc(ClientData data, int mode);
static int		TcpCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		TcpClose2Proc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		TcpGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);



static int		TcpGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
................................................................................
static const Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TcpCloseProc,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    TcpClose2Proc,		/* Close2 proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
................................................................................
    }
    Tcl_DStringAppendElement(dsPtr, nport);
}
 
/*
 *----------------------------------------------------------------------
 *




























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

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:






>
>
>







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
...
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
static int		TcpBlockModeProc(ClientData data, int mode);
static int		TcpCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		TcpClose2Proc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		TcpGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TcpSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static int		TcpGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
................................................................................
static const Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TcpCloseProc,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    TcpSetOptionProc,		/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    TcpClose2Proc,		/* Close2 proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
................................................................................
    }
    Tcl_DStringAppendElement(dsPtr, nport);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TcpSetOptionProc --
 *
 *	Sets Tcp channel specific options.
 *
 * Results:
 *	None, unless an error happens.
 *
 * Side effects:
 *	Changes attributes of the socket at the system level.
 *
 *----------------------------------------------------------------------
 */

static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    const char *value)		/* New value for option. */
{
    TcpState *statePtr = instanceData;

    return Tcl_BadChannelOption(interp, optionName, "");
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
................................................................................

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * WrapNotify --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:

Changes to win/tclWinSock.c.

244
245
246
247
248
249
250


251
252
253
254
255
256
257
....
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128
1129
1130
1131
1132
....
1137
1138
1139
1140
1141
1142
1143























































































1144
1145
1146
1147
1148
1149
1150
....
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
....
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
....
1505
1506
1507
1508
1509
1510
1511





































































1512
1513
1514
1515
1516
1517
1518
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);


static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
static void		TcpThreadActionProc(ClientData instanceData,
			    int action);
................................................................................
static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    const char *value)		/* New value for option. */
{

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SOCKET sock;
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
................................................................................
    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	}
	return TCL_ERROR;
    }
























































































#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
    sock = statePtr->sockets->fd;

    if (!strcasecmp(optionName, "-keepalive")) {
	BOOL val = FALSE;
................................................................................
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
#else
    return Tcl_BadChannelOption(interp, optionName, "");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
 
/*
 *----------------------------------------------------------------------
 *
 * TcpGetOptionProc --
................................................................................
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {

	/*
	* Do not return any errors if async connect is running
	*/
	if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) {


	    if ( statePtr->flags & TCP_ASYNC_FAILED ) {

		/*
		 * In case of a failed async connect, eventually report the
		 * connect error only once.
		 * Do not report the system error, as this comes again and again.
		 */

		if ( statePtr->connectError != 0 ) {
		    Tcl_DStringAppend(dsPtr,
			    Tcl_ErrnoMsg(statePtr->connectError), -1);
		    statePtr->connectError = 0;
		}

	    } else {

		/*
		 * Report an eventual last error of the socket system
		 */

		int optlen;
		int ret;
		DWORD err;

		/*
		 * Populater the err Variable with a possix error
		 */
		optlen = sizeof(int);
		ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
			(char *)&err, &optlen);
		/*
		 * The error was not returned directly but should be
		 * taken from WSA
		 */
		if (ret == SOCKET_ERROR) {
		    err = WSAGetLastError();
		}
		/*
		 * Return error message
		 */
		if (err) {
		    TclWinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
		}
	    }
	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {

................................................................................
#else
	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
    }

    return TCL_OK;
}





































































 
/*
 *----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Informs the channel driver of the events that the generic channel code






>
>







 







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|

|







 







|
|
|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
<
|
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
....
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
....
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
....
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
....
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360




1361



































1362
1363
1364

1365


1366
1367
1368
1369
1370
1371
1372
....
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		GetSocketError(TcpState *statePtr);

static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
static void		TcpThreadActionProc(ClientData instanceData,
			    int action);
................................................................................
static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    const char *value)		/* New value for option. */
{
    TcpState *statePtr = instanceData;
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SOCKET sock;
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
................................................................................
    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	}
	return TCL_ERROR;
    }

    /* 
     * Go one step in async connect
     * If any error is thrown save it as backround error to report eventually below
     */
    WaitForConnect(statePtr, NULL);

    /*
     * Option -error otherVar: Return socket error and socket error dict (TIP 428)
     */
    if (!strcmp(optionName, "-error")) {

	Tcl_Obj *errorDictPtr;

	/*
	 * Get error code and clear it
	 */
	int errorCode=GetSocketError(statePtr);
	
	/*
	 * Check for interpreter - otherwise we can not output
	 */
	if (!interp) {
	    return TCL_OK;
	}
	
	/*
	 * Clear any existing result
	 */
	Tcl_ResetResult(interp);
	
	/*
	 * Write -code key to dictionary with value 0/1
	 */
	errorDictPtr = Tcl_NewDictObj();
	if ( TCL_ERROR == Tcl_DictObjPut(interp, errorDictPtr,
		Tcl_NewStringObj("-code",-1), Tcl_NewBooleanObj(errorCode)) ) {
	    return TCL_ERROR;
	}

	if (0 != errorCode) {

	    /*
	     * Add key -errorcode with list value: POSIX id message
	     */
	    Tcl_Obj *errorMessagePtr;
	    Tcl_Obj *valuePtr = Tcl_NewObj();
	    errorMessagePtr = Tcl_NewStringObj(Tcl_ErrnoMsg(errorCode),-1);
	    Tcl_SetErrno(errorCode);
	    if (TCL_ERROR == Tcl_ListObjAppendElement(interp, valuePtr,
			Tcl_NewStringObj("POSSIX",-1)) ||
		    TCL_ERROR == Tcl_ListObjAppendElement(interp, valuePtr,
			Tcl_NewStringObj(Tcl_ErrnoId(),-1)) ||
		    TCL_ERROR == Tcl_ListObjAppendElement(interp, valuePtr,
			errorMessagePtr)) {
		return TCL_ERROR;
	    } 

	    if ( TCL_ERROR == Tcl_DictObjPut(interp, errorDictPtr,
		    Tcl_NewStringObj("-errorcode",-1), valuePtr) ) {
		return TCL_ERROR;
	    }

	    /*
	     * Set the result to the error message (shared with last list
	     * member of the -errorcode value).
	     */
	    Tcl_SetObjResult(interp,errorMessagePtr);
	}

	/*
	 * Save to specified variable
	 */
	if ( NULL ==
		Tcl_SetVar2Ex(interp, value, NULL, errorDictPtr, TCL_LEAVE_ERR_MSG ))
	{
	    /*
	     * Setting variable failed. This may also due to a variable name issue
	     * like an existing array with the same name.
	     * Thus treat this gracefully and clear temporary memory.
	     */
	    Tcl_DecrRefCount(errorDictPtr);
	    return TCL_ERROR;
	}
	
	return TCL_OK;
    }

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
    sock = statePtr->sockets->fd;

    if (!strcasecmp(optionName, "-keepalive")) {
	BOOL val = FALSE;
................................................................................
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName, "error keepalive nagle");
#else
    return Tcl_BadChannelOption(interp, optionName, "error");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
 
/*
 *----------------------------------------------------------------------
 *
 * TcpGetOptionProc --
................................................................................
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {

	/*
	 * Get error code and clear it
	 */
	int errorCode=GetSocketError(statePtr);




	/*



































	 * Return error message
	 */
	if (errorCode != 0) {

	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);


	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {

................................................................................
#else
	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * GetSocketError --
 *
 *	Get the error code for fconfigure -error.
 *
 * Results:
 *	error code.
 *
 * Side effects:
 *	Resets the error state.
 *
 *----------------------------------------------------------------------
 */

static int
GetSocketError(
    TcpState *statePtr)		/* The socket state. */
{
    int errorCode = 0;
    
    /*
     * Do not return any errors if async connect is running
     */
    if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
	return 0;
    }
    if ( statePtr->flags & TCP_ASYNC_FAILED ) {

	/*
	 * In case of a failed async connect, eventually report the
	 * connect error only once.
	 * Do not report the system error, as this comes again and again.
	 */

	errorCode = statePtr->connectError;
	statePtr->connectError = 0;
    } else {

	/*
	 * Report an eventual last error of the socket system
	 */

	int optlen;
	int ret;
	DWORD err;

	/*
	 * Populater the err Variable with a possix error
	 */
	optlen = sizeof(int);
	ret = getsockopt(statePtr->sockets->fd, SOL_SOCKET, SO_ERROR,
		(char *)&err, &optlen);
	/*
	 * The error was not returned directly but should be
	 * taken from WSA
	 */
	if (ret == SOCKET_ERROR) {
	    err = WSAGetLastError();
	}
	if (err) {
	    TclWinConvertError(err);
	    errorCode = Tcl_GetErrno();
	}
    }
    return errorCode;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Informs the channel driver of the events that the generic channel code