From a5cfbafa9098e5ae4018b3142702fd8138417776 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 17 Jan 2013 13:29:07 +0000
Subject: Proposed fix, by kakaroto, for Bug 2911139: http::geturl abuses vwait
on async call
---
library/http/http.tcl | 64 ++++++++++++++++++++++++++-------------------------
1 file changed, 33 insertions(+), 31 deletions(-)
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
}
--
cgit v0.12
From b97db66908c73a912c7b14f9502bad2fd6f7971a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 18 Jan 2013 13:58:32 +0000
Subject: [Bug 3598300]: unix: tcl.h does not include sys/stat.h. (with an
exception for OSX, for now)
---
ChangeLog | 5 +++++
generic/tclPort.h | 4 +++-
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/ChangeLog b/ChangeLog
index 3cbdd1a..9328946 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+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/tclPort.h b/generic/tclPort.h
index 7021b8d..198ee76 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -19,9 +19,11 @@
#endif
#if defined(_WIN32)
# include "tclWinPort.h"
+#elif !defined(MAC_OSX_TCL)
+# include "tclUnixPort.h"
#endif
#include "tcl.h"
-#if !defined(_WIN32)
+#if defined(MAC_OSX_TCL)
# include "tclUnixPort.h"
#endif
--
cgit v0.12
From f50af0e8c33d29a694f03efedfc7bf1ae18b3e16 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 18 Jan 2013 14:30:25 +0000
Subject: ... and fix cygwin build
---
unix/tclUnixFile.c | 6 ++++--
unix/tclUnixPort.h | 34 +++++++++++++++-------------------
2 files changed, 19 insertions(+), 21 deletions(-)
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..99c564b 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,21 +85,21 @@ 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);
+ 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)
# define TclOSstat stat64
# define TclOSlstat lstat64
@@ -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 */
--
cgit v0.12
From 62a66095ee80918300cf2d26a7cbecf8fdfab4e1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 18 Jan 2013 15:07:18 +0000
Subject: Proposed solution for Bug 3598300 on MacOSX
---
generic/tcl.h | 3 +--
generic/tclPort.h | 5 +----
unix/tclUnixFCmd.c | 2 +-
unix/tclUnixPort.h | 2 +-
4 files changed, 4 insertions(+), 8 deletions(-)
diff --git a/generic/tcl.h b/generic/tcl.h
index 33730d4..5b23694 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -327,7 +327,6 @@ typedef long LONG;
# undef TCL_WIDE_INT_IS_LONG
# undef TCL_CFG_DO64BIT
# endif /* __LP64__ */
-# undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */
/*
@@ -436,7 +435,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/tclPort.h b/generic/tclPort.h
index 198ee76..12a60db 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -19,13 +19,10 @@
#endif
#if defined(_WIN32)
# include "tclWinPort.h"
-#elif !defined(MAC_OSX_TCL)
+#else
# include "tclUnixPort.h"
#endif
#include "tcl.h"
-#if defined(MAC_OSX_TCL)
-# include "tclUnixPort.h"
-#endif
#if !defined(LLONG_MIN)
# ifdef TCL_WIDE_INT_IS_LONG
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/tclUnixPort.h b/unix/tclUnixPort.h
index 99c564b..7cfeec0 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -100,7 +100,7 @@ typedef off_t Tcl_SeekOffset;
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)
+#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
# define TclOSstat stat64
# define TclOSlstat lstat64
#else
--
cgit v0.12
From 0389d9d276a16e5f11a8ec823cb2334e4b5d119a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 22 Jan 2013 08:16:44 +0000
Subject: Fix test-case http-4.14
---
tests/http.test | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/tests/http.test b/tests/http.test
index 3a9d4ba..b03df88 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -465,8 +465,7 @@ test http-4.14 {http::Event} -body {
}
http::wait $token
http::status $token
- # error code varies among platforms.
-} -returnCodes 1 -match regexp -result {(connect failed|couldn't open socket)}
+} -result {timeout}
# Bogus host
test http-4.15 {http::Event} -body {
# This test may fail if you use a proxy server. That is to be
--
cgit v0.12
From 21be09ba34563c7d9fd3b0d013fe643c63f00174 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 22 Jan 2013 21:56:27 +0000
Subject: Bug [3601804]: platformCPUID segmentation fault on Darwin
---
unix/tclUnixCompat.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 71bd846..1969d1c 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -698,7 +698,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;
--
cgit v0.12
From ae2b9cd377978ef7018b95e2d16b17042e2eb76b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 22 Jan 2013 22:53:26 +0000
Subject: Now really fix test-case http-4.14
---
tests/http.test | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/tests/http.test b/tests/http.test
index b03df88..3ec0a6f 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -464,8 +464,8 @@ test http-4.14 {http::Event} -body {
error "bogus return from http::geturl"
}
http::wait $token
- http::status $token
-} -result {timeout}
+ 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
--
cgit v0.12
From c58c25ef079a96e684e2be9bdf78040c84c3cf9b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 23 Jan 2013 13:57:30 +0000
Subject: Protect Tcl_GetIndexFromObjStruct from invalid "offset" values, like
0 or -1. Undocumented, because I don't want to promote people start using
that.
---
generic/tclIndexObj.c | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index cc50fd3..0103cdb 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -144,7 +144,7 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
* 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
+ * error message will say something like 'bad option "foo": must be
* ...'
*
* Side effects:
@@ -176,6 +176,10 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
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.
*/
--
cgit v0.12