/* #include "config.h" */
-#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
+#if !defined(PERLIO_IS_STDIO)
# define PerlIO FILE
#endif
static void get_shell(void);
static char* find_next_space(const char *s);
static int do_spawn2(pTHX_ const char *cmd, int exectype);
-static long find_pid(int pid);
+static int do_spawn2_handles(pTHX_ const char *cmd, int exectype,
+ const int *handles);
+static int do_spawnvp_handles(int mode, const char *cmdname,
+ const char * const *argv, const int *handles);
+static long find_pid(pTHX_ int pid);
static void remove_dead_process(long child);
static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
+static int my_killpg(int pid, int sig);
static int my_kill(int pid, int sig);
static void out_of_memory(void);
static char* wstr_to_str(const wchar_t* wstr);
WPARAM wParam, LPARAM lParam);
#ifdef USE_ITHREADS
-static long find_pseudo_pid(int pid);
+static long find_pseudo_pid(pTHX_ int pid);
static void remove_dead_pseudo_process(long child);
static HWND get_hwnd_delay(pTHX, long child, DWORD tries);
#endif
START_EXTERN_C
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
char w32_module_name[MAX_PATH+1];
+#ifdef WIN32_DYN_IOINFO_SIZE
+Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
+#endif
END_EXTERN_C
static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
? GetModuleHandle(NULL)
: w32_perldll_handle);
- OSVERSIONINFO osver; /* g_osver may not yet be initialized */
- osver.dwOSVersionInfoSize = sizeof(osver);
- GetVersionEx(&osver);
-
- if (osver.dwMajorVersion > 4) {
- WCHAR modulename[MAX_PATH];
- WCHAR fullname[MAX_PATH];
- char *ansi;
+ WCHAR modulename[MAX_PATH];
+ WCHAR fullname[MAX_PATH];
+ char *ansi;
- DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
- (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
- GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
+ DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
+ (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
+ GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
- GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
+ GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
- /* Make sure we get an absolute pathname in case the module was loaded
- * explicitly by LoadLibrary() with a relative path. */
- GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
+ /* Make sure we get an absolute pathname in case the module was loaded
+ * explicitly by LoadLibrary() with a relative path. */
+ GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
- /* Make sure we start with the long path name of the module because we
- * later scan for pathname components to match "5.xx" to locate
- * compatible sitelib directories, and the short pathname might mangle
- * this path segment (e.g. by removing the dot on NTFS to something
- * like "5xx~1.yy") */
- if (pfnGetLongPathNameW)
- pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
+ /* Make sure we start with the long path name of the module because we
+ * later scan for pathname components to match "5.xx" to locate
+ * compatible sitelib directories, and the short pathname might mangle
+ * this path segment (e.g. by removing the dot on NTFS to something
+ * like "5xx~1.yy") */
+ if (pfnGetLongPathNameW)
+ pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
- /* remove \\?\ prefix */
- if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
- memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
+ /* remove \\?\ prefix */
+ if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
+ memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
- ansi = win32_ansipath(fullname);
- my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
- win32_free(ansi);
- }
- else {
- GetModuleFileName(module, w32_module_name, sizeof(w32_module_name));
-
- /* remove \\?\ prefix */
- if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
- memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
-
- /* try to get full path to binary (which may be mangled when perl is
- * run from a 16-bit app) */
- /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
- win32_longpath(w32_module_name);
- /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/
- }
+ ansi = win32_ansipath(fullname);
+ my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
+ win32_free(ansi);
/* normalize to forward slashes */
ptr = w32_module_name;
{
dTHX;
if (!*svp)
- *svp = sv_2mortal(newSVpvn("",0));
+ *svp = sv_2mortal(newSVpvs(""));
SvGROW(*svp, datalen);
retval = RegQueryValueEx(handle, valuename, 0, NULL,
(PBYTE)SvPVX(*svp), &datalen);
/* directory exists */
dTHX;
if (!*prev_pathp)
- *prev_pathp = sv_2mortal(newSVpvn("",0));
+ *prev_pathp = sv_2mortal(newSVpvs(""));
else if (SvPVX(*prev_pathp))
- sv_catpvn(*prev_pathp, ";", 1);
+ sv_catpvs(*prev_pathp, ";");
sv_catpv(*prev_pathp, mod_name);
if(len)
*len = SvCUR(*prev_pathp);
EXTERN_C char *
win32_get_privlib(const char *pl, STRLEN *const len)
{
- dTHX;
char *stdlib = "lib";
char buffer[MAX_PATH+1];
SV *sv = NULL;
win32_get_xlib(const char *pl, const char *xlib, const char *libname,
STRLEN *const len)
{
- dTHX;
char regstr[40];
char pathstr[MAX_PATH+1];
SV *sv1 = NULL;
if (!sv1) {
sv1 = sv2;
} else if (sv2) {
- sv_catpvn(sv1, ";", 1);
+ dTHX;
+ sv_catpv(sv1, ";");
sv_catsv(sv1, sv2);
}
char **retvstart = 0;
int items = -1;
if (str) {
- dTHX;
int slen = strlen(str);
char *ret;
char **retv;
}
static int
-do_spawn2(pTHX_ const char *cmd, int exectype)
+do_spawn2(pTHX_ const char *cmd, int exectype) {
+ return do_spawn2_handles(aTHX_ cmd, exectype, NULL);
+}
+
+static int
+do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles)
{
char **a;
char *s;
(const char* const*)argv);
break;
case EXECF_SPAWN_NOWAIT:
- status = win32_spawnvp(P_NOWAIT, argv[0],
- (const char* const*)argv);
+ status = do_spawnvp_handles(P_NOWAIT, argv[0],
+ (const char* const*)argv, handles);
break;
case EXECF_EXEC:
status = win32_execvp(argv[0], (const char* const*)argv);
(const char* const*)argv);
break;
case EXECF_SPAWN_NOWAIT:
- status = win32_spawnvp(P_NOWAIT, argv[0],
- (const char* const*)argv);
+ status = do_spawnvp_handles(P_NOWAIT, argv[0],
+ (const char* const*)argv, handles);
break;
case EXECF_EXEC:
status = win32_execvp(argv[0], (const char* const*)argv);
DllExport DIR *
win32_opendir(const char *filename)
{
- dTHX;
+ dTHXa(NULL);
DIR *dirp;
long len;
long idx;
/* do the FindFirstFile call */
MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
+ aTHXa(PERL_GET_THX);
dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
if (dirp->handle == INVALID_HANDLE_VALUE) {
/* Now set up for the next call to readdir */
dirp->curr += len + 1;
if (dirp->curr >= dirp->end) {
- dTHX;
BOOL res;
char buffer[MAX_PATH*2];
DllExport int
win32_closedir(DIR *dirp)
{
- dTHX;
if (dirp->handle != INVALID_HANDLE_VALUE)
FindClose(dirp->handle);
Safefree(dirp->start);
}
static long
-find_pid(int pid)
+find_pid(pTHX_ int pid)
{
- dTHX;
long child = w32_num_children;
while (--child >= 0) {
if ((int)w32_child_pids[child] == pid)
#ifdef USE_ITHREADS
static long
-find_pseudo_pid(int pid)
+find_pseudo_pid(pTHX_ int pid)
{
- dTHX;
long child = w32_num_pseudo_children;
while (--child >= 0) {
if ((int)w32_pseudo_child_pids[child] == pid)
return 0;
}
-int
-killpg(int pid, int sig)
+/* returns number of processes killed */
+static int
+my_killpg(int pid, int sig)
{
HANDLE process_handle;
HANDLE snapshot_handle;
if (Process32First(snapshot_handle, &entry)) {
do {
if (entry.th32ParentProcessID == (DWORD)pid)
- killed += killpg(entry.th32ProcessID, sig);
+ killed += my_killpg(entry.th32ProcessID, sig);
entry.dwSize = sizeof(entry);
}
while (Process32Next(snapshot_handle, &entry));
return killed;
}
+/* returns number of processes killed */
static int
my_kill(int pid, int sig)
{
HANDLE process_handle;
if (sig < 0)
- return killpg(pid, -sig);
+ return my_killpg(pid, -sig);
process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
/* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
#ifdef USE_ITHREADS
if (pid < 0) {
/* it is a pseudo-forked child */
- child = find_pseudo_pid(-pid);
+ child = find_pseudo_pid(aTHX_ -pid);
if (child >= 0) {
HANDLE hProcess = w32_pseudo_child_handles[child];
switch (sig) {
else
#endif
{
- child = find_pid(pid);
+ child = find_pid(aTHX_ pid);
if (child >= 0) {
if (my_kill(pid, sig)) {
DWORD exitcode = 0;
DllExport int
win32_stat(const char *path, Stat_t *sbuf)
{
- dTHX;
char buffer[MAX_PATH+1];
int l = strlen(path);
+ dTHX;
int res;
int nlink = 1;
BOOL expect_dir = FALSE;
static void
out_of_memory(void)
{
- if (PL_curinterp) {
- dTHX;
- /* Can't use PerlIO to write as it allocates memory */
- PerlLIO_write(PerlIO_fileno(Perl_error_log),
- PL_no_mem, strlen(PL_no_mem));
- my_exit(1);
- }
+ if (PL_curinterp)
+ croak_no_mem();
exit(1);
}
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
aenvstrings_len, NULL, NULL);
+ FreeEnvironmentStringsW(lpWStr);
+
return(lpStr);
}
needlen = GetEnvironmentVariableA(name,NULL,0);
if (needlen != 0) {
- curitem = sv_2mortal(newSVpvn("", 0));
+ curitem = sv_2mortal(newSVpvs(""));
do {
SvGROW(curitem, needlen+1);
needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
DllExport int
win32_putenv(const char *name)
{
- dTHX;
char* curitem;
char* val;
int relval = -1;
if (name) {
- Newx(curitem,strlen(name)+1,char);
+ curitem = (char *) win32_malloc(strlen(name)+1);
strcpy(curitem, name);
val = strchr(curitem, '=');
if (val) {
if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
relval = 0;
}
- Safefree(curitem);
+ win32_free(curitem);
}
return relval;
}
}
int
-win32_internal_wait(int *status, DWORD timeout)
+win32_internal_wait(pTHX_ int *status, DWORD timeout)
{
/* XXX this wait emulation only knows about processes
* spawned via win32_spawnvp(P_NOWAIT, ...).
*/
- dTHX;
int i, retval;
DWORD exitcode, waitcode;
int retval = -1;
long child;
if (pid == -1) /* XXX threadid == 1 ? */
- return win32_internal_wait(status, timeout);
+ return win32_internal_wait(aTHX_ status, timeout);
#ifdef USE_ITHREADS
else if (pid < 0) {
- child = find_pseudo_pid(-pid);
+ child = find_pseudo_pid(aTHX_ -pid);
if (child >= 0) {
HANDLE hThread = w32_pseudo_child_handles[child];
DWORD waitcode;
else {
HANDLE hProcess;
DWORD waitcode;
- child = find_pid(pid);
+ child = find_pid(aTHX_ pid);
if (child >= 0) {
hProcess = w32_child_handles[child];
win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
DllExport int
win32_wait(int *status)
{
- return win32_internal_wait(status, INFINITE);
+ dTHX;
+ return win32_internal_wait(aTHX_ status, INFINITE);
}
DllExport unsigned int
}
if (i == -1) {
if (GetLastError() == ERROR_LOCK_VIOLATION)
- errno = WSAEWOULDBLOCK;
+ errno = EWOULDBLOCK;
else
errno = EINVAL;
}
#undef LK_LEN
+extern int convert_wsa_error_to_errno(int wsaerr); /* in win32sck.c */
+
+/* Get the errno value corresponding to the given err. This function is not
+ * intended to handle conversion of general GetLastError() codes. It only exists
+ * to translate Windows sockets error codes from WSAGetLastError(). Such codes
+ * used to be assigned to errno/$! in earlier versions of perl; this function is
+ * used to catch any old Perl code which is still trying to assign such values
+ * to $! and convert them to errno values instead.
+ */
+int
+win32_get_errno(int err)
+{
+ return convert_wsa_error_to_errno(err);
+}
+
/*
* redirected io subsystem for all XS modules
*
return (feof(fp));
}
+#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
+extern int convert_errno_to_wsa_error(int err); /* in win32sck.c */
+#endif
+
/*
* Since the errors returned by the socket error function
* WSAGetLastError() are not known by the library routine strerror
- * we have to roll our own.
+ * we have to roll our own to cover the case of socket errors
+ * that could not be converted to regular errno values by
+ * get_last_socket_error() in win32/win32sck.c.
*/
DllExport char *
#endif
if (e < 0 || e > sys_nerr) {
- dTHX;
+ dTHXa(NULL);
if (e < 0)
e = GetLastError();
+#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
+ /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno
+ * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but
+ * sys_nerr is still 43 and strerror() returns "Unknown error" for them.
+ * We must therefore still roll our own messages for these codes, and
+ * additionally map them to corresponding Windows (sockets) error codes
+ * first to avoid getting the wrong system message.
+ */
+ else if (e >= EADDRINUSE && e <= EWOULDBLOCK) {
+ e = convert_errno_to_wsa_error(e);
+ }
+#endif
+ aTHXa(PERL_GET_THX);
if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
|FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
w32_strerror_buffer, sizeof(w32_strerror_buffer),
DllExport FILE *
win32_fopen(const char *filename, const char *mode)
{
- dTHX;
+ dTHXa(NULL);
FILE *f;
if (!*filename)
if (stricmp(filename, "/dev/null")==0)
filename = "NUL";
+ aTHXa(PERL_GET_THX);
f = fopen(PerlDir_mapA(filename), mode);
/* avoid buffering headaches for child processes */
if (f && *mode == 'a')
DllExport FILE *
win32_fdopen(int handle, const char *mode)
{
- dTHX;
FILE *f;
f = fdopen(handle, (char *) mode);
/* avoid buffering headaches for child processes */
DllExport FILE *
win32_freopen(const char *path, const char *mode, FILE *stream)
{
- dTHX;
+ dTHXa(NULL);
if (stricmp(path, "/dev/null")==0)
path = "NUL";
+ aTHXa(PERL_GET_THX);
return freopen(PerlDir_mapA(path), mode, stream);
}
DllExport int
win32_tmpfd(void)
{
- dTHX;
char prefix[MAX_PATH+1];
char filename[MAX_PATH+1];
DWORD len = GetTempPath(MAX_PATH, prefix);
if (fh != INVALID_HANDLE_VALUE) {
int fd = win32_open_osfhandle((intptr_t)fh, 0);
if (fd >= 0) {
+ PERL_DEB(dTHX;)
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Created tmpfile=%s\n",filename));
return fd;
#ifdef USE_RTL_POPEN
return _popen(command, mode);
#else
- dTHX;
int p[2];
+ int handles[3];
int parent, child;
- int stdfd, oldfd;
+ int stdfd;
int ourmode;
int childpid;
DWORD nhandle;
- HANDLE old_h;
int lock_held = 0;
/* establish which ends read and write */
if (win32_pipe(p, 512, ourmode) == -1)
return NULL;
- /* save the old std handle (this needs to happen before the
- * dup2(), since that might call SetStdHandle() too) */
- OP_REFCNT_LOCK;
- lock_held = 1;
- old_h = GetStdHandle(nhandle);
+ /* Previously this code redirected stdin/out temporarily so the
+ child process inherited those handles, this caused race
+ conditions when another thread was writing/reading those
+ handles.
- /* save current stdfd */
- if ((oldfd = win32_dup(stdfd)) == -1)
- goto cleanup;
+ To avoid that we just feed the handles to CreateProcess() so
+ the handles are redirected only in the child.
+ */
+ handles[child] = p[child];
+ handles[parent] = -1;
+ handles[2] = -1;
- /* make stdfd go to child end of pipe (implicitly closes stdfd) */
- /* stdfd will be inherited by the child */
- if (win32_dup2(p[child], stdfd) == -1)
+ /* CreateProcess() requires inheritable handles */
+ if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT,
+ HANDLE_FLAG_INHERIT)) {
goto cleanup;
-
- /* close the child end in parent */
- win32_close(p[child]);
-
- /* set the new std handle (in case dup2() above didn't) */
- SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
+ }
/* start the child */
{
dTHX;
- if ((childpid = do_spawn_nowait((char*)command)) == -1)
- goto cleanup;
- /* revert stdfd to whatever it was before */
- if (win32_dup2(oldfd, stdfd) == -1)
+ if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
goto cleanup;
- /* close saved handle */
- win32_close(oldfd);
-
- /* restore the old std handle (this needs to happen after the
- * dup2(), since that might call SetStdHandle() too */
- if (lock_held) {
- SetStdHandle(nhandle, old_h);
- OP_REFCNT_UNLOCK;
- lock_held = 0;
- }
+ win32_close(p[child]);
sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
/* we don't need to check for errors here */
win32_close(p[0]);
win32_close(p[1]);
- if (oldfd != -1) {
- win32_dup2(oldfd, stdfd);
- win32_close(oldfd);
- }
- if (lock_held) {
- SetStdHandle(nhandle, old_h);
- OP_REFCNT_UNLOCK;
- lock_held = 0;
- }
+
return (NULL);
#endif /* USE_RTL_POPEN */
DllExport int
win32_link(const char *oldname, const char *newname)
{
- dTHX;
+ dTHXa(NULL);
WCHAR wOldName[MAX_PATH+1];
WCHAR wNewName[MAX_PATH+1];
if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
- (wcscpy(wOldName, PerlDir_mapW(wOldName)),
+ ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
{
return 0;
case ERROR_NOT_SAME_DEVICE:
errno = EXDEV;
break;
+ case ERROR_DISK_FULL:
+ errno = ENOSPC;
+ break;
+ case ERROR_NOT_ENOUGH_QUOTA:
+ errno = EDQUOT;
+ break;
default:
/* ERROR_INVALID_FUNCTION - eg. on a FAT volume */
errno = EINVAL;
case ERROR_PATH_NOT_FOUND:
errno = ENOENT;
break;
+ case ERROR_DISK_FULL:
+ errno = ENOSPC;
+ break;
+ case ERROR_NOT_ENOUGH_QUOTA:
+ errno = EDQUOT;
+ break;
default:
errno = EACCES;
break;
DllExport int
win32_open(const char *path, int flag, ...)
{
- dTHX;
+ dTHXa(NULL);
va_list ap;
int pmode;
if (stricmp(path, "/dev/null")==0)
path = "NUL";
+ aTHXa(PERL_GET_THX);
return open(PerlDir_mapA(path), flag, pmode);
}
DllExport int
win32_chdir(const char *dir)
{
- dTHX;
if (!dir) {
errno = ENOENT;
return -1;
static char *
create_command_line(char *cname, STRLEN clen, const char * const *args)
{
- dTHX;
+ PERL_DEB(dTHX;)
int index, argc;
char *cmd, *ptr;
const char *arg;
static char *
qualified_path(const char *cmd)
{
- dTHX;
char *pathstr;
char *fullcmd, *curfullcmd;
STRLEN cmdlen = 0;
}
/* look in PATH */
- pathstr = PerlEnv_getenv("PATH");
-
+ {
+ dTHX;
+ pathstr = PerlEnv_getenv("PATH");
+ }
/* worst case: PATH is a single directory; we need additional space
* to append "/", ".exe" and trailing "\0" */
Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
DllExport char*
win32_get_childdir(void)
{
- dTHX;
char* ptr;
char szfilename[MAX_PATH+1];
DllExport void
win32_free_childdir(char* d)
{
- dTHX;
Safefree(d);
}
#ifdef USE_RTL_SPAWNVP
return spawnvp(mode, cmdname, (char * const *)argv);
#else
- dTHX;
+ return do_spawnvp_handles(mode, cmdname, argv, NULL);
+#endif
+}
+
+static int
+do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv,
+ const int *handles) {
+ dTHXa(NULL);
int ret;
void* env;
char* dir;
cmd = create_command_line(cname, clen, argv);
+ aTHXa(PERL_GET_THX);
env = PerlEnv_get_childenv();
dir = PerlEnv_get_childdir();
ret = -1;
goto RETVAL;
}
+
memset(&StartupInfo,0,sizeof(StartupInfo));
StartupInfo.cb = sizeof(StartupInfo);
memset(&tbl,0,sizeof(tbl));
StartupInfo.dwYCountChars = tbl.dwYCountChars;
StartupInfo.dwFillAttribute = tbl.dwFillAttribute;
StartupInfo.wShowWindow = tbl.wShowWindow;
- StartupInfo.hStdInput = tbl.childStdIn;
- StartupInfo.hStdOutput = tbl.childStdOut;
- StartupInfo.hStdError = tbl.childStdErr;
+ StartupInfo.hStdInput = handles && handles[0] != -1 ?
+ (HANDLE)_get_osfhandle(handles[0]) : tbl.childStdIn;
+ StartupInfo.hStdOutput = handles && handles[1] != -1 ?
+ (HANDLE)_get_osfhandle(handles[1]) : tbl.childStdOut;
+ StartupInfo.hStdError = handles && handles[2] != -1 ?
+ (HANDLE)_get_osfhandle(handles[2]) : tbl.childStdErr;
if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE &&
StartupInfo.hStdOutput == INVALID_HANDLE_VALUE &&
StartupInfo.hStdError == INVALID_HANDLE_VALUE)
if (cname != cmdname)
Safefree(cname);
return ret;
-#endif
}
DllExport int
DllExport void*
win32_dynaload(const char* filename)
{
- dTHX;
+ dTHXa(NULL);
char buf[MAX_PATH+1];
const char *first;
filename = buf;
}
}
+ aTHXa(PERL_GET_THX);
return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
}
void
Perl_init_os_extras(void)
{
- dTHX;
+ dTHXa(NULL);
char *file = __FILE__;
/* Initialize Win32CORE if it has been statically linked. */
#ifndef PERL_IS_MINIPERL
void (*pfn_init)(pTHX);
- pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "init_Win32CORE");
+ HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+ ? GetModuleHandle(NULL)
+ : w32_perldll_handle);
+ pfn_init = (void (*)(pTHX))GetProcAddress(module, "init_Win32CORE");
+ aTHXa(PERL_GET_THX);
if (pfn_init)
pfn_init(aTHX);
+#else
+ aTHXa(PERL_GET_THX);
#endif
newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
wide_path = (WCHAR*)win32_malloc(len*sizeof(WCHAR));
while (wide_path) {
size_t newlen = GetEnvironmentVariableW(L"PATH", wide_path, len);
+ if (newlen == 0) {
+ win32_free(wide_path);
+ return;
+ }
if (newlen < len)
break;
len = newlen;
* will not call mg_set() if it initializes %ENV from `environ`.
*/
SetEnvironmentVariableA("PATH", ansi_path+5);
- /* We are intentionally leaking the ansi_path string here because
- * the some runtime libraries puts it directly into the environ
- * array. The Microsoft runtime library seems to make a copy,
- * but will leak the copy should it be replaced again later.
- * Since this code is only called once during PERL_SYS_INIT this
- * shouldn't really matter.
- */
+ win32_free(ansi_path);
}
win32_free(wide_path);
}
g_osver.dwOSVersionInfoSize = sizeof(g_osver);
GetVersionEx(&g_osver);
+#ifdef WIN32_DYN_IOINFO_SIZE
+ {
+ Size_t ioinfo_size = _msize((void*)__pioinfo[0]);;
+ if((SSize_t)ioinfo_size <= 0) { /* -1 is err */
+ fprintf(stderr, "panic: invalid size for ioinfo\n"); /* no interp */
+ exit(1);
+ }
+ ioinfo_size /= IOINFO_ARRAY_ELTS;
+ w32_ioinfo_size = ioinfo_size;
+ }
+#endif
+
ansify_path();
}
void
Perl_win32_term(void)
{
- dTHX;
HINTS_REFCNT_TERM;
OP_REFCNT_TERM;
PERLIO_TERM;
Sighandler_t
win32_signal(int sig, Sighandler_t subcode)
{
- dTHX;
+ dTHXa(NULL);
if (sig < SIG_SIZE) {
int save_errno = errno;
Sighandler_t result;
#ifdef SET_INVALID_PARAMETER_HANDLER
set_silent_invalid_parameter_handler(oldvalue);
#endif
+ aTHXa(PERL_GET_THX);
if (result == SIG_ERR) {
result = w32_sighandler[sig];
errno = save_errno;
* are relativley infrequent code-paths, is better than the added
* complexity of getting the correct context passed into
* win32_create_message_window() */
+ dTHX;
switch(msg) {
#ifdef USE_ITHREADS
case WM_USER_MESSAGE: {
- long child = find_pseudo_pid((int)wParam);
+ long child = find_pseudo_pid(aTHX_ (int)wParam);
if (child >= 0) {
- dTHX;
w32_pseudo_child_message_hwnds[child] = (HWND)lParam;
return 1;
}
#endif
case WM_USER_KILL: {
- dTHX;
/* We use WM_USER_KILL to fake kill() with other signals */
int sig = (int)wParam;
if (do_raise(aTHX_ sig))
}
case WM_TIMER: {
- dTHX;
/* alarm() is a one-shot but SetTimer() repeats so kill it */
if (w32_timerid && w32_timerid==(UINT)wParam) {
KillTimer(w32_message_hwnd, w32_timerid);
https://perl5.git.perl.org / perl5.git / blobdiff