Add mutex for accessing ENV

11 files changed, 31 insertions, 4 deletions

diff --git a/dosish.h b/dosish.h
index 98f8f998e6..5b2716046d 100644
--- a/dosish.h
+++ b/dosish.h
@@ -51,7 +51,8 @@
 #  define PERL_SYS_TERM_BODY()                         \
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
-    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;
+    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;
 #endif
 #define dXSUB_SYS dNOOP
 
diff --git a/embedvar.h b/embedvar.h
index dff0af64d4..5b6aa2b82a 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -397,6 +397,8 @@
 #define PL_Gdo_undump		(my_vars->Gdo_undump)
 #define PL_dollarzero_mutex	(my_vars->Gdollarzero_mutex)
 #define PL_Gdollarzero_mutex	(my_vars->Gdollarzero_mutex)
+#define PL_env_mutex		(my_vars->Genv_mutex)
+#define PL_Genv_mutex		(my_vars->Genv_mutex)
 #define PL_fold_locale		(my_vars->Gfold_locale)
 #define PL_Gfold_locale		(my_vars->Gfold_locale)
 #define PL_hash_chars		(my_vars->Ghash_chars)
diff --git a/makedef.pl b/makedef.pl
index 5fbca37752..f0805e9059 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -399,6 +399,7 @@ unless ($define{'USE_ITHREADS'}) {
 		    PL_regex_pad
 		    PL_regex_padav
 		    PL_dollarzero_mutex
+		    PL_env_mutex
 		    PL_hints_mutex
 		    PL_locale_mutex
 		    PL_lc_numeric_mutex
diff --git a/perl.c b/perl.c
index 6d1fff3a25..dc555fbc95 100644
--- a/perl.c
+++ b/perl.c
@@ -96,6 +96,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
 	HINTS_REFCNT_INIT;
         LOCALE_INIT;
         USER_PROP_MUTEX_INIT;
+        ENV_INIT;
 	MUTEX_INIT(&PL_dollarzero_mutex);
 	MUTEX_INIT(&PL_my_ctx_mutex);
 #  endif
diff --git a/perl.h b/perl.h
index b8f697240c..c734548771 100644
--- a/perl.h
+++ b/perl.h
@@ -2907,6 +2907,21 @@ typedef struct padname PADNAME;
 #  define USE_ENVIRON_ARRAY
 #endif
 
+#ifdef USE_ITHREADS
+   /* On some platforms it would be safe to use a read/write mutex with many
+    * readers possible at the same time.  On other platforms, notably IBM ones,
+    * subsequent getenv calls destroy earlier ones.  Those platforms would not
+    * be able to handle simultaneous getenv calls */
+#  define ENV_LOCK            MUTEX_LOCK(&PL_env_mutex)
+#  define ENV_UNLOCK          MUTEX_UNLOCK(&PL_env_mutex)
+#  define ENV_INIT            MUTEX_INIT(&PL_env_mutex);
+#  define ENV_TERM            MUTEX_DESTROY(&PL_env_mutex);
+#else
+#  define ENV_LOCK       NOOP;
+#  define ENV_UNLOCK     NOOP;
+#  define ENV_INIT       NOOP;
+#  define ENV_TERM       NOOP;
+#endif
 
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
     /* having sigaction(2) means that the OS supports both 1-arg and 3-arg
diff --git a/perlapi.h b/perlapi.h
index 221493437c..f3ef930c06 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -119,6 +119,8 @@ END_EXTERN_C
 #define PL_do_undump		(*Perl_Gdo_undump_ptr(NULL))
 #undef  PL_dollarzero_mutex
 #define PL_dollarzero_mutex	(*Perl_Gdollarzero_mutex_ptr(NULL))
+#undef  PL_env_mutex
+#define PL_env_mutex		(*Perl_Genv_mutex_ptr(NULL))
 #undef  PL_fold_locale
 #define PL_fold_locale		(*Perl_Gfold_locale_ptr(NULL))
 #undef  PL_hash_chars
diff --git a/perlvars.h b/perlvars.h
index 5a351a060b..24ff324c15 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -104,6 +104,7 @@ PERLVARI(G, mmap_page_size, IV, 0)
 
 #if defined(USE_ITHREADS)
 PERLVAR(G, hints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
+PERLVAR(G, env_mutex, perl_mutex)      /* Mutex for accessing ENV */
 #  if ! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV)
 PERLVAR(G, locale_mutex, perl_mutex)   /* Mutex for setlocale() changing */
 #  endif
diff --git a/symbian/symbianish.h b/symbian/symbianish.h
index 3b8c0e7a76..3b0ddb3f3c 100644
--- a/symbian/symbianish.h
+++ b/symbian/symbianish.h
@@ -122,7 +122,7 @@
 #ifndef PERL_SYS_TERM_BODY
 #define PERL_SYS_TERM_BODY()	HINTS_REFCNT_TERM; OP_REFCNT_TERM;          \
 				PERLIO_TERM; MALLOC_TERM; CloseSTDLIB();    \
-                                LOCALE_TERM
+                                LOCALE_TERM; ENV_TERM;
 
 #endif
 
diff --git a/unixish.h b/unixish.h
index 697a242243..5bf5b93690 100644
--- a/unixish.h
+++ b/unixish.h
@@ -142,6 +142,7 @@ int afstat(int fd, struct stat *statb);
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
     MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;                                          \
     amigaos4_dispose_fork_array();
 #endif
 
@@ -154,7 +155,8 @@ int afstat(int fd, struct stat *statb);
 #  define PERL_SYS_TERM_BODY()                         \
     HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM;      \
     OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM;  \
-    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;
+    MALLOC_TERM; LOCALE_TERM; USER_PROP_MUTEX_TERM;    \
+    ENV_TERM;
 
 #endif
 
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 8dca211b5a..3fae5d781e 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -310,7 +310,8 @@ struct interp_intern {
 #define BIT_BUCKET "/dev/null"
 #define PERL_SYS_INIT_BODY(c,v)	MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); PERLIO_INIT; MALLOC_INIT
 #define PERL_SYS_TERM_BODY()    HINTS_REFCNT_TERM; OP_REFCNT_TERM;      \
-                                PERLIO_TERM; MALLOC_TERM; LOCALE_TERM
+                                PERLIO_TERM; MALLOC_TERM; LOCALE_TERM   \
+                                ENV_TERM;
 #define dXSUB_SYS dNOOP
 #define HAS_KILL
 #define HAS_WAIT
diff --git a/win32/win32.c b/win32/win32.c
index 874f27bdbd..7f5482b65e 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -4553,6 +4553,7 @@ Perl_win32_term(void)
     PERLIO_TERM;
     MALLOC_TERM;
     LOCALE_TERM;
+    ENV_TERM;
 #ifndef WIN32_NO_REGISTRY
     /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
        but no point of checking and we can't die() at this point */