windows fixes for virtualizing child std{in,out,err} handles,

attempts to lock uninitialized critical section in files that
were never explicitly opened (from Doug Lankshear)

p4raw-id: //depot/perl@5169

4 files changed, 42 insertions, 5 deletions

diff --git a/iperlsys.h b/iperlsys.h
index 7b20d5dd5b..d07d525edc 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -597,6 +597,7 @@ typedef char*		(*LPENVGetenv_len)(struct IPerlEnv*,
 typedef unsigned long	(*LPEnvOsID)(struct IPerlEnv*);
 typedef char*		(*LPEnvLibPath)(struct IPerlEnv*, char*);
 typedef char*		(*LPEnvSiteLibPath)(struct IPerlEnv*, char*);
+typedef void		(*LPEnvGetChildIO)(struct IPerlEnv*, child_IO_table*);
 #endif
 
 struct IPerlEnv
@@ -618,6 +619,7 @@ struct IPerlEnv
     LPEnvOsID		pEnvOsID;
     LPEnvLibPath	pLibPath;
     LPEnvSiteLibPath	pSiteLibPath;
+    LPEnvGetChildIO	pGetChildIO;
 #endif
 };
 
@@ -663,6 +665,8 @@ struct IPerlEnvInfo
 	(*PL_Env->pLibPath)(PL_Env,(str))
 #define PerlEnv_sitelib_path(str)				\
 	(*PL_Env->pSiteLibPath)(PL_Env,(str))
+#define PerlEnv_get_child_IO(ptr)				\
+	(*PL_Env->pGetChildIO)(PL_Env, ptr)
 #endif
 
 #else	/* PERL_IMPLICIT_SYS */
@@ -686,6 +690,7 @@ struct IPerlEnvInfo
 
 #ifdef WIN32
 #define PerlEnv_os_id()			win32_os_id()
+#define PerlEnv_get_child_IO(ptr)	win32_get_child_IO(ptr)
 #endif
 
 #endif	/* PERL_IMPLICIT_SYS */
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 4b4ad586a4..a748ead0b2 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -486,6 +486,12 @@ PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
     return g_win32_get_sitelib(pl);
 }
 
+void
+PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
+{
+    win32_get_child_IO(ptr);
+}
+
 struct IPerlEnv perlEnv = 
 {
     PerlEnvGetenv,
@@ -500,6 +506,7 @@ struct IPerlEnv perlEnv =
     PerlEnvOsId,
     PerlEnvLibPath,
     PerlEnvSiteLibPath,
+    PerlEnvGetChildIO,
 };
 
 #undef IPERL2HOST
diff --git a/win32/win32.c b/win32/win32.c
index b17275928a..ff52692fec 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2713,7 +2713,12 @@ _fixed_read(int fh, void *buf, unsigned cnt)
 	return -1;
     }
 
-    EnterCriticalSection(&(_pioinfo(fh)->lock));  /* lock file */
+    /*
+     * If lockinitflag is FALSE, assume fd is device
+     * lockinitflag is set to TRUE by open.
+     */
+    if (_pioinfo(fh)->lockinitflag)
+	EnterCriticalSection(&(_pioinfo(fh)->lock));  /* lock file */
 
     bytes_read = 0;                 /* nothing read yet */
     buffer = (char*)buf;
@@ -2861,7 +2866,8 @@ _fixed_read(int fh, void *buf, unsigned cnt)
     }
 
 functionexit:	
-    LeaveCriticalSection(&(_pioinfo(fh)->lock));    /* unlock file */
+    if (_pioinfo(fh)->lockinitflag)
+	LeaveCriticalSection(&(_pioinfo(fh)->lock));    /* unlock file */
 
     return bytes_read;
 }
@@ -3123,6 +3129,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     int ret;
     void* env;
     char* dir;
+    child_IO_table tbl;
     STARTUPINFO StartupInfo;
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
@@ -3151,9 +3158,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     }
     memset(&StartupInfo,0,sizeof(StartupInfo));
     StartupInfo.cb = sizeof(StartupInfo);
-    StartupInfo.hStdInput  = GetStdHandle(STD_INPUT_HANDLE);
-    StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
-    StartupInfo.hStdError  = GetStdHandle(STD_ERROR_HANDLE);
+    PerlEnv_get_child_IO(&tbl);
+    StartupInfo.hStdInput  = tbl.childStdIn;
+    StartupInfo.hStdOutput = tbl.childStdOut;
+    StartupInfo.hStdError  = tbl.childStdErr;
     if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE &&
 	StartupInfo.hStdOutput != INVALID_HANDLE_VALUE &&
 	StartupInfo.hStdError != INVALID_HANDLE_VALUE)
@@ -3964,6 +3972,15 @@ Perl_win32_init(int *argcp, char ***argvp)
     MALLOC_INIT;
 }
 
+void
+win32_get_child_IO(child_IO_table* ptbl)
+{
+    ptbl->childStdIn	= GetStdHandle(STD_INPUT_HANDLE);
+    ptbl->childStdOut	= GetStdHandle(STD_OUTPUT_HANDLE);
+    ptbl->childStdErr	= GetStdHandle(STD_ERROR_HANDLE);
+}
+
+
 #ifdef USE_ITHREADS
 
 #  ifdef PERL_OBJECT
diff --git a/win32/win32.h b/win32/win32.h
index 4e9a42251b..4e73a23fe6 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -301,6 +301,14 @@ DllExport int		RunPerl(int argc, char **argv, char **env);
 DllExport bool		SetPerlInterpreter(void* interp);
 DllExport void*		GetPerlInterpreter(void);
 
+typedef struct {
+    HANDLE	childStdIn;
+    HANDLE	childStdOut;
+    HANDLE	childStdErr;
+} child_IO_table;
+
+DllExport void		win32_get_child_IO(child_IO_table* ptr);
+
 #ifndef USE_SOCKETS_AS_HANDLES
 extern FILE *		my_fdopen(int, char *);
 #endif