merge core-8-5-branchbug_3601260

10 files changed, 82 insertions, 67 deletions

diff --git a/ChangeLog b/ChangeLog
index 3cbdd1a..130364c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2013-01-23  Donal K. Fellows  <dkf@users.sf.net>
+
+	* library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
+	for connect to avoid reentrancy problems (except when operating
+	without a -command option). Internally, this means that all sockets
+	created by the http package will always be operated in asynchronous
+	mode.
+
+2013-01-18  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include
+	sys/stat.h
+
 2013-01-16  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* Makefile.in: Enable win32 build with -DTCL_NO_DEPRECATED, just
diff --git a/generic/tcl.h b/generic/tcl.h
index 33730d4..5fde9dc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -436,7 +436,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 	struct {long tv_sec;} st_ctim;
 	/* Here is a 4-byte gap */
     } Tcl_StatBuf;
-#elif defined(HAVE_STRUCT_STAT64)
+#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
     typedef struct stat64 Tcl_StatBuf;
 #else
     typedef struct stat Tcl_StatBuf;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 944fb8e..8ec1b68 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -53,12 +53,12 @@ typedef struct {
  * The following macros greatly simplify moving through a table...
  */
 
-#define STRING_AT(table, offset, index) \
-	(*((const char *const *)(((char *)(table)) + ((offset) * (index)))))
+#define STRING_AT(table, offset) \
+	(*((const char *const *)(((char *)(table)) + (offset))))
 #define NEXT_ENTRY(table, offset) \
-	(&(STRING_AT(table, offset, 1)))
+	(&(STRING_AT(table, offset)))
 #define EXPAND_OF(indexRep) \
-	STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
+	STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
 
 /*
  *----------------------------------------------------------------------
@@ -138,7 +138,7 @@ Tcl_GetIndexFromObj(
  *	proper match, then TCL_ERROR is returned and an error message is left
  *	in interp's result (unless interp is NULL). The msg argument is used
  *	in the error message; for example, if msg has the value "option" then
- *	the error message will say something flag 'bad option "foo": must be
+ *	the error message will say something like 'bad option "foo": must be
  *	...'
  *
  * Side effects:
@@ -170,6 +170,10 @@ Tcl_GetIndexFromObjStruct(
     Tcl_Obj *resultPtr;
     IndexRep *indexRep;
 
+    /* Protect against invalid values, like -1 or 0. */
+    if (offset < (int)sizeof(char *)) {
+	offset = (int)sizeof(char *);
+    }
     /*
      * See if there is a valid cached result from a previous lookup.
      */
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 7021b8d..12a60db 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -19,11 +19,10 @@
 #endif
 #if defined(_WIN32)
 #   include "tclWinPort.h"
-#endif
-#include "tcl.h"
-#if !defined(_WIN32)
+#else
 #   include "tclUnixPort.h"
 #endif
+#include "tcl.h"
 
 #if !defined(LLONG_MIN)
 #   ifdef TCL_WIDE_INT_IS_LONG
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 6b82894..4a517ac 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -528,11 +528,10 @@ proc http::geturl {url args} {
     # If a timeout is specified we set up the after event and arrange for an
     # asynchronous socket connection.
 
-    set sockopts [list]
+    set sockopts [list -async]
     if {$state(-timeout) > 0} {
 	set state(after) [after $state(-timeout) \
 		[list http::reset $token timeout]]
-	lappend sockopts -async
     }
 
     # If we are using the proxy, we must pass in the full URL that includes
@@ -588,10 +587,15 @@ proc http::geturl {url args} {
         set socketmap($state(socketinfo)) $sock
     }
 
-    # Wait for the connection to complete.
+    if {![info exists phost]} {
+	set phost ""
+    }
+    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
 
-    if {$state(-timeout) > 0} {
-	fileevent $sock writable [list http::Connect $token]
+    # Wait for the connection to complete.
+    if {![info exists state(-command)]} {
+	# geturl does EVERYTHING asynchronously, so if the user
+	# calls it synchronously, we just do a wait here.
 	http::wait $token
 
 	if {![info exists state]} {
@@ -607,13 +611,29 @@ proc http::geturl {url args} {
 	    set err [lindex $state(error) 0]
 	    cleanup $token
 	    return -code error $err
-	} elseif {$state(status) ne "connect"} {
-	    # Likely to be connection timeout
-	    return $token
 	}
-	set state(status) ""
     }
 
+    return $token
+}
+
+
+proc http::Connected { token proto phost srvurl} {
+    variable http
+    variable urlTypes
+
+    variable $token
+    upvar 0 $token state
+
+    # Set back the variables needed here
+    set sock $state(sock)
+    set isQueryChannel [info exists state(-querychannel)]
+    set isQuery [info exists state(-query)]
+    set host [lindex [split $state(socketinfo) :] 0]
+    set port [lindex [split $state(socketinfo) :] 1]
+
+    set defport [lindex $urlTypes($proto) 0]
+
     # Send data in cr-lf format, but accept any line terminators
 
     fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
@@ -746,35 +766,17 @@ proc http::geturl {url args} {
 	    fileevent $sock readable [list http::Event $sock $token]
 	}
 
-	if {![info exists state(-command)]} {
-	    # geturl does EVERYTHING asynchronously, so if the user calls it
-	    # synchronously, we just do a wait here.
-
-	    wait $token
-	    if {$state(status) eq "error"} {
-		# Something went wrong, so throw the exception, and the
-		# enclosing catch will do cleanup.
-		return -code error [lindex $state(error) 0]
-	    }
-	}
     } err]} then {
 	# The socket probably was never connected, or the connection dropped
 	# later.
 
-	# Clean up after events and such, but DON'T call the command callback
-	# (if available) because we're going to throw an exception from here
-	# instead.
-
 	# if state(status) is error, it means someone's already called Finish
 	# to do the above-described clean up.
 	if {$state(status) ne "error"} {
-	    Finish $token $err 1
+	    Finish $token $err
 	}
-	cleanup $token
-	return -code error $err
     }
 
-    return $token
 }
 
 # Data access functions:
@@ -858,7 +860,7 @@ proc http::cleanup {token} {
 #	Sets the status of the connection, which unblocks
 # 	the waiting geturl call
 
-proc http::Connect {token} {
+proc http::Connect {token proto phost srvurl} {
     variable $token
     upvar 0 $token state
     set err "due to unexpected EOF"
@@ -866,10 +868,10 @@ proc http::Connect {token} {
 	[eof $state(sock)] ||
 	[set err [fconfigure $state(sock) -error]] ne ""
     } then {
-	Finish $token "connect failed $err" 1
+	Finish $token "connect failed $err"
     } else {
-	set state(status) connect
 	fileevent $state(sock) writable {}
+	::http::Connected $token $proto $phost $srvurl
     }
     return
 }
diff --git a/tests/http.test b/tests/http.test
index 3a9d4ba..3ec0a6f 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -464,9 +464,8 @@ test http-4.14 {http::Event} -body {
 	error "bogus return from http::geturl"
     }
     http::wait $token
-    http::status $token
-    # error code varies among platforms.
-} -returnCodes 1 -match regexp -result {(connect failed|couldn't open socket)}
+    lindex [http::error $token] 0
+} -result {connect failed connection refused}
 # Bogus host
 test http-4.15 {http::Event} -body {
     # This test may fail if you use a proxy server. That is to be
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 06c19b9..67bd498 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -992,7 +992,7 @@ TclWinCPUID(
                  "mov %%ebx, %%esi   \n\t" /* save what cpuid just put in %ebx */
                  "mov %%edi, %%ebx  \n\t" /* restore the old %ebx */
                  : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
-                 : "a"(index) : "edi");
+                 : "a"(index) : "edi","ebx");
     status = TCL_OK;
 #endif
     return status;
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 79f115e..d655990 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -232,7 +232,7 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;
 #endif /* NO_REALPATH */
 
 #ifdef HAVE_FTS
-#ifdef HAVE_STRUCT_STAT64
+#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
 /* fts doesn't do stat64 */
 #define noFtsStat 1
 #elif defined(__APPLE__) && defined(__LP64__) && \
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 40434a0..5abac9d 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1183,8 +1183,9 @@ TclpUtime(
     return utime(Tcl_FSGetNativePath(pathPtr), tval);
 }
 #ifdef __CYGWIN__
-int TclOSstat(const char *name, Tcl_StatBuf *statBuf) {
+int TclOSstat(const char *name, void *cygstat) {
     struct stat buf;
+    Tcl_StatBuf *statBuf = cygstat;
     int result = stat(name, &buf);
     statBuf->st_mode = buf.st_mode;
     statBuf->st_ino = buf.st_ino;
@@ -1199,8 +1200,9 @@ int TclOSstat(const char *name, Tcl_StatBuf *statBuf) {
     statBuf->st_ctime = buf.st_ctime;
     return result;
 }
-int TclOSlstat(const char *name, Tcl_StatBuf *statBuf) {
+int TclOSlstat(const char *name, void *cygstat) {
     struct stat buf;
+    Tcl_StatBuf *statBuf = cygstat;
     int result = lstat(name, &buf);
     statBuf->st_mode = buf.st_mode;
     statBuf->st_ino = buf.st_ino;
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 4668707..7cfeec0 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -22,10 +22,6 @@
 
 #ifndef _TCLUNIXPORT
 #define _TCLUNIXPORT
-
-#ifndef MODULE_SCOPE
-#define MODULE_SCOPE extern
-#endif
 
 /*
  *---------------------------------------------------------------------------
@@ -89,22 +85,22 @@ typedef off_t		Tcl_SeekOffset;
 #   define HINSTANCE void *
 #   define SOCKET unsigned int
 #   define WSAEWOULDBLOCK 10035
-    DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
-    DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
-    DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
+    __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
+    __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int);
+    __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
 	    const char *, int, const char *, const char *);
 
-    DLLIMPORT extern int cygwin_conv_path(int, const void *, void *, int);
-    DLLIMPORT extern int cygwin_conv_path_list(int, const void *, void *, int);
+    __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
+    __declspec(dllimport) extern int cygwin_conv_path_list(int, const void *, void *, int);
 #   define USE_PUTENV 1
 #   define USE_PUTENV_FOR_UNSET 1
 /* On Cygwin, the environment is imported from the Cygwin DLL. */
 #   define environ __cygwin_environ
 #   define timezone _timezone
-    DLLIMPORT extern char **__cygwin_environ;
-    MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
-    MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
-#elif defined(HAVE_STRUCT_STAT64)
+    extern char **__cygwin_environ;
+    extern int TclOSstat(const char *name, void *statBuf);
+    extern int TclOSlstat(const char *name, void *statBuf);
+#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
 #   define TclOSstat		stat64
 #   define TclOSlstat		lstat64
 #else
@@ -147,7 +143,7 @@ typedef off_t		Tcl_SeekOffset;
 #   include "../compat/unistd.h"
 #endif
 
-MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
+extern int TclUnixSetBlockingMode(int fd, int mode);
 
 #include <utime.h>
 
@@ -658,11 +654,11 @@ extern int pthread_getattr_np (pthread_t, pthread_attr_t *);
 
 #include <grp.h>
 
-MODULE_SCOPE struct passwd*  TclpGetPwNam(const char *name);
-MODULE_SCOPE struct group*   TclpGetGrNam(const char *name);
-MODULE_SCOPE struct passwd*  TclpGetPwUid(uid_t uid);
-MODULE_SCOPE struct group*   TclpGetGrGid(gid_t gid);
-MODULE_SCOPE struct hostent* TclpGetHostByName(const char *name);
-MODULE_SCOPE struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
+extern struct passwd*  TclpGetPwNam(const char *name);
+extern struct group*   TclpGetGrNam(const char *name);
+extern struct passwd*  TclpGetPwUid(uid_t uid);
+extern struct group*   TclpGetGrGid(gid_t gid);
+extern struct hostent* TclpGetHostByName(const char *name);
+extern struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
 
 #endif /* _TCLUNIXPORT */