diff options
| -rw-r--r-- | unix/tclUnixSock.c | 35 | ||||
| -rw-r--r-- | win/tclWinSock.c | 221 |
2 files changed, 202 insertions, 54 deletions
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index d06e7f1..a9752ea 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -127,6 +127,9 @@ 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); @@ -150,7 +153,7 @@ static const Tcl_ChannelType tcpChannelType = { TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ - NULL, /* Set option proc. */ + TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ @@ -751,6 +754,34 @@ TcpHostPortList( /* *---------------------------------------------------------------------- * + * 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 @@ -914,7 +945,7 @@ TcpGetOptionProc( /* *---------------------------------------------------------------------- * - * TcpWatchProc -- + * WrapNotify -- * * Initialize the notifier to watch the fd from this channel. * diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 66df291..ef2d82b 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -248,6 +248,8 @@ static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, 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); @@ -1123,6 +1125,7 @@ TcpSetOptionProc( 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; @@ -1142,6 +1145,93 @@ TcpSetOptionProc( 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; @@ -1192,9 +1282,9 @@ TcpSetOptionProc( return TCL_OK; } - return Tcl_BadChannelOption(interp, optionName, "keepalive nagle"); + return Tcl_BadChannelOption(interp, optionName, "error keepalive nagle"); #else - return Tcl_BadChannelOption(interp, optionName, ""); + return Tcl_BadChannelOption(interp, optionName, "error"); #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } @@ -1265,56 +1355,14 @@ TcpGetOptionProc( (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); - } - } + * 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; } @@ -1513,6 +1561,75 @@ TcpGetOptionProc( /* *---------------------------------------------------------------------- * + * 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 |