From 5cb86aa574bf8ab539797a9b908bb87db6e5b91e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Jul 2012 08:03:17 +0000 Subject: Make registry 1.3 package (and possibly others) dynamically loadable in Tcl 8.4 Reverted. No good reason to partially hack 8.5 features into (only one patch release of) 8.4. If you need to support Tcl 8.4, just don't use [tcl::pkgconfig]. If you're set on moving to [tcl::pkgconfig], then that's an 8.5 features and you're choosing to drop 8.4 support. --- ChangeLog | 5 +++++ library/init.tcl | 58 +++++++++++++++++++++++++++++++++++++------------------- tests/init.test | 9 ++++++--- 3 files changed, 50 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index de29b61..8ad896e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-16 Jan Nijtmans + + * library/init.tcl: Make registry 1.3 package (and possibly others) + * tests/init.test: dynamically loadable in Tcl 8.4. + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/library/init.tcl b/library/init.tcl index f2f85e1..4c4b6db 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -66,7 +66,7 @@ namespace eval tcl { } } } - + # Windows specific end of initialization if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} { @@ -187,7 +187,7 @@ proc unknown args { # may get modified if caught errors occur below. The variables will # be restored just before re-executing the missing command. - # Safety check in case something unsets the variables + # Safety check in case something unsets the variables # ::errorInfo or ::errorCode. [Bug 1063707] if {![info exists errorCode]} { set errorCode "" @@ -222,7 +222,7 @@ proc unknown args { if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. - # Note the dependence on how Tcl_AddErrorInfo, etc. + # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set cinfo $args @@ -340,7 +340,7 @@ proc unknown args { # library file to create the procedure. Returns 1 if it successfully # loaded the procedure, 0 otherwise. # -# Arguments: +# Arguments: # cmd - Name of the command to find and load. # namespace (optional) The namespace where the command is being used - must be # a canonical namespace as returned [namespace current] @@ -364,7 +364,7 @@ proc auto_load {cmd {namespace {}}} { # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better - # route is to use + # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { return 1 @@ -395,7 +395,7 @@ proc auto_load {cmd {namespace {}}} { # of available commands. Returns 1 if the index is loaded, and 0 if # the index is already loaded and up to date. # -# Arguments: +# Arguments: # None. proc auto_load_index {} { @@ -424,7 +424,7 @@ proc auto_load_index {} { eval [read $f] } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { - if {[string index $line 0] eq "#" + if {[string index $line 0] eq "#" || ([llength $line] != 2)} { continue } @@ -484,7 +484,7 @@ proc auto_qualify {cmd namespace} { return [list [string range $cmd 2 end]] } } - + # Potentially returning 2 elements to try : # (if the current namespace is not the global one) @@ -542,13 +542,13 @@ proc auto_import {pattern} { # auto_execok -- # -# Returns string that indicates name of program to execute if +# Returns string that indicates name of program to execute if # name corresponds to a shell builtin or an executable in the -# Windows search path, or "" otherwise. Builds an associative -# array auto_execs that caches information about previous checks, +# Windows search path, or "" otherwise. Builds an associative +# array auto_execs that caches information about previous checks, # for speed. # -# Arguments: +# Arguments: # name - Name of a command. if {$tcl_platform(platform) eq "windows"} { @@ -603,7 +603,7 @@ proc auto_execok name { set path "[file dirname [info nameof]];.;" if {[info exists env(WINDIR)]} { - set windir $env(WINDIR) + set windir $env(WINDIR) } if {[info exists windir]} { if {$tcl_platform(os) eq "Windows NT"} { @@ -668,13 +668,13 @@ proc auto_execok name { # This procedure is called by Tcl's core when attempts to call the # filesystem's copydirectory function fail. The semantics of the call # are that 'dest' does not yet exist, i.e. dest should become the exact -# image of src. If dest does exist, we throw an error. -# +# image of src. If dest does exist, we throw an error. +# # Note that making changes to this procedure can change the results # of running Tcl's tests. # -# Arguments: -# action - "renaming" or "copying" +# Arguments: +# action - "renaming" or "copying" # src - source directory # dest - destination directory proc tcl::CopyDirectory {action src dest} { @@ -729,12 +729,12 @@ proc tcl::CopyDirectory {action src dest} { # Have to be careful to capture both visible and hidden files. # We will also be more generous to the file system and not # assume the hidden and non-hidden lists are non-overlapping. - # + # # On Unix 'hidden' files begin with '.'. On other platforms # or filesystems hidden files may have other interpretations. set filelist [concat [glob -nocomplain -directory $src *] \ [glob -nocomplain -directory $src -types hidden *]] - + foreach s [lsort -unique $filelist] { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { file copy $s [file join $dest [file tail $s]] @@ -742,3 +742,23 @@ proc tcl::CopyDirectory {action src dest} { } return } + +# ::tcl::pkgconfig -- +# +# This procedure is undocumented. It is meant to make the dde +# and registry packages distributed with Tcl 8.6 and the Thread +# 2.7 package (and possibly others) dynamically loadable in Tcl 8.4. +# +# Arguments: +# action - "get" +# key - "debug" or "threaded" +proc tcl::pkgconfig {{action {}} {key {}} args} { + if {$action eq "get"} { + if {$key eq "debug"} { + return [info exists ::tcl_platform(debug)] + } elseif {$key eq "threaded"} { + return [info exists ::tcl_platform(threaded)] + } + } + error {invalid command name "::tcl::pkgconfig"} +} diff --git a/tests/init.test b/tests/init.test index 79142c4..c46ba48 100644 --- a/tests/init.test +++ b/tests/init.test @@ -117,13 +117,11 @@ test init-2.6 {load setLogCmd from safe:: - stage 1} { rename ::safe::setLogCmd {} ; # should not fail } {} -test init-2.7 {oad setLogCmd from safe:: - stage 2} { +test init-2.7 {load setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ; # should not fail } {} - - test init-2.8 {load tcl::HistAdd} -setup { auto_reset catch {rename ::tcl::HistAdd {}} @@ -134,6 +132,11 @@ test init-2.8 {load tcl::HistAdd} -setup { rename ::tcl::HistAdd {} ; } -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}} +test init-2.9 {undocumented tcl::pkgconfig} -setup { +} -body { + list [catch {::tcl::pkgconfig} error] $error + } -cleanup { +} -result {1 {invalid command name "::tcl::pkgconfig"}} test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { -- cgit v0.12 From cea9be24359eda18e04e8b95f9674a376a016675 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 16 Jul 2012 22:40:10 +0000 Subject: [Bug 3544683]: Backport of reentrancy fix for super-POSIX correctness of the passwd/group access functions. --- ChangeLog | 9 ++ unix/tclUnixCompat.c | 270 ++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 225 insertions(+), 54 deletions(-) diff --git a/ChangeLog b/ChangeLog index aecbf9c..ae28d4f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2012-07-16 Donal K. Fellows + + * unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam) + (TclpGetGrGid): [Bug 3544683]: Use the elaborate memory management + scheme outlined on http://www.opengroup.org/austin/docs/austin_328.txt + to handle Tcl's use of standard reentrant versions of the passwd/group + access functions so that everything can work on all BSDs. Problem + identified by Stuart Cassoff. + 2012-07-11 Jan Nijtmans * win/tclWinReg.c: [Bug #3362446]: registry keys command fails diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index f582c0c..8b067af 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -13,8 +13,10 @@ #include #include -/* See also: SC_BLOCKING_STYLE in unix/tcl.m4 +/* + * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ + #ifdef USE_FIONBIO # ifdef HAVE_SYS_FILIO_H # include /* For FIONBIO. */ @@ -23,39 +25,6 @@ # include # endif #endif /* USE_FIONBIO */ - -/* - *--------------------------------------------------------------------------- - * - * TclUnixSetBlockingMode -- - * - * Set the blocking mode of a file descriptor. - * - * Results: - * - * 0 on success, -1 (with errno set) on error. - * - *--------------------------------------------------------------------------- - */ -int -TclUnixSetBlockingMode( - int fd, /* File descriptor */ - int mode) /* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */ -{ -#ifndef USE_FIONBIO - int flags = fcntl(fd, F_GETFL); - - if (mode == TCL_MODE_BLOCKING) { - flags &= ~O_NONBLOCK; - } else { - flags |= O_NONBLOCK; - } - return fcntl(fd, F_SETFL, flags); -#else /* USE_FIONBIO */ - int state = (mode == TCL_MODE_NONBLOCKING); - return ioctl(fd, FIONBIO, &state); -#endif /* !USE_FIONBIO */ -} /* * Used to pad structures at size'd boundaries @@ -82,10 +51,22 @@ TclUnixSetBlockingMode( typedef struct ThreadSpecificData { struct passwd pwd; +#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) +#define NEED_PW_CLEANER 1 + char *pbuf; + int pbuflen; +#else char pbuf[2048]; +#endif struct group grp; +#if defined(HAVE_GETGRNAM_R_5) || defined(HAVE_GETGRGID_R_5) +#define NEED_GR_CLEANER 1 + char *gbuf; + int gbuflen; +#else char gbuf[2048]; +#endif #if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR) struct hostent hent; @@ -124,14 +105,57 @@ static int CopyGrp(struct group *tgtPtr, char *buf, int buflen); static int CopyHostent(struct hostent *tgtPtr, char *buf, int buflen); static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen); -static int CopyString(CONST char *src, char *buf, int buflen); +static int CopyString(const char *src, char *buf, int buflen); #endif + +#ifdef NEED_PW_CLEANER +static void FreePwBuf(ClientData ignored); +#endif +#ifdef NEED_GR_CLEANER +static void FreeGrBuf(ClientData ignored); +#endif #endif /* TCL_THREADS */ /* *--------------------------------------------------------------------------- * + * TclUnixSetBlockingMode -- + * + * Set the blocking mode of a file descriptor. + * + * Results: + * + * 0 on success, -1 (with errno set) on error. + * + *--------------------------------------------------------------------------- + */ + +int +TclUnixSetBlockingMode( + int fd, /* File descriptor */ + int mode) /* Either TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ +{ +#ifndef USE_FIONBIO + int flags = fcntl(fd, F_GETFL); + + if (mode == TCL_MODE_BLOCKING) { + flags &= ~O_NONBLOCK; + } else { + flags |= O_NONBLOCK; + } + return fcntl(fd, F_SETFL, flags); +#else /* USE_FIONBIO */ + int state = (mode == TCL_MODE_NONBLOCKING); + + return ioctl(fd, FIONBIO, &state); +#endif /* !USE_FIONBIO */ +} + +/* + *--------------------------------------------------------------------------- + * * TclpGetPwNam -- * * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more @@ -158,8 +182,33 @@ TclpGetPwNam( #if defined(HAVE_GETPWNAM_R_5) struct passwd *pwPtr = NULL; - return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), - &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->pbuf == NULL) { + tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); + if (tsdPtr->pbuflen < 1) { + tsdPtr->pbuflen = 1024; + } + tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen); + Tcl_CreateThreadExitHandler(FreePwBuf, NULL); + } + while (1) { + int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, + &pwPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->pbuflen *= 2; + tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + } + return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWNAM_R_4) return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -214,8 +263,33 @@ TclpGetPwUid( #if defined(HAVE_GETPWUID_R_5) struct passwd *pwPtr = NULL; - return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), - &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->pbuf == NULL) { + tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); + if (tsdPtr->pbuflen < 1) { + tsdPtr->pbuflen = 1024; + } + tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen); + Tcl_CreateThreadExitHandler(FreePwBuf, NULL); + } + while (1) { + int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, + &pwPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->pbuflen *= 2; + tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + } + return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWUID_R_4) return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -244,6 +318,29 @@ TclpGetPwUid( /* *--------------------------------------------------------------------------- * + * FreePwBuf -- + * + * Helper that is used to dispose of space allocated and referenced from + * the ThreadSpecificData for user entries. (Darn that baroque POSIX + * reentrant interface.) + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_PW_CLEANER +static void +FreePwBuf( + ClientData ignored) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + ckfree(tsdPtr->pbuf); +} +#endif /* NEED_PW_CLEANER */ + +/* + *--------------------------------------------------------------------------- + * * TclpGetGrNam -- * * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more @@ -267,11 +364,36 @@ TclpGetGrNam( #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); -#if defined(HAVE_GETGRNAM_R_5) +#ifdef HAVE_GETGRNAM_R_5 struct group *grPtr = NULL; - return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), - &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->gbuf == NULL) { + tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); + if (tsdPtr->gbuflen < 1) { + tsdPtr->gbuflen = 1024; + } + tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen); + Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); + } + while (1) { + int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, + &grPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->gbuflen *= 2; + tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + } + return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRNAM_R_4) return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -326,8 +448,33 @@ TclpGetGrGid( #if defined(HAVE_GETGRGID_R_5) struct group *grPtr = NULL; - return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), - &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->gbuf == NULL) { + tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); + if (tsdPtr->gbuflen < 1) { + tsdPtr->gbuflen = 1024; + } + tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen); + Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); + } + while (1) { + int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, + &grPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->gbuflen *= 2; + tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + } + return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRGID_R_4) return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -356,6 +503,29 @@ TclpGetGrGid( /* *--------------------------------------------------------------------------- * + * FreeGrBuf -- + * + * Helper that is used to dispose of space allocated and referenced from + * the ThreadSpecificData for group entries. (Darn that baroque POSIX + * reentrant interface.) + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_GR_CLEANER +static void +FreeGrBuf( + ClientData ignored) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + ckfree(tsdPtr->gbuf); +} +#endif /* NEED_GR_CLEANER */ + +/* + *--------------------------------------------------------------------------- + * * TclpGetHostByName -- * * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for @@ -769,7 +939,7 @@ CopyArray( #ifdef NEED_COPYSTRING static int CopyString( - CONST char *src, /* String to copy. */ + const char *src, /* String to copy. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { @@ -788,14 +958,6 @@ CopyString( #endif /* NEED_COPYSTRING */ /* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - -/* *------------------------------------------------------------------------ * * TclWinCPUID -- @@ -831,7 +993,7 @@ TclWinCPUID( #endif return status; } - + /* * Local Variables: * mode: c -- cgit v0.12 From 65cd3b085a130ef32fbef6644dbdabe61dc096ca Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jul 2012 12:47:45 +0000 Subject: [Bug 3544932]: Visual studio compiler check fails --- ChangeLog | 4 ++++ win/makefile.vc | 7 +++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index de29b61..3c74475 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-07-17 Jan Nijtmans + + * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/win/makefile.vc b/win/makefile.vc index 426c907..d7845d3 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,10 +12,9 @@ # Copyright (c) 2001-2002 David Gravereaux. #------------------------------------------------------------------------------ -# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) -# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define -# VCINSTALLDIR instead. -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR) +# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or +# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WindowsSDKDir) MSG = ^ You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ -- cgit v0.12