This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make win32_link and win32_rename raise ENOSPC and EDQUOT when appropriate
[perl5.git] / win32 / win32.c
CommitLineData
68dc0745
PP
1/* WIN32.C
2 *
3fadfdf1 3 * (c) 1995 Microsoft Corporation. All rights reserved.
0d130a44 4 * Developed by hip communications inc.
68dc0745
PP
5 * Portions (c) 1993 Intergraph Corporation. All rights reserved.
6 *
7 * You may distribute under the terms of either the GNU General Public
8 * License or the Artistic License, as specified in the README file.
9 */
3fadfdf1 10#define PERLIO_NOT_STDIO 0
0a753a76
PP
11#define WIN32_LEAN_AND_MEAN
12#define WIN32IO_IS_STDIO
13#include <tchar.h>
8cbe99e5 14
a835ef8a 15#ifdef __GNUC__
8cbe99e5
JD
16# define Win32_Winsock
17#endif
18
19#ifndef _WIN32_WINNT
20# define _WIN32_WINNT 0x0500 /* needed for CreateHardlink() etc. */
a835ef8a 21#endif
8cbe99e5 22
0a753a76 23#include <windows.h>
8cbe99e5 24
8e564886
JD
25#ifndef HWND_MESSAGE
26# define HWND_MESSAGE ((HWND)-3)
27#endif
28
29#ifndef PROCESSOR_ARCHITECTURE_AMD64
30# define PROCESSOR_ARCHITECTURE_AMD64 9
31#endif
32
33#ifndef WC_NO_BEST_FIT_CHARS
34# define WC_NO_BEST_FIT_CHARS 0x00000400
35#endif
36
5db10396 37#include <winnt.h>
4ebea3c6 38#include <commctrl.h>
542cb85f 39#include <tlhelp32.h>
5db10396 40#include <io.h>
c843839f 41#include <signal.h>
0a753a76 42
68dc0745 43/* #include "config.h" */
0a753a76 44
0a753a76 45#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
8cbe99e5 46# define PerlIO FILE
0a753a76
PP
47#endif
48
7a9ec5a3 49#include <sys/stat.h>
0a753a76
PP
50#include "EXTERN.h"
51#include "perl.h"
c69f6586
GS
52
53#define NO_XSLOCKS
c5be433b 54#define PERL_NO_GET_CONTEXT
ad2e33dc 55#include "XSUB.h"
c69f6586 56
0a753a76 57#include <fcntl.h>
5b0d9cbe
NIS
58#ifndef __GNUC__
59/* assert.h conflicts with #define of assert in perl.h */
8cbe99e5 60# include <assert.h>
5b0d9cbe 61#endif
8cbe99e5 62
0a753a76
PP
63#include <string.h>
64#include <stdarg.h>
ad2e33dc 65#include <float.h>
ad0751ec 66#include <time.h>
4eab039d 67#include <sys/utime.h>
8cbe99e5 68
5b0d9cbe 69#ifdef __GNUC__
3fadfdf1 70/* Mingw32 defaults to globing command line
5b0d9cbe
NIS
71 * So we turn it off like this:
72 */
73int _CRT_glob = 0;
74#endif
75
7c5b6093
AB
76#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
77/* Mingw32-1.1 is missing some prototypes */
d06fc7d4 78START_EXTERN_C
f8fb7c90
GS
79FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
80FILE * _wfdopen(int nFd, LPCWSTR wszMode);
81FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
82int _flushall();
83int _fcloseall();
d06fc7d4 84END_EXTERN_C
2b260de0
GS
85#endif
86
6890e559
GS
87#define EXECF_EXEC 1
88#define EXECF_SPAWN 2
89#define EXECF_SPAWN_NOWAIT 3
90
32e30700
GS
91#if defined(PERL_IMPLICIT_SYS)
92# undef win32_get_privlib
93# define win32_get_privlib g_win32_get_privlib
94# undef win32_get_sitelib
95# define win32_get_sitelib g_win32_get_sitelib
4ea817c6
GS
96# undef win32_get_vendorlib
97# define win32_get_vendorlib g_win32_get_vendorlib
32e30700
GS
98# undef getlogin
99# define getlogin g_getlogin
100#endif
101
58d049f0
JD
102/* VS2005 (MSC version 14) provides a mechanism to set an invalid
103 * parameter handler. This functionality is not available in the
104 * 64-bit compiler from the Platform SDK, which unfortunately also
105 * believes itself to be MSC version 14.
106 *
107 * There is no #define related to _set_invalid_parameter_handler(),
108 * but we can check for one of the constants defined for
109 * _set_abort_behavior(), which was introduced into stdlib.h at
110 * the same time.
111 */
112
113#if _MSC_VER >= 1400 && defined(_WRITE_ABORT_MSG)
114# define SET_INVALID_PARAMETER_HANDLER
115#endif
116
117#ifdef SET_INVALID_PARAMETER_HANDLER
d52ca586 118static BOOL set_silent_invalid_parameter_handler(BOOL newvalue);
e2cd629f
SH
119static void my_invalid_parameter_handler(const wchar_t* expression,
120 const wchar_t* function, const wchar_t* file,
121 unsigned int line, uintptr_t pReserved);
122#endif
123
124static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
125static char* get_regstr(const char *valuename, SV **svp);
126static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
127 char *trailing, ...);
128static char* win32_get_xlib(const char *pl, const char *xlib,
129 const char *libname, STRLEN *const len);
130static BOOL has_shell_metachars(const char *ptr);
131static long tokenize(const char *str, char **dest, char ***destv);
132static void get_shell(void);
133static char* find_next_space(const char *s);
134static int do_spawn2(pTHX_ const char *cmd, int exectype);
04a2c3d9 135static long find_pid(pTHX_ int pid);
e2cd629f
SH
136static void remove_dead_process(long child);
137static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
138static int my_kill(int pid, int sig);
139static void out_of_memory(void);
00a0ae28 140static char* wstr_to_str(const wchar_t* wstr);
e2cd629f
SH
141static long filetime_to_clock(PFILETIME ft);
142static BOOL filetime_from_time(PFILETIME ft, time_t t);
143static char* create_command_line(char *cname, STRLEN clen,
144 const char * const *args);
145static char* qualified_path(const char *cmd);
146static void ansify_path(void);
147static LRESULT win32_process_message(HWND hwnd, UINT msg,
148 WPARAM wParam, LPARAM lParam);
149
150#ifdef USE_ITHREADS
04a2c3d9 151static long find_pseudo_pid(pTHX_ int pid);
e2cd629f
SH
152static void remove_dead_pseudo_process(long child);
153static HWND get_hwnd_delay(pTHX, long child, DWORD tries);
154#endif
155
156#ifdef HAVE_INTERP_INTERN
157static void win32_csighandler(int sig);
158#endif
159
160START_EXTERN_C
161HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
162char w32_module_name[MAX_PATH+1];
163END_EXTERN_C
164
165static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
166
167#ifdef SET_INVALID_PARAMETER_HANDLER
d52ca586
SH
168static BOOL silent_invalid_parameter_handler = FALSE;
169
170static BOOL
171set_silent_invalid_parameter_handler(BOOL newvalue)
172{
d52ca586 173 BOOL oldvalue = silent_invalid_parameter_handler;
adb86be5 174# ifdef _DEBUG
d52ca586 175 silent_invalid_parameter_handler = newvalue;
d52ca586 176# endif
adb86be5 177 return oldvalue;
d52ca586
SH
178}
179
e2cd629f
SH
180static void
181my_invalid_parameter_handler(const wchar_t* expression,
0448a0bd
SH
182 const wchar_t* function,
183 const wchar_t* file,
184 unsigned int line,
185 uintptr_t pReserved)
186{
187# ifdef _DEBUG
00a0ae28
SH
188 char* ansi_expression;
189 char* ansi_function;
190 char* ansi_file;
d52ca586
SH
191 if (silent_invalid_parameter_handler)
192 return;
00a0ae28
SH
193 ansi_expression = wstr_to_str(expression);
194 ansi_function = wstr_to_str(function);
195 ansi_file = wstr_to_str(file);
196 fprintf(stderr, "Invalid parameter detected in function %s. "
197 "File: %s, line: %d\n", ansi_function, ansi_file, line);
198 fprintf(stderr, "Expression: %s\n", ansi_expression);
199 free(ansi_expression);
200 free(ansi_function);
201 free(ansi_file);
0448a0bd
SH
202# endif
203}
204#endif
205
2fa86c13
GS
206EXTERN_C void
207set_w32_module_name(void)
208{
aa2b96ec 209 /* this function may be called at DLL_PROCESS_ATTACH time */
2fa86c13 210 char* ptr;
aa2b96ec
JD
211 HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
212 ? GetModuleHandle(NULL)
213 : w32_perldll_handle);
2fa86c13 214
aa2b96ec
JD
215 OSVERSIONINFO osver; /* g_osver may not yet be initialized */
216 osver.dwOSVersionInfoSize = sizeof(osver);
217 GetVersionEx(&osver);
be9da6a9 218
3839a0fa 219 if (osver.dwMajorVersion > 4) {
aa2b96ec
JD
220 WCHAR modulename[MAX_PATH];
221 WCHAR fullname[MAX_PATH];
222 char *ansi;
223
ad256131
JD
224 DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
225 (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
226 GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
227
aa2b96ec
JD
228 GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
229
230 /* Make sure we get an absolute pathname in case the module was loaded
231 * explicitly by LoadLibrary() with a relative path. */
232 GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
233
ad256131
JD
234 /* Make sure we start with the long path name of the module because we
235 * later scan for pathname components to match "5.xx" to locate
236 * compatible sitelib directories, and the short pathname might mangle
237 * this path segment (e.g. by removing the dot on NTFS to something
238 * like "5xx~1.yy") */
239 if (pfnGetLongPathNameW)
240 pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
241
aa2b96ec
JD
242 /* remove \\?\ prefix */
243 if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
244 memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
245
246 ansi = win32_ansipath(fullname);
247 my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
248 win32_free(ansi);
249 }
250 else {
251 GetModuleFileName(module, w32_module_name, sizeof(w32_module_name));
252
253 /* remove \\?\ prefix */
254 if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
255 memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
256
257 /* try to get full path to binary (which may be mangled when perl is
258 * run from a 16-bit app) */
259 /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
260 win32_longpath(w32_module_name);
261 /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/
262 }
2fa86c13
GS
263
264 /* normalize to forward slashes */
265 ptr = w32_module_name;
266 while (*ptr) {
267 if (*ptr == '\\')
268 *ptr = '/';
269 ++ptr;
270 }
271}
272
c5be433b 273/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 274static char*
c5be433b 275get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
349ad1fe
GS
276{
277 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
00dc2f4f
GS
278 HKEY handle;
279 DWORD type;
280 const char *subkey = "Software\\Perl";
4e205ed6 281 char *str = NULL;
00dc2f4f
GS
282 long retval;
283
284 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
349ad1fe 285 if (retval == ERROR_SUCCESS) {
51371543
GS
286 DWORD datalen;
287 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
1c94caf4
GS
288 if (retval == ERROR_SUCCESS
289 && (type == REG_SZ || type == REG_EXPAND_SZ))
290 {
acfe0abc 291 dTHX;
c5be433b
GS
292 if (!*svp)
293 *svp = sv_2mortal(newSVpvn("",0));
294 SvGROW(*svp, datalen);
51371543 295 retval = RegQueryValueEx(handle, valuename, 0, NULL,
c5be433b 296 (PBYTE)SvPVX(*svp), &datalen);
51371543 297 if (retval == ERROR_SUCCESS) {
c5be433b
GS
298 str = SvPVX(*svp);
299 SvCUR_set(*svp,datalen-1);
51371543 300 }
00dc2f4f
GS
301 }
302 RegCloseKey(handle);
303 }
349ad1fe 304 return str;
00dc2f4f
GS
305}
306
c5be433b 307/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 308static char*
c5be433b 309get_regstr(const char *valuename, SV **svp)
00dc2f4f 310{
c5be433b 311 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
349ad1fe 312 if (!str)
c5be433b 313 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
349ad1fe 314 return str;
00dc2f4f
GS
315}
316
c5be433b 317/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
e5a95ffb 318static char *
e6a0bbf8 319get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
00dc2f4f 320{
dc9e4912 321 char base[10];
e5a95ffb 322 va_list ap;
e24c7c18 323 char mod_name[MAX_PATH+1];
00dc2f4f 324 char *ptr;
e5a95ffb
GS
325 char *optr;
326 char *strip;
273cf8d1 327 STRLEN baselen;
e5a95ffb
GS
328
329 va_start(ap, trailing_path);
330 strip = va_arg(ap, char *);
331
273cf8d1
GS
332 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
333 baselen = strlen(base);
dc9e4912 334
8ac9c18d 335 if (!*w32_module_name) {
2fa86c13 336 set_w32_module_name();
95140b98 337 }
8ac9c18d 338 strcpy(mod_name, w32_module_name);
95140b98 339 ptr = strrchr(mod_name, '/');
e5a95ffb
GS
340 while (ptr && strip) {
341 /* look for directories to skip back */
342 optr = ptr;
00dc2f4f 343 *ptr = '\0';
95140b98 344 ptr = strrchr(mod_name, '/');
1c39adb2
GS
345 /* avoid stripping component if there is no slash,
346 * or it doesn't match ... */
e5a95ffb 347 if (!ptr || stricmp(ptr+1, strip) != 0) {
273cf8d1 348 /* ... but not if component matches m|5\.$patchlevel.*| */
1c39adb2 349 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
273cf8d1
GS
350 && strncmp(strip, base, baselen) == 0
351 && strncmp(ptr+1, base, baselen) == 0))
95140b98
GS
352 {
353 *optr = '/';
80252599
GS
354 ptr = optr;
355 }
00dc2f4f 356 }
e5a95ffb 357 strip = va_arg(ap, char *);
00dc2f4f 358 }
e5a95ffb
GS
359 if (!ptr) {
360 ptr = mod_name;
361 *ptr++ = '.';
95140b98 362 *ptr = '/';
00dc2f4f 363 }
e5a95ffb
GS
364 va_end(ap);
365 strcpy(++ptr, trailing_path);
366
dc9e4912 367 /* only add directory if it exists */
349ad1fe 368 if (GetFileAttributes(mod_name) != (DWORD) -1) {
dc9e4912 369 /* directory exists */
acfe0abc 370 dTHX;
c5be433b
GS
371 if (!*prev_pathp)
372 *prev_pathp = sv_2mortal(newSVpvn("",0));
f0c8bec2
SH
373 else if (SvPVX(*prev_pathp))
374 sv_catpvn(*prev_pathp, ";", 1);
c5be433b 375 sv_catpv(*prev_pathp, mod_name);
e6a0bbf8
NC
376 if(len)
377 *len = SvCUR(*prev_pathp);
c5be433b 378 return SvPVX(*prev_pathp);
00dc2f4f 379 }
00dc2f4f 380
4e205ed6 381 return NULL;
00dc2f4f
GS
382}
383
73f2c082 384EXTERN_C char *
e6a0bbf8 385win32_get_privlib(const char *pl, STRLEN *const len)
00dc2f4f 386{
e5a95ffb
GS
387 char *stdlib = "lib";
388 char buffer[MAX_PATH+1];
4e205ed6 389 SV *sv = NULL;
00dc2f4f 390
e5a95ffb
GS
391 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
392 sprintf(buffer, "%s-%s", stdlib, pl);
c5be433b
GS
393 if (!get_regstr(buffer, &sv))
394 (void)get_regstr(stdlib, &sv);
00dc2f4f 395
e5a95ffb 396 /* $stdlib .= ";$EMD/../../lib" */
e6a0bbf8 397 return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
00dc2f4f
GS
398}
399
4ea817c6 400static char *
e6a0bbf8
NC
401win32_get_xlib(const char *pl, const char *xlib, const char *libname,
402 STRLEN *const len)
00dc2f4f 403{
e5a95ffb 404 char regstr[40];
e24c7c18 405 char pathstr[MAX_PATH+1];
4e205ed6
SP
406 SV *sv1 = NULL;
407 SV *sv2 = NULL;
00dc2f4f 408
4ea817c6
GS
409 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
410 sprintf(regstr, "%s-%s", xlib, pl);
c5be433b 411 (void)get_regstr(regstr, &sv1);
e5a95ffb 412
4ea817c6
GS
413 /* $xlib .=
414 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
415 sprintf(pathstr, "%s/%s/lib", libname, pl);
e6a0bbf8 416 (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
00dc2f4f 417
4ea817c6
GS
418 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
419 (void)get_regstr(xlib, &sv2);
00dc2f4f 420
4ea817c6
GS
421 /* $xlib .=
422 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
423 sprintf(pathstr, "%s/lib", libname);
e6a0bbf8 424 (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
e5a95ffb 425
51371543 426 if (!sv1 && !sv2)
4e205ed6 427 return NULL;
e6a0bbf8
NC
428 if (!sv1) {
429 sv1 = sv2;
430 } else if (sv2) {
04a2c3d9 431 dTHX;
e6a0bbf8
NC
432 sv_catpvn(sv1, ";", 1);
433 sv_catsv(sv1, sv2);
434 }
e5a95ffb 435
e6a0bbf8
NC
436 if (len)
437 *len = SvCUR(sv1);
349ad1fe 438 return SvPVX(sv1);
68dc0745 439}
0a753a76 440
73f2c082 441EXTERN_C char *
e6a0bbf8 442win32_get_sitelib(const char *pl, STRLEN *const len)
4ea817c6 443{
e6a0bbf8 444 return win32_get_xlib(pl, "sitelib", "site", len);
4ea817c6
GS
445}
446
447#ifndef PERL_VENDORLIB_NAME
448# define PERL_VENDORLIB_NAME "vendor"
449#endif
450
73f2c082 451EXTERN_C char *
e6a0bbf8 452win32_get_vendorlib(const char *pl, STRLEN *const len)
4ea817c6 453{
e6a0bbf8 454 return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
4ea817c6 455}
b4793f7f 456
2d7a9237 457static BOOL
08039b81 458has_shell_metachars(const char *ptr)
68dc0745
PP
459{
460 int inquote = 0;
461 char quote = '\0';
462
463 /*
464 * Scan string looking for redirection (< or >) or pipe
e200fe59
JD
465 * characters (|) that are not in a quoted string.
466 * Shell variable interpolation (%VAR%) can also happen inside strings.
68dc0745 467 */
9404a519 468 while (*ptr) {
68dc0745 469 switch(*ptr) {
e200fe59
JD
470 case '%':
471 return TRUE;
68dc0745
PP
472 case '\'':
473 case '\"':
9404a519
GS
474 if (inquote) {
475 if (quote == *ptr) {
68dc0745
PP
476 inquote = 0;
477 quote = '\0';
0a753a76 478 }
68dc0745
PP
479 }
480 else {
481 quote = *ptr;
482 inquote++;
483 }
484 break;
485 case '>':
486 case '<':
487 case '|':
9404a519 488 if (!inquote)
68dc0745
PP
489 return TRUE;
490 default:
491 break;
0a753a76 492 }
68dc0745
PP
493 ++ptr;
494 }
495 return FALSE;
0a753a76
PP
496}
497
32e30700 498#if !defined(PERL_IMPLICIT_SYS)
68dc0745
PP
499/* since the current process environment is being updated in util.c
500 * the library functions will get the correct environment
501 */
502PerlIO *
79d39d80 503Perl_my_popen(pTHX_ const char *cmd, const char *mode)
0a753a76 504{
45bc9206 505 PERL_FLUSHALL_FOR_CHILD;
0a753a76 506 return win32_popen(cmd, mode);
0a753a76
PP
507}
508
68dc0745 509long
4f63d024 510Perl_my_pclose(pTHX_ PerlIO *fp)
0a753a76
PP
511{
512 return win32_pclose(fp);
513}
c69f6586 514#endif
0a753a76 515
0cb96387
GS
516DllExport unsigned long
517win32_os_id(void)
0a753a76 518{
aeecf691 519 return (unsigned long)g_osver.dwPlatformId;
0a753a76
PP
520}
521
7766f137
GS
522DllExport int
523win32_getpid(void)
524{
525#ifdef USE_ITHREADS
acfe0abc 526 dTHX;
7766f137
GS
527 if (w32_pseudo_id)
528 return -((int)w32_pseudo_id);
529#endif
8cbe99e5 530 return _getpid();
7766f137
GS
531}
532
ce1da67e
GS
533/* Tokenize a string. Words are null-separated, and the list
534 * ends with a doubled null. Any character (except null and
535 * including backslash) may be escaped by preceding it with a
536 * backslash (the backslash will be stripped).
537 * Returns number of words in result buffer.
538 */
539static long
dff6d3cd 540tokenize(const char *str, char **dest, char ***destv)
ce1da67e 541{
4e205ed6 542 char *retstart = NULL;
ce1da67e
GS
543 char **retvstart = 0;
544 int items = -1;
545 if (str) {
546 int slen = strlen(str);
eb578fdb
KW
547 char *ret;
548 char **retv;
a02a5408
JC
549 Newx(ret, slen+2, char);
550 Newx(retv, (slen+3)/2, char*);
ce1da67e
GS
551
552 retstart = ret;
553 retvstart = retv;
554 *retv = ret;
555 items = 0;
556 while (*str) {
557 *ret = *str++;
558 if (*ret == '\\' && *str)
559 *ret = *str++;
560 else if (*ret == ' ') {
561 while (*str == ' ')
562 str++;
563 if (ret == retstart)
564 ret--;
565 else {
566 *ret = '\0';
567 ++items;
568 if (*str)
569 *++retv = ret+1;
570 }
571 }
572 else if (!*str)
573 ++items;
574 ret++;
575 }
4e205ed6 576 retvstart[items] = NULL;
ce1da67e
GS
577 *ret++ = '\0';
578 *ret = '\0';
579 }
580 *dest = retstart;
581 *destv = retvstart;
582 return items;
583}
584
585static void
2d7a9237 586get_shell(void)
0a753a76 587{
acfe0abc 588 dTHX;
ce1da67e 589 if (!w32_perlshell_tokens) {
174c211a
GS
590 /* we don't use COMSPEC here for two reasons:
591 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
592 * uncontrolled unportability of the ensuing scripts.
593 * 2. PERL5SHELL could be set to a shell that may not be fit for
594 * interactive use (which is what most programs look in COMSPEC
595 * for).
596 */
8cbe99e5 597 const char* defaultshell = "cmd.exe /x/d/c";
2fb9ab56 598 const char *usershell = PerlEnv_getenv("PERL5SHELL");
ce1da67e
GS
599 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
600 &w32_perlshell_tokens,
601 &w32_perlshell_vec);
68dc0745 602 }
0a753a76
PP
603}
604
68dc0745 605int
54725af6 606Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
0a753a76 607{
68dc0745 608 char **argv;
2d7a9237 609 char *str;
68dc0745 610 int status;
2d7a9237 611 int flag = P_WAIT;
68dc0745 612 int index = 0;
68dc0745 613
7918f24d
NC
614 PERL_ARGS_ASSERT_DO_ASPAWN;
615
2d7a9237
GS
616 if (sp <= mark)
617 return -1;
68dc0745 618
ce1da67e 619 get_shell();
a02a5408 620 Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS
621
622 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
623 ++mark;
624 flag = SvIVx(*mark);
68dc0745
PP
625 }
626
9404a519 627 while (++mark <= sp) {
bb897dfc 628 if (*mark && (str = SvPV_nolen(*mark)))
2d7a9237
GS
629 argv[index++] = str;
630 else
631 argv[index++] = "";
68dc0745
PP
632 }
633 argv[index++] = 0;
3fadfdf1 634
2d7a9237 635 status = win32_spawnvp(flag,
bb897dfc 636 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
637 (const char* const*)argv);
638
80252599 639 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
2d7a9237 640 /* possible shell-builtin, invoke with shell */
ce1da67e
GS
641 int sh_items;
642 sh_items = w32_perlshell_items;
2d7a9237
GS
643 while (--index >= 0)
644 argv[index+sh_items] = argv[index];
ce1da67e
GS
645 while (--sh_items >= 0)
646 argv[sh_items] = w32_perlshell_vec[sh_items];
3fadfdf1 647
2d7a9237 648 status = win32_spawnvp(flag,
bb897dfc 649 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
650 (const char* const*)argv);
651 }
68dc0745 652
922b1888 653 if (flag == P_NOWAIT) {
40c7cc6d 654 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS
655 }
656 else {
50892819 657 if (status < 0) {
0453d815 658 if (ckWARN(WARN_EXEC))
f98bc0c6 659 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
50892819
GS
660 status = 255 * 256;
661 }
662 else
663 status *= 256;
b28d0864 664 PL_statusvalue = status;
5aabfad6 665 }
ce1da67e 666 Safefree(argv);
50892819 667 return (status);
68dc0745
PP
668}
669
dd7038b3
JH
670/* returns pointer to the next unquoted space or the end of the string */
671static char*
672find_next_space(const char *s)
673{
674 bool in_quotes = FALSE;
675 while (*s) {
676 /* ignore doubled backslashes, or backslash+quote */
677 if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
678 s += 2;
679 }
680 /* keep track of when we're within quotes */
681 else if (*s == '"') {
682 s++;
683 in_quotes = !in_quotes;
684 }
685 /* break it up only at spaces that aren't in quotes */
686 else if (!in_quotes && isSPACE(*s))
687 return (char*)s;
688 else
689 s++;
690 }
691 return (char*)s;
692}
693
54725af6 694static int
08039b81 695do_spawn2(pTHX_ const char *cmd, int exectype)
68dc0745
PP
696{
697 char **a;
698 char *s;
699 char **argv;
700 int status = -1;
701 BOOL needToTry = TRUE;
2d7a9237 702 char *cmd2;
68dc0745 703
2d7a9237
GS
704 /* Save an extra exec if possible. See if there are shell
705 * metacharacters in it */
e200fe59 706 if (!has_shell_metachars(cmd)) {
a02a5408
JC
707 Newx(argv, strlen(cmd) / 2 + 2, char*);
708 Newx(cmd2, strlen(cmd) + 1, char);
68dc0745
PP
709 strcpy(cmd2, cmd);
710 a = argv;
711 for (s = cmd2; *s;) {
de030af3 712 while (*s && isSPACE(*s))
68dc0745
PP
713 s++;
714 if (*s)
715 *(a++) = s;
dd7038b3 716 s = find_next_space(s);
9404a519 717 if (*s)
68dc0745 718 *s++ = '\0';
0a753a76 719 }
4e205ed6 720 *a = NULL;
ce1da67e 721 if (argv[0]) {
6890e559
GS
722 switch (exectype) {
723 case EXECF_SPAWN:
724 status = win32_spawnvp(P_WAIT, argv[0],
725 (const char* const*)argv);
726 break;
727 case EXECF_SPAWN_NOWAIT:
728 status = win32_spawnvp(P_NOWAIT, argv[0],
729 (const char* const*)argv);
730 break;
731 case EXECF_EXEC:
732 status = win32_execvp(argv[0], (const char* const*)argv);
733 break;
734 }
2d7a9237 735 if (status != -1 || errno == 0)
68dc0745 736 needToTry = FALSE;
0a753a76 737 }
0a753a76 738 Safefree(argv);
68dc0745
PP
739 Safefree(cmd2);
740 }
2d7a9237 741 if (needToTry) {
ce1da67e
GS
742 char **argv;
743 int i = -1;
744 get_shell();
a02a5408 745 Newx(argv, w32_perlshell_items + 2, char*);
ce1da67e
GS
746 while (++i < w32_perlshell_items)
747 argv[i] = w32_perlshell_vec[i];
08039b81 748 argv[i++] = (char *)cmd;
4e205ed6 749 argv[i] = NULL;
6890e559
GS
750 switch (exectype) {
751 case EXECF_SPAWN:
752 status = win32_spawnvp(P_WAIT, argv[0],
753 (const char* const*)argv);
754 break;
755 case EXECF_SPAWN_NOWAIT:
756 status = win32_spawnvp(P_NOWAIT, argv[0],
757 (const char* const*)argv);
758 break;
759 case EXECF_EXEC:
760 status = win32_execvp(argv[0], (const char* const*)argv);
761 break;
762 }
ce1da67e
GS
763 cmd = argv[0];
764 Safefree(argv);
68dc0745 765 }
922b1888 766 if (exectype == EXECF_SPAWN_NOWAIT) {
40c7cc6d 767 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS
768 }
769 else {
50892819 770 if (status < 0) {
0453d815 771 if (ckWARN(WARN_EXEC))
f98bc0c6 772 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
50892819
GS
773 (exectype == EXECF_EXEC ? "exec" : "spawn"),
774 cmd, strerror(errno));
775 status = 255 * 256;
776 }
777 else
778 status *= 256;
b28d0864 779 PL_statusvalue = status;
5aabfad6 780 }
50892819 781 return (status);
0a753a76
PP
782}
783
6890e559 784int
54725af6 785Perl_do_spawn(pTHX_ char *cmd)
6890e559 786{
7918f24d
NC
787 PERL_ARGS_ASSERT_DO_SPAWN;
788
54725af6 789 return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
6890e559
GS
790}
791
2d7a9237 792int
54725af6 793Perl_do_spawn_nowait(pTHX_ char *cmd)
2d7a9237 794{
7918f24d
NC
795 PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
796
54725af6 797 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
2d7a9237
GS
798}
799
6890e559 800bool
79d39d80 801Perl_do_exec(pTHX_ const char *cmd)
6890e559 802{
7918f24d
NC
803 PERL_ARGS_ASSERT_DO_EXEC;
804
08039b81 805 do_spawn2(aTHX_ cmd, EXECF_EXEC);
6890e559
GS
806 return FALSE;
807}
808
68dc0745
PP
809/* The idea here is to read all the directory names into a string table
810 * (separated by nulls) and when one of the other dir functions is called
811 * return the pointer to the current file name.
812 */
c5be433b 813DllExport DIR *
0e06f75d 814win32_opendir(const char *filename)
0a753a76 815{
04a2c3d9 816 dTHXa(NULL);
95136add 817 DIR *dirp;
9404a519
GS
818 long len;
819 long idx;
820 char scanname[MAX_PATH+3];
8cbe99e5 821 WCHAR wscanname[sizeof(scanname)];
35cf1ab6 822 WIN32_FIND_DATAW wFindData;
35cf1ab6 823 char buffer[MAX_PATH*2];
8cbe99e5 824 BOOL use_default;
9404a519
GS
825
826 len = strlen(filename);
525f9ba8
AD
827 if (len == 0) {
828 errno = ENOENT;
9404a519 829 return NULL;
525f9ba8
AD
830 }
831 if (len > MAX_PATH) {
832 errno = ENAMETOOLONG;
24caa93f 833 return NULL;
525f9ba8
AD
834 }
835
68dc0745 836 /* Get us a DIR structure */
a02a5408 837 Newxz(dirp, 1, DIR);
68dc0745
PP
838
839 /* Create the search pattern */
840 strcpy(scanname, filename);
23db2e2d
GS
841
842 /* bare drive name means look in cwd for drive */
843 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
844 scanname[len++] = '.';
845 scanname[len++] = '/';
846 }
847 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
9404a519 848 scanname[len++] = '/';
23db2e2d 849 }
9404a519
GS
850 scanname[len++] = '*';
851 scanname[len] = '\0';
68dc0745
PP
852
853 /* do the FindFirstFile call */
8cbe99e5 854 MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
04a2c3d9 855 aTHXa(PERL_GET_THX);
8cbe99e5
JD
856 dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
857
8c56068e 858 if (dirp->handle == INVALID_HANDLE_VALUE) {
95136add 859 DWORD err = GetLastError();
21e72512 860 /* FindFirstFile() fails on empty drives! */
95136add
GS
861 switch (err) {
862 case ERROR_FILE_NOT_FOUND:
863 return dirp;
864 case ERROR_NO_MORE_FILES:
865 case ERROR_PATH_NOT_FOUND:
866 errno = ENOENT;
867 break;
868 case ERROR_NOT_ENOUGH_MEMORY:
869 errno = ENOMEM;
870 break;
871 default:
872 errno = EINVAL;
873 break;
874 }
875 Safefree(dirp);
68dc0745
PP
876 return NULL;
877 }
878
8cbe99e5
JD
879 use_default = FALSE;
880 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
881 wFindData.cFileName, -1,
882 buffer, sizeof(buffer), NULL, &use_default);
883 if (use_default && *wFindData.cAlternateFileName) {
35cf1ab6 884 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
8cbe99e5
JD
885 wFindData.cAlternateFileName, -1,
886 buffer, sizeof(buffer), NULL, NULL);
35cf1ab6 887 }
8cbe99e5 888
68dc0745
PP
889 /* now allocate the first part of the string table for
890 * the filenames that we find.
891 */
8cbe99e5 892 idx = strlen(buffer)+1;
95136add 893 if (idx < 256)
35cf1ab6 894 dirp->size = 256;
95136add
GS
895 else
896 dirp->size = idx;
a02a5408 897 Newx(dirp->start, dirp->size, char);
8cbe99e5 898 strcpy(dirp->start, buffer);
95136add
GS
899 dirp->nfiles++;
900 dirp->end = dirp->curr = dirp->start;
901 dirp->end += idx;
902 return dirp;
0a753a76
PP
903}
904
905
68dc0745
PP
906/* Readdir just returns the current string pointer and bumps the
907 * string pointer to the nDllExport entry.
908 */
c5be433b 909DllExport struct direct *
ce2e26e5 910win32_readdir(DIR *dirp)
0a753a76 911{
95136add 912 long len;
0a753a76 913
68dc0745
PP
914 if (dirp->curr) {
915 /* first set up the structure to return */
916 len = strlen(dirp->curr);
0f38926b 917 strcpy(dirp->dirstr.d_name, dirp->curr);
68dc0745 918 dirp->dirstr.d_namlen = len;
0a753a76 919
68dc0745 920 /* Fake an inode */
0f38926b 921 dirp->dirstr.d_ino = dirp->curr - dirp->start;
0a753a76 922
95136add 923 /* Now set up for the next call to readdir */
68dc0745 924 dirp->curr += len + 1;
95136add 925 if (dirp->curr >= dirp->end) {
35cf1ab6 926 BOOL res;
35cf1ab6 927 char buffer[MAX_PATH*2];
95136add 928
60b22aca
JD
929 if (dirp->handle == INVALID_HANDLE_VALUE) {
930 res = 0;
931 }
95136add
GS
932 /* finding the next file that matches the wildcard
933 * (which should be all of them in this directory!).
95136add 934 */
8cbe99e5 935 else {
35cf1ab6
JD
936 WIN32_FIND_DATAW wFindData;
937 res = FindNextFileW(dirp->handle, &wFindData);
938 if (res) {
939 BOOL use_default = FALSE;
940 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
941 wFindData.cFileName, -1,
942 buffer, sizeof(buffer), NULL, &use_default);
943 if (use_default && *wFindData.cAlternateFileName) {
944 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
945 wFindData.cAlternateFileName, -1,
946 buffer, sizeof(buffer), NULL, NULL);
947 }
35cf1ab6
JD
948 }
949 }
95136add 950 if (res) {
0f38926b 951 long endpos = dirp->end - dirp->start;
8cbe99e5 952 long newsize = endpos + strlen(buffer) + 1;
95136add 953 /* bump the string table size by enough for the
022735b4 954 * new name and its null terminator */
0f38926b
GS
955 while (newsize > dirp->size) {
956 long curpos = dirp->curr - dirp->start;
95136add
GS
957 dirp->size *= 2;
958 Renew(dirp->start, dirp->size, char);
0f38926b 959 dirp->curr = dirp->start + curpos;
95136add 960 }
8cbe99e5 961 strcpy(dirp->start + endpos, buffer);
0f38926b 962 dirp->end = dirp->start + newsize;
95136add
GS
963 dirp->nfiles++;
964 }
60b22aca 965 else {
95136add 966 dirp->curr = NULL;
60b22aca
JD
967 if (dirp->handle != INVALID_HANDLE_VALUE) {
968 FindClose(dirp->handle);
969 dirp->handle = INVALID_HANDLE_VALUE;
970 }
971 }
68dc0745 972 }
68dc0745 973 return &(dirp->dirstr);
3fadfdf1 974 }
68dc0745
PP
975 else
976 return NULL;
0a753a76
PP
977}
978
68dc0745 979/* Telldir returns the current string pointer position */
c5be433b 980DllExport long
ce2e26e5 981win32_telldir(DIR *dirp)
0a753a76 982{
60b22aca 983 return dirp->curr ? (dirp->curr - dirp->start) : -1;
0a753a76
PP
984}
985
986
68dc0745 987/* Seekdir moves the string pointer to a previously saved position
95136add 988 * (returned by telldir).
68dc0745 989 */
c5be433b 990DllExport void
ce2e26e5 991win32_seekdir(DIR *dirp, long loc)
0a753a76 992{
60b22aca 993 dirp->curr = loc == -1 ? NULL : dirp->start + loc;
0a753a76
PP
994}
995
68dc0745 996/* Rewinddir resets the string pointer to the start */
c5be433b 997DllExport void
ce2e26e5 998win32_rewinddir(DIR *dirp)
0a753a76
PP
999{
1000 dirp->curr = dirp->start;
1001}
1002
68dc0745 1003/* free the memory allocated by opendir */
c5be433b 1004DllExport int
ce2e26e5 1005win32_closedir(DIR *dirp)
0a753a76 1006{
95136add 1007 if (dirp->handle != INVALID_HANDLE_VALUE)
0f38926b 1008 FindClose(dirp->handle);
0a753a76
PP
1009 Safefree(dirp->start);
1010 Safefree(dirp);
68dc0745 1011 return 1;
0a753a76
PP
1012}
1013
60b22aca
JD
1014/* duplicate a open DIR* for interpreter cloning */
1015DllExport DIR *
1016win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
1017{
1018 dVAR;
1019 PerlInterpreter *const from = param->proto_perl;
f76b679e 1020 PerlInterpreter *const to = (PerlInterpreter *)PERL_GET_THX;
60b22aca
JD
1021
1022 long pos;
1023 DIR *dup;
1024
1025 /* switch back to original interpreter because win32_readdir()
1026 * might Renew(dirp->start).
1027 */
1028 if (from != to) {
1029 PERL_SET_THX(from);
1030 }
1031
1032 /* mark current position; read all remaining entries into the
1033 * cache, and then restore to current position.
1034 */
1035 pos = win32_telldir(dirp);
1036 while (win32_readdir(dirp)) {
1037 /* read all entries into cache */
1038 }
1039 win32_seekdir(dirp, pos);
1040
1041 /* switch back to new interpreter to allocate new DIR structure */
1042 if (from != to) {
1043 PERL_SET_THX(to);
1044 }
1045
1046 Newx(dup, 1, DIR);
1047 memcpy(dup, dirp, sizeof(DIR));
1048
1049 Newx(dup->start, dirp->size, char);
1050 memcpy(dup->start, dirp->start, dirp->size);
1051
1052 dup->end = dup->start + (dirp->end - dirp->start);
1053 if (dirp->curr)
1054 dup->curr = dup->start + (dirp->curr - dirp->start);
1055
1056 return dup;
1057}
0a753a76 1058
68dc0745
PP
1059/*
1060 * various stubs
1061 */
0a753a76
PP
1062
1063
68dc0745
PP
1064/* Ownership
1065 *
1066 * Just pretend that everyone is a superuser. NT will let us know if
1067 * we don\'t really have permission to do something.
1068 */
0a753a76
PP
1069
1070#define ROOT_UID ((uid_t)0)
1071#define ROOT_GID ((gid_t)0)
1072
68dc0745
PP
1073uid_t
1074getuid(void)
0a753a76 1075{
68dc0745 1076 return ROOT_UID;
0a753a76
PP
1077}
1078
68dc0745
PP
1079uid_t
1080geteuid(void)
0a753a76 1081{
68dc0745 1082 return ROOT_UID;
0a753a76
PP
1083}
1084
68dc0745
PP
1085gid_t
1086getgid(void)
0a753a76 1087{
68dc0745 1088 return ROOT_GID;
0a753a76
PP
1089}
1090
68dc0745
PP
1091gid_t
1092getegid(void)
0a753a76 1093{
68dc0745 1094 return ROOT_GID;
0a753a76
PP
1095}
1096
68dc0745 1097int
22239a37 1098setuid(uid_t auid)
3fadfdf1 1099{
22239a37 1100 return (auid == ROOT_UID ? 0 : -1);
0a753a76
PP
1101}
1102
68dc0745 1103int
22239a37 1104setgid(gid_t agid)
0a753a76 1105{
22239a37 1106 return (agid == ROOT_GID ? 0 : -1);
0a753a76
PP
1107}
1108
73f2c082 1109EXTERN_C char *
e34ffe5a
GS
1110getlogin(void)
1111{
acfe0abc 1112 dTHX;
3352bfcb
GS
1113 char *buf = w32_getlogin_buffer;
1114 DWORD size = sizeof(w32_getlogin_buffer);
e34ffe5a
GS
1115 if (GetUserName(buf,&size))
1116 return buf;
1117 return (char*)NULL;
1118}
1119
b990f8c8
GS
1120int
1121chown(const char *path, uid_t owner, gid_t group)
1122{
1123 /* XXX noop */
1c1c7f20 1124 return 0;
b990f8c8
GS
1125}
1126
00b02797
JH
1127/*
1128 * XXX this needs strengthening (for PerlIO)
1129 * -- BKS, 11-11-200
1130*/
1131int mkstemp(const char *path)
1132{
1133 dTHX;
1134 char buf[MAX_PATH+1];
1135 int i = 0, fd = -1;
1136
1137retry:
1138 if (i++ > 10) { /* give up */
1139 errno = ENOENT;
1140 return -1;
1141 }
1142 if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1143 errno = ENOENT;
1144 return -1;
1145 }
1146 fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1147 if (fd == -1)
1148 goto retry;
1149 return fd;
1150}
1151
0aaad0ff 1152static long
04a2c3d9 1153find_pid(pTHX_ int pid)
0a753a76 1154{
7766f137
GS
1155 long child = w32_num_children;
1156 while (--child >= 0) {
eb160463 1157 if ((int)w32_child_pids[child] == pid)
0aaad0ff
GS
1158 return child;
1159 }
1160 return -1;
1161}
1162
1163static void
1164remove_dead_process(long child)
1165{
1166 if (child >= 0) {
acfe0abc 1167 dTHX;
0aaad0ff 1168 CloseHandle(w32_child_handles[child]);
c00206c8 1169 Move(&w32_child_handles[child+1], &w32_child_handles[child],
0aaad0ff 1170 (w32_num_children-child-1), HANDLE);
c00206c8 1171 Move(&w32_child_pids[child+1], &w32_child_pids[child],
0aaad0ff
GS
1172 (w32_num_children-child-1), DWORD);
1173 w32_num_children--;
f55ee38a 1174 }
f55ee38a
GS
1175}
1176
7766f137
GS
1177#ifdef USE_ITHREADS
1178static long
04a2c3d9 1179find_pseudo_pid(pTHX_ int pid)
7766f137 1180{
7766f137
GS
1181 long child = w32_num_pseudo_children;
1182 while (--child >= 0) {
eb160463 1183 if ((int)w32_pseudo_child_pids[child] == pid)
7766f137
GS
1184 return child;
1185 }
1186 return -1;
1187}
1188
1189static void
1190remove_dead_pseudo_process(long child)
1191{
1192 if (child >= 0) {
acfe0abc 1193 dTHX;
7766f137 1194 CloseHandle(w32_pseudo_child_handles[child]);
c00206c8 1195 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
7766f137 1196 (w32_num_pseudo_children-child-1), HANDLE);
c00206c8 1197 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
7766f137 1198 (w32_num_pseudo_children-child-1), DWORD);
aeecf691
JD
1199 Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1200 (w32_num_pseudo_children-child-1), HWND);
8a3cb9c6
JD
1201 Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child],
1202 (w32_num_pseudo_children-child-1), char);
7766f137
GS
1203 w32_num_pseudo_children--;
1204 }
1205}
8a3cb9c6
JD
1206
1207void
1208win32_wait_for_children(pTHX)
1209{
1210 if (w32_pseudo_children && w32_num_pseudo_children) {
1211 long child = 0;
1212 long count = 0;
1213 HANDLE handles[MAXIMUM_WAIT_OBJECTS];
1214
1215 for (child = 0; child < w32_num_pseudo_children; ++child) {
1216 if (!w32_pseudo_child_sigterm[child])
1217 handles[count++] = w32_pseudo_child_handles[child];
1218 }
1219 /* XXX should use MsgWaitForMultipleObjects() to continue
1220 * XXX processing messages while we wait.
1221 */
1222 WaitForMultipleObjects(count, handles, TRUE, INFINITE);
1223
1224 while (w32_num_pseudo_children)
1225 CloseHandle(w32_pseudo_child_handles[--w32_num_pseudo_children]);
1226 }
1227}
7766f137
GS
1228#endif
1229
542cb85f
JD
1230static int
1231terminate_process(DWORD pid, HANDLE process_handle, int sig)
1232{
1233 switch(sig) {
1234 case 0:
1235 /* "Does process exist?" use of kill */
1236 return 1;
1237 case 2:
1238 if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1239 return 1;
1240 break;
1241 case SIGBREAK:
1242 case SIGTERM:
1243 if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1244 return 1;
1245 break;
1246 default: /* For now be backwards compatible with perl 5.6 */
1247 case 9:
1248 /* Note that we will only be able to kill processes owned by the
1249 * current process owner, even when we are running as an administrator.
1250 * To kill processes of other owners we would need to set the
1251 * 'SeDebugPrivilege' privilege before obtaining the process handle.
1252 */
1253 if (TerminateProcess(process_handle, sig))
1254 return 1;
1255 break;
1256 }
1257 return 0;
1258}
1259
8cbe99e5
JD
1260int
1261killpg(int pid, int sig)
542cb85f
JD
1262{
1263 HANDLE process_handle;
1264 HANDLE snapshot_handle;
1265 int killed = 0;
1266
1267 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1268 if (process_handle == NULL)
542cb85f
JD
1269 return 0;
1270
1271 killed += terminate_process(pid, process_handle, sig);
1272
8cbe99e5 1273 snapshot_handle = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
542cb85f
JD
1274 if (snapshot_handle != INVALID_HANDLE_VALUE) {
1275 PROCESSENTRY32 entry;
1276
1277 entry.dwSize = sizeof(entry);
8cbe99e5 1278 if (Process32First(snapshot_handle, &entry)) {
542cb85f 1279 do {
8cbe99e5
JD
1280 if (entry.th32ParentProcessID == (DWORD)pid)
1281 killed += killpg(entry.th32ProcessID, sig);
542cb85f
JD
1282 entry.dwSize = sizeof(entry);
1283 }
8cbe99e5 1284 while (Process32Next(snapshot_handle, &entry));
542cb85f
JD
1285 }
1286 CloseHandle(snapshot_handle);
1287 }
1288 CloseHandle(process_handle);
1289 return killed;
1290}
1291
542cb85f
JD
1292static int
1293my_kill(int pid, int sig)
1294{
1295 int retval = 0;
1296 HANDLE process_handle;
1297
1298 if (sig < 0)
1299 return killpg(pid, -sig);
1300
1301 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af
JD
1302 /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
1303 if (process_handle != NULL) {
542cb85f
JD
1304 retval = terminate_process(pid, process_handle, sig);
1305 CloseHandle(process_handle);
1306 }
1307 return retval;
1308}
1309
d903973c 1310#ifdef USE_ITHREADS
17ce47a8
SH
1311/* Get a child pseudo-process HWND, with retrying and delaying/yielding.
1312 * The "tries" parameter is the number of retries to make, with a Sleep(1)
1313 * (waiting and yielding the time slot) between each try. Specifying 0 causes
1314 * only Sleep(0) (no waiting and potentially no yielding) to be used, so is not
1315 * recommended
1316 * Returns an hwnd != INVALID_HANDLE_VALUE (so be aware that NULL can be
1317 * returned) or croaks if the child pseudo-process doesn't schedule and deliver
1318 * a HWND in the time period allowed.
1319 */
d903973c 1320static HWND
17ce47a8
SH
1321get_hwnd_delay(pTHX, long child, DWORD tries)
1322{
d903973c 1323 HWND hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1324 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8
SH
1325
1326 /* Pseudo-process has not yet properly initialized since hwnd isn't set.
1327 * Fast sleep: On some NT kernels/systems, a Sleep(0) won't deschedule a
1328 * thread 100% of the time since threads are attached to a CPU for NUMA and
1329 * caching reasons, and the child thread was attached to a different CPU
1330 * therefore there is no workload on that CPU and Sleep(0) returns control
1331 * without yielding the time slot.
1332 * https://rt.perl.org/rt3/Ticket/Display.html?id=88840
1333 */
d903973c
DD
1334 Sleep(0);
1335 win32_async_check(aTHX);
17ce47a8 1336 hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1337 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8 1338
d903973c 1339 {
adb86be5 1340 unsigned int count = 0;
17ce47a8
SH
1341 /* No Sleep(1) if tries==0, just fail instead if we get this far. */
1342 while (count++ < tries) {
1343 Sleep(1);
1344 win32_async_check(aTHX);
1345 hwnd = w32_pseudo_child_message_hwnds[child];
1346 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
1347 }
d903973c 1348 }
17ce47a8
SH
1349
1350 Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled");
d903973c
DD
1351}
1352#endif
1353
f55ee38a
GS
1354DllExport int
1355win32_kill(int pid, int sig)
1356{
acfe0abc 1357 dTHX;
c66b022d 1358 long child;
7766f137
GS
1359#ifdef USE_ITHREADS
1360 if (pid < 0) {
1361 /* it is a pseudo-forked child */
04a2c3d9 1362 child = find_pseudo_pid(aTHX_ -pid);
7766f137 1363 if (child >= 0) {
85c508c3 1364 HANDLE hProcess = w32_pseudo_child_handles[child];
7e5f34c0 1365 switch (sig) {
17ce47a8
SH
1366 case 0:
1367 /* "Does process exist?" use of kill */
7e5f34c0 1368 return 0;
aeecf691 1369
17ce47a8
SH
1370 case 9: {
1371 /* kill -9 style un-graceful exit */
1372 /* Do a wait to make sure child starts and isn't in DLL
1373 * Loader Lock */
1374 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1375 if (TerminateThread(hProcess, sig)) {
1376 /* Allow the scheduler to finish cleaning up the other
1377 * thread.
1378 * Otherwise, if we ExitProcess() before another context
1379 * switch happens we will end up with a process exit
1380 * code of "sig" instead of our own exit status.
1381 * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
1382 */
1383 Sleep(0);
1384 remove_dead_pseudo_process(child);
1385 return 0;
1386 }
1387 break;
1388 }
1389
1390 default: {
1391 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1392 /* We fake signals to pseudo-processes using Win32
1393 * message queue. */
1394 if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1395 PostThreadMessage(-pid, WM_USER_KILL, sig, 0))
1396 {
1397 /* Don't wait for child process to terminate after we send a
1398 * SIGTERM because the child may be blocked in a system call
1399 * and never receive the signal.
1400 */
1401 if (sig == SIGTERM) {
1402 Sleep(0);
1403 w32_pseudo_child_sigterm[child] = 1;
1404 }
1405 /* It might be us ... */
1406 PERL_ASYNC_CHECK();
1407 return 0;
1408 }
1409 break;
1410 }
1411 } /* switch */
7766f137 1412 }
68dc0745 1413 }
7766f137
GS
1414 else
1415#endif
1416 {
04a2c3d9 1417 child = find_pid(aTHX_ pid);
7766f137 1418 if (child >= 0) {
542cb85f
JD
1419 if (my_kill(pid, sig)) {
1420 DWORD exitcode = 0;
1421 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1422 exitcode != STILL_ACTIVE)
1423 {
1424 remove_dead_process(child);
1425 }
1426 return 0;
7e5f34c0 1427 }
7766f137
GS
1428 }
1429 else {
8cbe99e5 1430 if (my_kill(pid, sig))
48db714f 1431 return 0;
7766f137
GS
1432 }
1433 }
1434 errno = EINVAL;
1435 return -1;
0a753a76 1436}
fbbbcc48 1437
68dc0745 1438DllExport int
c623ac67 1439win32_stat(const char *path, Stat_t *sbuf)
0a753a76 1440{
3fadfdf1 1441 char buffer[MAX_PATH+1];
68dc0745 1442 int l = strlen(path);
04a2c3d9 1443 dTHX;
67fbe06e 1444 int res;
6b980173 1445 int nlink = 1;
44221b20 1446 BOOL expect_dir = FALSE;
0a753a76 1447
cba61fe1
JD
1448 GV *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT",
1449 GV_NOTQUAL, SVt_PV);
1450 BOOL sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy));
1451
68dc0745
PP
1452 if (l > 1) {
1453 switch(path[l - 1]) {
e1dbac94 1454 /* FindFirstFile() and stat() are buggy with a trailing
44221b20 1455 * slashes, except for the root directory of a drive */
68dc0745 1456 case '\\':
44221b20
JD
1457 case '/':
1458 if (l > sizeof(buffer)) {
0b96339f
JD
1459 errno = ENAMETOOLONG;
1460 return -1;
1461 }
44221b20
JD
1462 --l;
1463 strncpy(buffer, path, l);
1464 /* remove additional trailing slashes */
1465 while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
1466 --l;
1467 /* add back slash if we otherwise end up with just a drive letter */
1468 if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
1469 buffer[l++] = '\\';
1470 buffer[l] = '\0';
1471 path = buffer;
1472 expect_dir = TRUE;
e1dbac94 1473 break;
44221b20 1474
23db2e2d 1475 /* FindFirstFile() is buggy with "x:", so add a dot :-( */
e1dbac94
GS
1476 case ':':
1477 if (l == 2 && isALPHA(path[0])) {
426c1a18
GS
1478 buffer[0] = path[0];
1479 buffer[1] = ':';
1480 buffer[2] = '.';
1481 buffer[3] = '\0';
e1dbac94 1482 l = 3;
426c1a18 1483 path = buffer;
e1dbac94
GS
1484 }
1485 break;
68dc0745
PP
1486 }
1487 }
6b980173 1488
8c56068e
JD
1489 path = PerlDir_mapA(path);
1490 l = strlen(path);
cba61fe1
JD
1491
1492 if (!sloppy) {
1493 /* We must open & close the file once; otherwise file attribute changes */
1494 /* might not yet have propagated to "other" hard links of the same file. */
1495 /* This also gives us an opportunity to determine the number of links. */
1496 HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
1497 if (handle != INVALID_HANDLE_VALUE) {
1498 BY_HANDLE_FILE_INFORMATION bhi;
1499 if (GetFileInformationByHandle(handle, &bhi))
1500 nlink = bhi.nNumberOfLinks;
1501 CloseHandle(handle);
1502 }
7fac1903 1503 }
6b980173 1504
8c56068e 1505 /* path will be mapped correctly above */
c623ac67 1506#if defined(WIN64) || defined(USE_LARGE_FILES)
8c56068e 1507 res = _stati64(path, sbuf);
c623ac67 1508#else
8c56068e 1509 res = stat(path, sbuf);
c623ac67 1510#endif
426c1a18 1511 sbuf->st_nlink = nlink;
6b980173 1512
24caa93f
GS
1513 if (res < 0) {
1514 /* CRT is buggy on sharenames, so make sure it really isn't.
1515 * XXX using GetFileAttributesEx() will enable us to set
426c1a18 1516 * sbuf->st_*time (but note that's not available on the
24caa93f 1517 * Windows of 1995) */
8c56068e 1518 DWORD r = GetFileAttributesA(path);
24caa93f 1519 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
426c1a18 1520 /* sbuf may still contain old garbage since stat() failed */
c623ac67 1521 Zero(sbuf, 1, Stat_t);
426c1a18 1522 sbuf->st_mode = S_IFDIR | S_IREAD;
24caa93f
GS
1523 errno = 0;
1524 if (!(r & FILE_ATTRIBUTE_READONLY))
426c1a18 1525 sbuf->st_mode |= S_IWRITE | S_IEXEC;
24caa93f
GS
1526 return 0;
1527 }
1528 }
24caa93f 1529 else {
e1dbac94
GS
1530 if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1531 && (path[2] == '\\' || path[2] == '/'))
2293b0e9
AB
1532 {
1533 /* The drive can be inaccessible, some _stat()s are buggy */
8c56068e 1534 if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
2293b0e9
AB
1535 errno = ENOENT;
1536 return -1;
1537 }
1538 }
44221b20
JD
1539 if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
1540 errno = ENOTDIR;
1541 return -1;
1542 }
038ae9a4
SH
1543 if (S_ISDIR(sbuf->st_mode)) {
1544 /* Ensure the "write" bit is switched off in the mode for
378eeda7
SH
1545 * directories with the read-only attribute set. Some compilers
1546 * switch it on for directories, which is technically correct
038ae9a4
SH
1547 * (directories are indeed always writable unless denied by DACLs),
1548 * but we want stat() and -w to reflect the state of the read-only
1549 * attribute for symmetry with chmod(). */
1550 DWORD r = GetFileAttributesA(path);
1551 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_READONLY)) {
1552 sbuf->st_mode &= ~S_IWRITE;
1553 }
1554 }
2293b0e9 1555 }
67fbe06e 1556 return res;
0a753a76
PP
1557}
1558
bb27e7b6
JH
1559#define isSLASH(c) ((c) == '/' || (c) == '\\')
1560#define SKIP_SLASHES(s) \
1561 STMT_START { \
1562 while (*(s) && isSLASH(*(s))) \
1563 ++(s); \
1564 } STMT_END
1565#define COPY_NONSLASHES(d,s) \
1566 STMT_START { \
1567 while (*(s) && !isSLASH(*(s))) \
1568 *(d)++ = *(s)++; \
1569 } STMT_END
1570
8ac9c18d
GS
1571/* Find the longname of a given path. path is destructively modified.
1572 * It should have space for at least MAX_PATH characters. */
1573DllExport char *
1574win32_longpath(char *path)
1575{
1576 WIN32_FIND_DATA fdata;
1577 HANDLE fhand;
1578 char tmpbuf[MAX_PATH+1];
1579 char *tmpstart = tmpbuf;
1580 char *start = path;
1581 char sep;
1582 if (!path)
4e205ed6 1583 return NULL;
8ac9c18d
GS
1584
1585 /* drive prefix */
bb27e7b6 1586 if (isALPHA(path[0]) && path[1] == ':') {
8ac9c18d
GS
1587 start = path + 2;
1588 *tmpstart++ = path[0];
1589 *tmpstart++ = ':';
1590 }
1591 /* UNC prefix */
bb27e7b6 1592 else if (isSLASH(path[0]) && isSLASH(path[1])) {
8ac9c18d 1593 start = path + 2;
52fcf7ee
GS
1594 *tmpstart++ = path[0];
1595 *tmpstart++ = path[1];
bb27e7b6
JH
1596 SKIP_SLASHES(start);
1597 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
8ac9c18d 1598 if (*start) {
bb27e7b6
JH
1599 *tmpstart++ = *start++;
1600 SKIP_SLASHES(start);
1601 COPY_NONSLASHES(tmpstart,start); /* copy share name */
8ac9c18d
GS
1602 }
1603 }
8ac9c18d 1604 *tmpstart = '\0';
bb27e7b6
JH
1605 while (*start) {
1606 /* copy initial slash, if any */
1607 if (isSLASH(*start)) {
1608 *tmpstart++ = *start++;
1609 *tmpstart = '\0';
1610 SKIP_SLASHES(start);
1611 }
1612
1613 /* FindFirstFile() expands "." and "..", so we need to pass
1614 * those through unmolested */
1615 if (*start == '.'
1616 && (!start[1] || isSLASH(start[1])
1617 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1618 {
1619 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1620 *tmpstart = '\0';
1621 continue;
1622 }
1623
1624 /* if this is the end, bust outta here */
1625 if (!*start)
1626 break;
8ac9c18d 1627
bb27e7b6
JH
1628 /* now we're at a non-slash; walk up to next slash */
1629 while (*start && !isSLASH(*start))
8ac9c18d 1630 ++start;
8ac9c18d
GS
1631
1632 /* stop and find full name of component */
bb27e7b6 1633 sep = *start;
8ac9c18d
GS
1634 *start = '\0';
1635 fhand = FindFirstFile(path,&fdata);
bb27e7b6 1636 *start = sep;
8ac9c18d 1637 if (fhand != INVALID_HANDLE_VALUE) {
bb27e7b6
JH
1638 STRLEN len = strlen(fdata.cFileName);
1639 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1640 strcpy(tmpstart, fdata.cFileName);
1641 tmpstart += len;
1642 FindClose(fhand);
1643 }
1644 else {
1645 FindClose(fhand);
1646 errno = ERANGE;
4e205ed6 1647 return NULL;
bb27e7b6 1648 }
8ac9c18d
GS
1649 }
1650 else {
1651 /* failed a step, just return without side effects */
bf49b057 1652 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
bb27e7b6 1653 errno = EINVAL;
4e205ed6 1654 return NULL;
8ac9c18d
GS
1655 }
1656 }
1657 strcpy(path,tmpbuf);
1658 return path;
1659}
1660
aa2b96ec 1661static void
0934c9d9 1662out_of_memory(void)
aa2b96ec 1663{
4cbe3a7d
DD
1664 if (PL_curinterp)
1665 croak_no_mem();
ae6198af 1666 exit(1);
aa2b96ec
JD
1667}
1668
073dd035
DD
1669void
1670win32_croak_not_implemented(const char * fname)
1671{
1672 PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
1673
1674 Perl_croak_nocontext("%s not implemented!\n", fname);
1675}
1676
00a0ae28
SH
1677/* Converts a wide character (UTF-16) string to the Windows ANSI code page,
1678 * potentially using the system's default replacement character for any
1679 * unrepresentable characters. The caller must free() the returned string. */
1680static char*
1681wstr_to_str(const wchar_t* wstr)
1682{
1683 BOOL used_default = FALSE;
1684 size_t wlen = wcslen(wstr) + 1;
1685 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1686 NULL, 0, NULL, NULL);
f76b679e 1687 char* str = (char*)malloc(len);
00a0ae28
SH
1688 if (!str)
1689 out_of_memory();
1690 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1691 str, len, NULL, &used_default);
1692 return str;
1693}
1694
aa2b96ec
JD
1695/* The win32_ansipath() function takes a Unicode filename and converts it
1696 * into the current Windows codepage. If some characters cannot be mapped,
1697 * then it will convert the short name instead.
1698 *
1699 * The buffer to the ansi pathname must be freed with win32_free() when it
1700 * it no longer needed.
1701 *
1702 * The argument to win32_ansipath() must exist before this function is
1703 * called; otherwise there is no way to determine the short path name.
1704 *
1705 * Ideas for future refinement:
1706 * - Only convert those segments of the path that are not in the current
1707 * codepage, but leave the other segments in their long form.
1708 * - If the resulting name is longer than MAX_PATH, start converting
1709 * additional path segments into short names until the full name
1710 * is shorter than MAX_PATH. Shorten the filename part last!
1711 */
1712DllExport char *
1713win32_ansipath(const WCHAR *widename)
1714{
1715 char *name;
1716 BOOL use_default = FALSE;
1717 size_t widelen = wcslen(widename)+1;
1718 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1719 NULL, 0, NULL, NULL);
f76b679e 1720 name = (char*)win32_malloc(len);
aa2b96ec
JD
1721 if (!name)
1722 out_of_memory();
1723
1724 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1725 name, len, NULL, &use_default);
1726 if (use_default) {
aa2b96ec 1727 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af 1728 if (shortlen) {
f76b679e 1729 WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
ae6198af
JD
1730 if (!shortname)
1731 out_of_memory();
1732 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1733
1734 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1735 NULL, 0, NULL, NULL);
f76b679e 1736 name = (char*)win32_realloc(name, len);
ae6198af
JD
1737 if (!name)
1738 out_of_memory();
1739 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1740 name, len, NULL, NULL);
1741 win32_free(shortname);
1742 }
aa2b96ec
JD
1743 }
1744 return name;
1745}
1746
2c8ca683
DD
1747/* the returned string must be freed with win32_freeenvironmentstrings which is
1748 * implemented as a macro
1749 * void win32_freeenvironmentstrings(void* block)
1750 */
0551aaa8 1751DllExport char *
4f46e52b
KR
1752win32_getenvironmentstrings(void)
1753{
1754 LPWSTR lpWStr, lpWTmp;
1755 LPSTR lpStr, lpTmp;
1756 DWORD env_len, wenvstrings_len = 0, aenvstrings_len = 0;
1757
1758 /* Get the process environment strings */
1759 lpWTmp = lpWStr = (LPWSTR) GetEnvironmentStringsW();
fa467b9b 1760 for (wenvstrings_len = 1; *lpWTmp != '\0'; lpWTmp += env_len + 1) {
4f46e52b
KR
1761 env_len = wcslen(lpWTmp);
1762 /* calculate the size of the environment strings */
1763 wenvstrings_len += env_len + 1;
1764 }
1765
fa467b9b 1766 /* Get the number of bytes required to store the ACP encoded string */
4f46e52b 1767 aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
fa467b9b 1768 lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
4f46e52b
KR
1769 lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
1770 if(!lpTmp)
1771 out_of_memory();
1772
1773 /* Convert the string from UTF-16 encoding to ACP encoding */
1774 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
fa467b9b 1775 aenvstrings_len, NULL, NULL);
4f46e52b
KR
1776
1777 return(lpStr);
1778}
1779
4f46e52b 1780DllExport char *
0551aaa8
GS
1781win32_getenv(const char *name)
1782{
acfe0abc 1783 dTHX;
0551aaa8 1784 DWORD needlen;
4e205ed6 1785 SV *curitem = NULL;
1fcb0052 1786 DWORD last_err;
58a50f62 1787
8c56068e 1788 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 1789 if (needlen != 0) {
51371543 1790 curitem = sv_2mortal(newSVpvn("", 0));
8c56068e
JD
1791 do {
1792 SvGROW(curitem, needlen+1);
1793 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
1794 needlen);
1795 } while (needlen >= SvLEN(curitem));
1796 SvCUR_set(curitem, needlen);
0551aaa8 1797 }
c934e9d4 1798 else {
1fcb0052
PM
1799 last_err = GetLastError();
1800 if (last_err == ERROR_NOT_ENOUGH_MEMORY) {
1801 /* It appears the variable is in the env, but the Win32 API
1802 doesn't have a canned way of getting it. So we fall back to
1803 grabbing the whole env and pulling this value out if possible */
1804 char *envv = GetEnvironmentStrings();
1805 char *cur = envv;
1806 STRLEN len;
1807 while (*cur) {
1808 char *end = strchr(cur,'=');
1809 if (end && end != cur) {
1810 *end = '\0';
1811 if (!strcmp(cur,name)) {
1812 curitem = sv_2mortal(newSVpv(end+1,0));
1813 *end = '=';
1814 break;
1815 }
1816 *end = '=';
1817 cur = end + strlen(end+1)+2;
1818 }
1819 else if ((len = strlen(cur)))
1820 cur += len+1;
1821 }
1822 FreeEnvironmentStrings(envv);
1823 }
1824 else {
1825 /* last ditch: allow any environment variables that begin with 'PERL'
1826 to be obtained from the registry, if found there */
1827 if (strncmp(name, "PERL", 4) == 0)
1828 (void)get_regstr(name, &curitem);
1829 }
c69f6586 1830 }
51371543
GS
1831 if (curitem && SvCUR(curitem))
1832 return SvPVX(curitem);
58a50f62 1833
4e205ed6 1834 return NULL;
0551aaa8
GS
1835}
1836
ac5c734f
GS
1837DllExport int
1838win32_putenv(const char *name)
1839{
1840 char* curitem;
1841 char* val;
b813a9c7 1842 int relval = -1;
51371543 1843
73c4f7a1 1844 if (name) {
9399a70c 1845 curitem = (char *) win32_malloc(strlen(name)+1);
8c56068e
JD
1846 strcpy(curitem, name);
1847 val = strchr(curitem, '=');
1848 if (val) {
1849 /* The sane way to deal with the environment.
1850 * Has these advantages over putenv() & co.:
1851 * * enables us to store a truly empty value in the
1852 * environment (like in UNIX).
8d0cd07e
SH
1853 * * we don't have to deal with RTL globals, bugs and leaks
1854 * (specifically, see http://support.microsoft.com/kb/235601).
8c56068e 1855 * * Much faster.
d0fc6d8d
SH
1856 * Why you may want to use the RTL environment handling
1857 * (previously enabled by USE_WIN32_RTL_ENV):
8c56068e
JD
1858 * * environ[] and RTL functions will not reflect changes,
1859 * which might be an issue if extensions want to access
1860 * the env. via RTL. This cuts both ways, since RTL will
1861 * not see changes made by extensions that call the Win32
1862 * functions directly, either.
1863 * GSAR 97-06-07
1864 */
1865 *val++ = '\0';
1866 if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
1867 relval = 0;
1868 }
9399a70c 1869 win32_free(curitem);
ac5c734f
GS
1870 }
1871 return relval;
1872}
1873
d55594ae 1874static long
2d7a9237 1875filetime_to_clock(PFILETIME ft)
d55594ae 1876{
7766f137
GS
1877 __int64 qw = ft->dwHighDateTime;
1878 qw <<= 32;
1879 qw |= ft->dwLowDateTime;
1880 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
1881 return (long) qw;
d55594ae
GS
1882}
1883
f3986ebb
GS
1884DllExport int
1885win32_times(struct tms *timebuf)
0a753a76 1886{
d55594ae
GS
1887 FILETIME user;
1888 FILETIME kernel;
1889 FILETIME dummy;
50ee8e5e 1890 clock_t process_time_so_far = clock();
3fadfdf1 1891 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
d55594ae 1892 &kernel,&user)) {
2d7a9237
GS
1893 timebuf->tms_utime = filetime_to_clock(&user);
1894 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS
1895 timebuf->tms_cutime = 0;
1896 timebuf->tms_cstime = 0;
3fadfdf1 1897 } else {
d55594ae 1898 /* That failed - e.g. Win95 fallback to clock() */
50ee8e5e 1899 timebuf->tms_utime = process_time_so_far;
d55594ae
GS
1900 timebuf->tms_stime = 0;
1901 timebuf->tms_cutime = 0;
1902 timebuf->tms_cstime = 0;
1903 }
50ee8e5e 1904 return process_time_so_far;
0a753a76
PP
1905}
1906
9c51cf4c 1907/* fix utime() so it works on directories in NT */
ad0751ec
GS
1908static BOOL
1909filetime_from_time(PFILETIME pFileTime, time_t Time)
1910{
9c51cf4c 1911 struct tm *pTM = localtime(&Time);
ad0751ec 1912 SYSTEMTIME SystemTime;
9c51cf4c 1913 FILETIME LocalTime;
ad0751ec
GS
1914
1915 if (pTM == NULL)
1916 return FALSE;
1917
1918 SystemTime.wYear = pTM->tm_year + 1900;
1919 SystemTime.wMonth = pTM->tm_mon + 1;
1920 SystemTime.wDay = pTM->tm_mday;
1921 SystemTime.wHour = pTM->tm_hour;
1922 SystemTime.wMinute = pTM->tm_min;
1923 SystemTime.wSecond = pTM->tm_sec;
1924 SystemTime.wMilliseconds = 0;
1925
9c51cf4c
GS
1926 return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
1927 LocalFileTimeToFileTime(&LocalTime, pFileTime);
ad0751ec
GS
1928}
1929
1930DllExport int
7766f137
GS
1931win32_unlink(const char *filename)
1932{
acfe0abc 1933 dTHX;
7766f137
GS
1934 int ret;
1935 DWORD attrs;
1936
8c56068e
JD
1937 filename = PerlDir_mapA(filename);
1938 attrs = GetFileAttributesA(filename);
1939 if (attrs == 0xFFFFFFFF) {
1940 errno = ENOENT;
1941 return -1;
7766f137 1942 }
8c56068e
JD
1943 if (attrs & FILE_ATTRIBUTE_READONLY) {
1944 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
1945 ret = unlink(filename);
1946 if (ret == -1)
1947 (void)SetFileAttributesA(filename, attrs);
7766f137 1948 }
8c56068e
JD
1949 else
1950 ret = unlink(filename);
7766f137
GS
1951 return ret;
1952}
1953
1954DllExport int
3b405fc5 1955win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 1956{
acfe0abc 1957 dTHX;
ad0751ec
GS
1958 HANDLE handle;
1959 FILETIME ftCreate;
1960 FILETIME ftAccess;
1961 FILETIME ftWrite;
1962 struct utimbuf TimeBuffer;
7fac1903 1963 int rc;
8c56068e
JD
1964
1965 filename = PerlDir_mapA(filename);
1966 rc = utime(filename, times);
1967
ad0751ec 1968 /* EACCES: path specifies directory or readonly file */
8cbe99e5 1969 if (rc == 0 || errno != EACCES)
ad0751ec
GS
1970 return rc;
1971
1972 if (times == NULL) {
1973 times = &TimeBuffer;
1974 time(&times->actime);
1975 times->modtime = times->actime;
1976 }
1977
1978 /* This will (and should) still fail on readonly files */
8c56068e
JD
1979 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
1980 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1981 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
ad0751ec
GS
1982 if (handle == INVALID_HANDLE_VALUE)
1983 return rc;
1984
1985 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
1986 filetime_from_time(&ftAccess, times->actime) &&
1987 filetime_from_time(&ftWrite, times->modtime) &&
1988 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
1989 {
1990 rc = 0;
1991 }
1992
1993 CloseHandle(handle);
1994 return rc;
1995}
1996
6e3b076d
JH
1997typedef union {
1998 unsigned __int64 ft_i64;
1999 FILETIME ft_val;
2000} FT_t;
2001
2002#ifdef __GNUC__
2003#define Const64(x) x##LL
2004#else
2005#define Const64(x) x##i64
2006#endif
2007/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
2008#define EPOCH_BIAS Const64(116444736000000000)
2009
57ab3dfe
GS
2010/* NOTE: This does not compute the timezone info (doing so can be expensive,
2011 * and appears to be unsupported even by glibc) */
2012DllExport int
2013win32_gettimeofday(struct timeval *tp, void *not_used)
2014{
6e3b076d
JH
2015 FT_t ft;
2016
2017 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
2018 GetSystemTimeAsFileTime(&ft.ft_val);
2019
2020 /* seconds since epoch */
2021 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
2022
2023 /* microseconds remaining */
2024 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
2025
2026 return 0;
57ab3dfe
GS
2027}
2028
2d7a9237 2029DllExport int
b2af26b1
GS
2030win32_uname(struct utsname *name)
2031{
2032 struct hostent *hep;
2033 STRLEN nodemax = sizeof(name->nodename)-1;
b2af26b1 2034
aeecf691
JD
2035 /* sysname */
2036 switch (g_osver.dwPlatformId) {
2037 case VER_PLATFORM_WIN32_WINDOWS:
2038 strcpy(name->sysname, "Windows");
2039 break;
2040 case VER_PLATFORM_WIN32_NT:
2041 strcpy(name->sysname, "Windows NT");
2042 break;
2043 case VER_PLATFORM_WIN32s:
2044 strcpy(name->sysname, "Win32s");
2045 break;
2046 default:
2047 strcpy(name->sysname, "Win32 Unknown");
2048 break;
b2af26b1 2049 }
aeecf691
JD
2050
2051 /* release */
2052 sprintf(name->release, "%d.%d",
2053 g_osver.dwMajorVersion, g_osver.dwMinorVersion);
2054
2055 /* version */
2056 sprintf(name->version, "Build %d",
2057 g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
2058 ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
2059 if (g_osver.szCSDVersion[0]) {
2060 char *buf = name->version + strlen(name->version);
2061 sprintf(buf, " (%s)", g_osver.szCSDVersion);
b2af26b1
GS
2062 }
2063
2064 /* nodename */
2065 hep = win32_gethostbyname("localhost");
2066 if (hep) {
2067 STRLEN len = strlen(hep->h_name);
2068 if (len <= nodemax) {
2069 strcpy(name->nodename, hep->h_name);
2070 }
2071 else {
2072 strncpy(name->nodename, hep->h_name, nodemax);
2073 name->nodename[nodemax] = '\0';
2074 }
2075 }
2076 else {
2077 DWORD sz = nodemax;
2078 if (!GetComputerName(name->nodename, &sz))
2079 *name->nodename = '\0';
2080 }
2081
2082 /* machine (architecture) */
2083 {
2084 SYSTEM_INFO info;
fe537c65 2085 DWORD procarch;
b2af26b1
GS
2086 char *arch;
2087 GetSystemInfo(&info);
a6c40364 2088
378eeda7 2089#if (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION) && !defined(__MINGW_EXTENSION))
fe537c65 2090 procarch = info.u.s.wProcessorArchitecture;
a6c40364 2091#else
fe537c65 2092 procarch = info.wProcessorArchitecture;
a6c40364 2093#endif
fe537c65 2094 switch (procarch) {
b2af26b1
GS
2095 case PROCESSOR_ARCHITECTURE_INTEL:
2096 arch = "x86"; break;
fe537c65
GS
2097 case PROCESSOR_ARCHITECTURE_IA64:
2098 arch = "ia64"; break;
fe537c65
GS
2099 case PROCESSOR_ARCHITECTURE_AMD64:
2100 arch = "amd64"; break;
fe537c65 2101 case PROCESSOR_ARCHITECTURE_UNKNOWN:
b2af26b1 2102 arch = "unknown"; break;
fe537c65
GS
2103 default:
2104 sprintf(name->machine, "unknown(0x%x)", procarch);
2105 arch = name->machine;
2106 break;
b2af26b1 2107 }
fe537c65
GS
2108 if (name->machine != arch)
2109 strcpy(name->machine, arch);
b2af26b1
GS
2110 }
2111 return 0;
2112}
2113
8fb3fcfb
NIS
2114/* Timing related stuff */
2115
3fadfdf1
NIS
2116int
2117do_raise(pTHX_ int sig)
2118{
2119 if (sig < SIG_SIZE) {
2120 Sighandler_t handler = w32_sighandler[sig];
2121 if (handler == SIG_IGN) {
2122 return 0;
2123 }
2124 else if (handler != SIG_DFL) {
2125 (*handler)(sig);
2126 return 0;
2127 }
2128 else {
2129 /* Choose correct default behaviour */
2130 switch (sig) {
2131#ifdef SIGCLD
2132 case SIGCLD:
2133#endif
2134#ifdef SIGCHLD
2135 case SIGCHLD:
2136#endif
2137 case 0:
2138 return 0;
2139 case SIGTERM:
2140 default:
2141 break;
2142 }
2143 }
2144 }
2145 /* Tell caller to exit thread/process as approriate */
2146 return 1;
2147}
2148
2149void
2150sig_terminate(pTHX_ int sig)
2151{
2152 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2153 /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2154 thread
2155 */
2156 exit(sig);
2157}
2158
8fb3fcfb
NIS
2159DllExport int
2160win32_async_check(pTHX)
2161{
2162 MSG msg;
aeecf691
JD
2163 HWND hwnd = w32_message_hwnd;
2164
099b16d3
RM
2165 /* Reset w32_poll_count before doing anything else, incase we dispatch
2166 * messages that end up calling back into perl */
aeecf691
JD
2167 w32_poll_count = 0;
2168
099b16d3
RM
2169 if (hwnd != INVALID_HANDLE_VALUE) {
2170 /* Passing PeekMessage -1 as HWND (2nd arg) only gets PostThreadMessage() messages
2171 * and ignores window messages - should co-exist better with windows apps e.g. Tk
2172 */
2173 if (hwnd == NULL)
2174 hwnd = (HWND)-1;
2175
2176 while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) ||
2177 PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2178 {
2179 /* re-post a WM_QUIT message (we'll mark it as read later) */
2180 if(msg.message == WM_QUIT) {
2181 PostQuitMessage((int)msg.wParam);
2182 break;
2183 }
8fb3fcfb 2184
099b16d3
RM
2185 if(!CallMsgFilter(&msg, MSGF_USER))
2186 {
2187 TranslateMessage(&msg);
2188 DispatchMessage(&msg);
aeecf691 2189 }
099b16d3 2190 }
8fb3fcfb
NIS
2191 }
2192
099b16d3
RM
2193 /* Call PeekMessage() to mark all pending messages in the queue as "old".
2194 * This is necessary when we are being called by win32_msgwait() to
2195 * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2196 * message over and over. An example how this can happen is when
2197 * Perl is calling win32_waitpid() inside a GUI application and the GUI
2198 * is generating messages before the process terminated.
2199 */
4386d69d 2200 PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
099b16d3 2201
7e5f34c0 2202 /* Above or other stuff may have set a signal flag */
099b16d3
RM
2203 if (PL_sig_pending)
2204 despatch_signals();
2205
aeecf691 2206 return 1;
8fb3fcfb
NIS
2207}
2208
089197fa
GS
2209/* This function will not return until the timeout has elapsed, or until
2210 * one of the handles is ready. */
8fb3fcfb
NIS
2211DllExport DWORD
2212win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2213{
2214 /* We may need several goes at this - so compute when we stop */
001e9f89
DD
2215 FT_t ticks = {0};
2216 unsigned __int64 endtime = timeout;
8fb3fcfb 2217 if (timeout != INFINITE) {
001e9f89
DD
2218 GetSystemTimeAsFileTime(&ticks.ft_val);
2219 ticks.ft_i64 /= 10000;
2220 endtime += ticks.ft_i64;
2221 }
2222 /* This was a race condition. Do not let a non INFINITE timeout to
2223 * MsgWaitForMultipleObjects roll under 0 creating a near
2224 * infinity/~(UINT32)0 timeout which will appear as a deadlock to the
2225 * user who did a CORE perl function with a non infinity timeout,
2226 * sleep for example. This is 64 to 32 truncation minefield.
2227 *
2228 * This scenario can only be created if the timespan from the return of
2229 * MsgWaitForMultipleObjects to GetSystemTimeAsFileTime exceeds 1 ms. To
2230 * generate the scenario, manual breakpoints in a C debugger are required,
2231 * or a context switch occured in win32_async_check in PeekMessage, or random
2232 * messages are delivered to the *thread* message queue of the Perl thread
2233 * from another process (msctf.dll doing IPC among its instances, VS debugger
2234 * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096].
2235 */
2236 while (ticks.ft_i64 <= endtime) {
9afd6203
SH
2237 /* if timeout's type is lengthened, remember to split 64b timeout
2238 * into multiple non-infinity runs of MWFMO */
2239 DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE,
2240 (DWORD)(endtime - ticks.ft_i64),
2241 QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
8fb3fcfb
NIS
2242 if (resultp)
2243 *resultp = result;
2244 if (result == WAIT_TIMEOUT) {
3fadfdf1
NIS
2245 /* Ran out of time - explicit return of zero to avoid -ve if we
2246 have scheduling issues
2247 */
8fb3fcfb
NIS
2248 return 0;
2249 }
2250 if (timeout != INFINITE) {
001e9f89
DD
2251 GetSystemTimeAsFileTime(&ticks.ft_val);
2252 ticks.ft_i64 /= 10000;
2253 }
8fb3fcfb
NIS
2254 if (result == WAIT_OBJECT_0 + count) {
2255 /* Message has arrived - check it */
089197fa 2256 (void)win32_async_check(aTHX);
8fb3fcfb
NIS
2257 }
2258 else {
2259 /* Not timeout or message - one of handles is ready */
2260 break;
2261 }
2262 }
8fb3fcfb 2263 /* If we are past the end say zero */
9afd6203 2264 if (!ticks.ft_i64 || ticks.ft_i64 > endtime)
001e9f89
DD
2265 return 0;
2266 /* compute time left to wait */
2267 ticks.ft_i64 = endtime - ticks.ft_i64;
9afd6203
SH
2268 /* if more ms than DWORD, then return max DWORD */
2269 return ticks.ft_i64 <= UINT_MAX ? (DWORD)ticks.ft_i64 : UINT_MAX;
8fb3fcfb
NIS
2270}
2271
932b7487 2272int
04a2c3d9 2273win32_internal_wait(pTHX_ int *status, DWORD timeout)
932b7487
RC
2274{
2275 /* XXX this wait emulation only knows about processes
2276 * spawned via win32_spawnvp(P_NOWAIT, ...).
2277 */
932b7487
RC
2278 int i, retval;
2279 DWORD exitcode, waitcode;
2280
2281#ifdef USE_ITHREADS
2282 if (w32_num_pseudo_children) {
8fb3fcfb
NIS
2283 win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2284 timeout, &waitcode);
932b7487
RC
2285 /* Time out here if there are no other children to wait for. */
2286 if (waitcode == WAIT_TIMEOUT) {
2287 if (!w32_num_children) {
2288 return 0;
2289 }
2290 }
2291 else if (waitcode != WAIT_FAILED) {
2292 if (waitcode >= WAIT_ABANDONED_0
2293 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2294 i = waitcode - WAIT_ABANDONED_0;
2295 else
2296 i = waitcode - WAIT_OBJECT_0;
2297 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2298 *status = (int)((exitcode & 0xff) << 8);
2299 retval = (int)w32_pseudo_child_pids[i];
2300 remove_dead_pseudo_process(i);
2301 return -retval;
2302 }
2303 }
2304 }
2305#endif
2306
2307 if (!w32_num_children) {
2308 errno = ECHILD;
2309 return -1;
2310 }
2311
2312 /* if a child exists, wait for it to die */
8fb3fcfb 2313 win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
932b7487
RC
2314 if (waitcode == WAIT_TIMEOUT) {
2315 return 0;
2316 }
2317 if (waitcode != WAIT_FAILED) {
2318 if (waitcode >= WAIT_ABANDONED_0
2319 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2320 i = waitcode - WAIT_ABANDONED_0;
2321 else
2322 i = waitcode - WAIT_OBJECT_0;
2323 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2324 *status = (int)((exitcode & 0xff) << 8);
2325 retval = (int)w32_child_pids[i];
2326 remove_dead_process(i);
2327 return retval;
2328 }
2329 }
2330
932b7487
RC
2331 errno = GetLastError();
2332 return -1;
2333}
2334
b2af26b1 2335DllExport int
f55ee38a
GS
2336win32_waitpid(int pid, int *status, int flags)
2337{
acfe0abc 2338 dTHX;
922b1888 2339 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
0aaad0ff 2340 int retval = -1;
c66b022d 2341 long child;
7766f137 2342 if (pid == -1) /* XXX threadid == 1 ? */
04a2c3d9 2343 return win32_internal_wait(aTHX_ status, timeout);
7766f137
GS
2344#ifdef USE_ITHREADS
2345 else if (pid < 0) {
04a2c3d9 2346 child = find_pseudo_pid(aTHX_ -pid);
7766f137
GS
2347 if (child >= 0) {
2348 HANDLE hThread = w32_pseudo_child_handles[child];
8fb3fcfb
NIS
2349 DWORD waitcode;
2350 win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2f67576d
BC
2351 if (waitcode == WAIT_TIMEOUT) {
2352 return 0;
2353 }
8fb3fcfb 2354 else if (waitcode == WAIT_OBJECT_0) {
7766f137
GS
2355 if (GetExitCodeThread(hThread, &waitcode)) {
2356 *status = (int)((waitcode & 0xff) << 8);
2357 retval = (int)w32_pseudo_child_pids[child];
2358 remove_dead_pseudo_process(child);
68a29c53 2359 return -retval;
7766f137
GS
2360 }
2361 }
2362 else
2363 errno = ECHILD;
2364 }
2365 }
2366#endif
f55ee38a 2367 else {
922b1888
GS
2368 HANDLE hProcess;
2369 DWORD waitcode;
04a2c3d9 2370 child = find_pid(aTHX_ pid);
0aaad0ff 2371 if (child >= 0) {
922b1888 2372 hProcess = w32_child_handles[child];
8fb3fcfb 2373 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
a7867d0a
GS
2374 if (waitcode == WAIT_TIMEOUT) {
2375 return 0;
2376 }
8fb3fcfb 2377 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS
2378 if (GetExitCodeProcess(hProcess, &waitcode)) {
2379 *status = (int)((waitcode & 0xff) << 8);
2380 retval = (int)w32_child_pids[child];
2381 remove_dead_process(child);
2382 return retval;
2383 }
a7867d0a 2384 }
0aaad0ff
GS
2385 else
2386 errno = ECHILD;
2387 }
2388 else {
8cbe99e5 2389 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
922b1888 2390 if (hProcess) {
8fb3fcfb 2391 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
922b1888 2392 if (waitcode == WAIT_TIMEOUT) {
48db714f 2393 CloseHandle(hProcess);
922b1888
GS
2394 return 0;
2395 }
8fb3fcfb 2396 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS
2397 if (GetExitCodeProcess(hProcess, &waitcode)) {
2398 *status = (int)((waitcode & 0xff) << 8);
2399 CloseHandle(hProcess);
2400 return pid;
2401 }
2402 }
2403 CloseHandle(hProcess);
2404 }
2405 else
2406 errno = ECHILD;
0aaad0ff 2407 }
f55ee38a 2408 }
3fadfdf1 2409 return retval >= 0 ? pid : retval;
f55ee38a
GS
2410}
2411
2412DllExport int
2d7a9237
GS
2413win32_wait(int *status)
2414{
04a2c3d9
DD
2415 dTHX;
2416 return win32_internal_wait(aTHX_ status, INFINITE);
2d7a9237 2417}
d55594ae 2418
8fb3fcfb
NIS
2419DllExport unsigned int
2420win32_sleep(unsigned int t)
d55594ae 2421{
acfe0abc 2422 dTHX;
8fb3fcfb 2423 /* Win32 times are in ms so *1000 in and /1000 out */
3b9aea04
SH
2424 if (t > UINT_MAX / 1000) {
2425 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
2426 "sleep(%lu) too large", t);
2427 }
2428 return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000;
d55594ae
GS
2429}
2430
f3986ebb
GS
2431DllExport unsigned int
2432win32_alarm(unsigned int sec)
0a753a76 2433{
3fadfdf1 2434 /*
d55594ae 2435 * the 'obvious' implentation is SetTimer() with a callback
3fadfdf1
NIS
2436 * which does whatever receiving SIGALRM would do
2437 * we cannot use SIGALRM even via raise() as it is not
d55594ae 2438 * one of the supported codes in <signal.h>
3fadfdf1 2439 */
acfe0abc 2440 dTHX;
aeecf691
JD
2441
2442 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2443 w32_message_hwnd = win32_create_message_window();
2444
8fb3fcfb 2445 if (sec) {
aeecf691
JD
2446 if (w32_message_hwnd == NULL)
2447 w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2448 else {
2449 w32_timerid = 1;
2450 SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2451 }
8fb3fcfb
NIS
2452 }
2453 else {
2454 if (w32_timerid) {
aeecf691
JD
2455 KillTimer(w32_message_hwnd, w32_timerid);
2456 w32_timerid = 0;
8fb3fcfb 2457 }
3fadfdf1 2458 }
afe91769 2459 return 0;
0a753a76
PP
2460}
2461
2d77217b 2462extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
26618a56
GS
2463
2464DllExport char *
2465win32_crypt(const char *txt, const char *salt)
2466{
acfe0abc 2467 dTHX;
3352bfcb 2468 return des_fcrypt(txt, salt, w32_crypt_buffer);
26618a56 2469}
26618a56 2470
390b85e7
GS
2471/* simulate flock by locking a range on the file */
2472
390b85e7
GS
2473#define LK_LEN 0xffff0000
2474
f3986ebb
GS
2475DllExport int
2476win32_flock(int fd, int oper)
390b85e7
GS
2477{
2478 OVERLAPPED o;
2479 int i = -1;
2480 HANDLE fh;
2481
2482 fh = (HANDLE)_get_osfhandle(fd);
97b33cac
JD
2483 if (fh == (HANDLE)-1) /* _get_osfhandle() already sets errno to EBADF */
2484 return -1;
2485
390b85e7
GS
2486 memset(&o, 0, sizeof(o));
2487
2488 switch(oper) {
2489 case LOCK_SH: /* shared lock */
97b33cac
JD
2490 if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o))
2491 i = 0;
390b85e7
GS
2492 break;
2493 case LOCK_EX: /* exclusive lock */
97b33cac
JD
2494 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o))
2495 i = 0;
390b85e7
GS
2496 break;
2497 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
97b33cac
JD
2498 if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o))
2499 i = 0;
390b85e7
GS
2500 break;
2501 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
97b33cac
JD
2502 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2503 0, LK_LEN, 0, &o))
2504 i = 0;
390b85e7
GS
2505 break;
2506 case LOCK_UN: /* unlock lock */
97b33cac
JD
2507 if (UnlockFileEx(fh, 0, LK_LEN, 0, &o))
2508 i = 0;
390b85e7
GS
2509 break;
2510 default: /* unknown */
2511 errno = EINVAL;
97b33cac
JD
2512 return -1;
2513 }
2514 if (i == -1) {
2515 if (GetLastError() == ERROR_LOCK_VIOLATION)
b0ba2190 2516 errno = EWOULDBLOCK;
97b33cac
JD
2517 else
2518 errno = EINVAL;
390b85e7
GS
2519 }
2520 return i;
2521}
2522
390b85e7
GS
2523#undef LK_LEN
2524
cd6a3131
SH
2525extern int convert_wsa_error_to_errno(int wsaerr); /* in win32sck.c */
2526
c9beaf97
SH
2527/* Get the errno value corresponding to the given err. This function is not
2528 * intended to handle conversion of general GetLastError() codes. It only exists
2529 * to translate Windows sockets error codes from WSAGetLastError(). Such codes
2530 * used to be assigned to errno/$! in earlier versions of perl; this function is
2531 * used to catch any old Perl code which is still trying to assign such values
2532 * to $! and convert them to errno values instead.
2533 */
2534int
2535win32_get_errno(int err)
2536{
2537 return convert_wsa_error_to_errno(err);
2538}
2539
68dc0745
PP
2540/*
2541 * redirected io subsystem for all XS modules
2542 *
2543 */
0a753a76 2544
68dc0745
PP
2545DllExport int *
2546win32_errno(void)
0a753a76 2547{
390b85e7 2548 return (&errno);
0a753a76
PP
2549}
2550
dcb2879a
GS
2551DllExport char ***
2552win32_environ(void)
2553{
390b85e7 2554 return (&(_environ));
dcb2879a
GS
2555}
2556
68dc0745
PP
2557/* the rest are the remapped stdio routines */
2558DllExport FILE *
2559win32_stderr(void)
0a753a76 2560{
390b85e7 2561 return (stderr);
0a753a76
PP
2562}
2563
68dc0745
PP
2564DllExport FILE *
2565win32_stdin(void)
0a753a76 2566{
390b85e7 2567 return (stdin);
0a753a76
PP
2568}
2569
68dc0745 2570DllExport FILE *
0934c9d9 2571win32_stdout(void)
0a753a76 2572{
390b85e7 2573 return (stdout);
0a753a76
PP
2574}
2575
68dc0745
PP
2576DllExport int
2577win32_ferror(FILE *fp)
0a753a76 2578{
390b85e7 2579 return (ferror(fp));
0a753a76
PP
2580}
2581
2582
68dc0745
PP
2583DllExport int
2584win32_feof(FILE *fp)
0a753a76 2585{
390b85e7 2586 return (feof(fp));
0a753a76
PP
2587}
2588
e85fa3eb 2589#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
cd6a3131 2590extern int convert_errno_to_wsa_error(int err); /* in win32sck.c */
e85fa3eb 2591#endif
cd6a3131 2592
68dc0745 2593/*
3fadfdf1 2594 * Since the errors returned by the socket error function
68dc0745 2595 * WSAGetLastError() are not known by the library routine strerror
cd6a3131
SH
2596 * we have to roll our own to cover the case of socket errors
2597 * that could not be converted to regular errno values by
2598 * get_last_socket_error() in win32/win32sck.c.
68dc0745 2599 */
0a753a76 2600
68dc0745 2601DllExport char *
3fadfdf1 2602win32_strerror(int e)
0a753a76 2603{
378eeda7 2604#if !defined __MINGW32__ /* compiler intolerance */
68dc0745 2605 extern int sys_nerr;
3e3baf6d 2606#endif
0a753a76 2607
9404a519 2608 if (e < 0 || e > sys_nerr) {
9399a70c 2609 dTHXa(NULL);
9404a519 2610 if (e < 0)
68dc0745 2611 e = GetLastError();
e85fa3eb 2612#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
cd6a3131
SH
2613 /* VC10+ define a "POSIX supplement" of errno values ranging from
2614 * EADDRINUSE (100) to EWOULDBLOCK (140), but sys_nerr is still 43 and
2615 * strerror() returns "Unknown error" for them. We must therefore still
2616 * roll our own messages for these codes, and additionally map them to
2617 * corresponding Windows (sockets) error codes first to avoid getting
2618 * the wrong system message.
2619 */
2620 else if (e >= EADDRINUSE && e <= EWOULDBLOCK) {
2621 e = convert_errno_to_wsa_error(e);
2622 }
2623#endif
0a753a76 2624
9399a70c 2625 aTHXa(PERL_GET_THX);
364d54ba
JD
2626 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
2627 |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
2628 w32_strerror_buffer, sizeof(w32_strerror_buffer),
2629 NULL) == 0)
2630 {
3352bfcb 2631 strcpy(w32_strerror_buffer, "Unknown Error");
364d54ba 2632 }
3352bfcb 2633 return w32_strerror_buffer;
68dc0745 2634 }
364d54ba 2635#undef strerror
390b85e7 2636 return strerror(e);
364d54ba 2637#define strerror win32_strerror
0a753a76
PP
2638}
2639
22fae026 2640DllExport void
c5be433b 2641win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM
2642{
2643 DWORD dwLen;
2644 char *sMsg;
2645 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
2646 |FORMAT_MESSAGE_IGNORE_INSERTS
2647 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2648 dwErr, 0, (char *)&sMsg, 1, NULL);
2ce77adf 2649 /* strip trailing whitespace and period */
22fae026 2650 if (0 < dwLen) {
2ce77adf
GS
2651 do {
2652 --dwLen; /* dwLen doesn't include trailing null */
2653 } while (0 < dwLen && isSPACE(sMsg[dwLen]));
22fae026
TM
2654 if ('.' != sMsg[dwLen])
2655 dwLen++;
2ce77adf 2656 sMsg[dwLen] = '\0';
22fae026
TM
2657 }
2658 if (0 == dwLen) {
c69f6586 2659 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
db7c17d7
GS
2660 if (sMsg)
2661 dwLen = sprintf(sMsg,
2662 "Unknown error #0x%lX (lookup 0x%lX)",
2663 dwErr, GetLastError());
2664 }
2665 if (sMsg) {
acfe0abc 2666 dTHX;
db7c17d7
GS
2667 sv_setpvn((SV*)sv, sMsg, dwLen);
2668 LocalFree(sMsg);
22fae026 2669 }
22fae026
TM
2670}
2671
68dc0745
PP
2672DllExport int
2673win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 2674{
68dc0745
PP
2675 va_list marker;
2676 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2677
390b85e7 2678 return (vfprintf(fp, format, marker));
0a753a76
PP
2679}
2680
68dc0745
PP
2681DllExport int
2682win32_printf(const char *format, ...)
0a753a76 2683{
68dc0745
PP
2684 va_list marker;
2685 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2686
390b85e7 2687 return (vprintf(format, marker));
0a753a76
PP
2688}
2689
68dc0745
PP
2690DllExport int
2691win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 2692{
390b85e7 2693 return (vfprintf(fp, format, args));
0a753a76
PP
2694}
2695
96e4d5b1
PP
2696DllExport int
2697win32_vprintf(const char *format, va_list args)
2698{
390b85e7 2699 return (vprintf(format, args));
96e4d5b1
PP
2700}
2701
68dc0745
PP
2702DllExport size_t
2703win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2704{
390b85e7 2705 return fread(buf, size, count, fp);
0a753a76
PP
2706}
2707
68dc0745
PP
2708DllExport size_t
2709win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2710{
390b85e7 2711 return fwrite(buf, size, count, fp);
0a753a76
PP
2712}
2713
7fac1903
GS
2714#define MODE_SIZE 10
2715
68dc0745
PP
2716DllExport FILE *
2717win32_fopen(const char *filename, const char *mode)
0a753a76 2718{
04a2c3d9 2719 dTHXa(NULL);
1c5905c2 2720 FILE *f;
3fadfdf1 2721
c5be433b
GS
2722 if (!*filename)
2723 return NULL;
2724
68dc0745 2725 if (stricmp(filename, "/dev/null")==0)
7fac1903
GS
2726 filename = "NUL";
2727
04a2c3d9 2728 aTHXa(PERL_GET_THX);
8c56068e 2729 f = fopen(PerlDir_mapA(filename), mode);
1c5905c2
GS
2730 /* avoid buffering headaches for child processes */
2731 if (f && *mode == 'a')
2732 win32_fseek(f, 0, SEEK_END);
2733 return f;
0a753a76
PP
2734}
2735
68dc0745 2736DllExport FILE *
7fac1903 2737win32_fdopen(int handle, const char *mode)
0a753a76 2738{
1c5905c2 2739 FILE *f;
8c56068e 2740 f = fdopen(handle, (char *) mode);
1c5905c2
GS
2741 /* avoid buffering headaches for child processes */
2742 if (f && *mode == 'a')
2743 win32_fseek(f, 0, SEEK_END);
2744 return f;
0a753a76
PP
2745}
2746
68dc0745 2747DllExport FILE *
7fac1903 2748win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 2749{
04a2c3d9 2750 dTHXa(NULL);
68dc0745 2751 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
2752 path = "NUL";
2753
04a2c3d9 2754 aTHXa(PERL_GET_THX);
7766f137 2755 return freopen(PerlDir_mapA(path), mode, stream);
0a753a76
PP
2756}
2757
68dc0745
PP
2758DllExport int
2759win32_fclose(FILE *pf)
0a753a76 2760{
19253ae6
DD
2761#ifdef WIN32_NO_SOCKETS
2762 return fclose(pf);
2763#else
f3986ebb 2764 return my_fclose(pf); /* defined in win32sck.c */
19253ae6 2765#endif
0a753a76
PP
2766}
2767
68dc0745
PP
2768DllExport int
2769win32_fputs(const char *s,FILE *pf)
0a753a76 2770{
390b85e7 2771 return fputs(s, pf);
0a753a76
PP
2772}
2773
68dc0745
PP
2774DllExport int
2775win32_fputc(int c,FILE *pf)
0a753a76 2776{
390b85e7 2777 return fputc(c,pf);
0a753a76
PP
2778}
2779
68dc0745
PP
2780DllExport int
2781win32_ungetc(int c,FILE *pf)
0a753a76 2782{
390b85e7 2783 return ungetc(c,pf);
0a753a76
PP
2784}
2785
68dc0745
PP
2786DllExport int
2787win32_getc(FILE *pf)
0a753a76 2788{
390b85e7 2789 return getc(pf);
0a753a76
PP
2790}
2791
68dc0745
PP
2792DllExport int
2793win32_fileno(FILE *pf)
0a753a76 2794{
390b85e7 2795 return fileno(pf);
0a753a76
PP
2796}
2797
68dc0745
PP
2798DllExport void
2799win32_clearerr(FILE *pf)
0a753a76 2800{
390b85e7 2801 clearerr(pf);
68dc0745 2802 return;
0a753a76
PP
2803}
2804
68dc0745
PP
2805DllExport int
2806win32_fflush(FILE *pf)
0a753a76 2807{
390b85e7 2808 return fflush(pf);
0a753a76
PP
2809}
2810
c623ac67 2811DllExport Off_t
68dc0745 2812win32_ftell(FILE *pf)
0a753a76 2813{
c623ac67
GS
2814#if defined(WIN64) || defined(USE_LARGE_FILES)
2815 fpos_t pos;
2816 if (fgetpos(pf, &pos))
2817 return -1;
2818 return (Off_t)pos;
2819#else
390b85e7 2820 return ftell(pf);
c623ac67 2821#endif
0a753a76
PP
2822}
2823
68dc0745 2824DllExport int
c623ac67 2825win32_fseek(FILE *pf, Off_t offset,int origin)
0a753a76 2826{
c623ac67
GS
2827#if defined(WIN64) || defined(USE_LARGE_FILES)
2828 fpos_t pos;
2829 switch (origin) {
2830 case SEEK_CUR:
2831 if (fgetpos(pf, &pos))
2832 return -1;
2833 offset += pos;
2834 break;
2835 case SEEK_END:
2836 fseek(pf, 0, SEEK_END);
2837 pos = _telli64(fileno(pf));
2838 offset += pos;
2839 break;
2840 case SEEK_SET:
2841 break;
2842 default:
2843 errno = EINVAL;
2844 return -1;
2845 }
2846 return fsetpos(pf, &offset);
2847#else
8859a7a0 2848 return fseek(pf, (long)offset, origin);
c623ac67 2849#endif
0a753a76
PP
2850}
2851
68dc0745
PP
2852DllExport int
2853win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 2854{
390b85e7 2855 return fgetpos(pf, p);
0a753a76
PP
2856}
2857
68dc0745
PP
2858DllExport int
2859win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 2860{
390b85e7 2861 return fsetpos(pf, p);
0a753a76
PP
2862}
2863
68dc0745
PP
2864DllExport void
2865win32_rewind(FILE *pf)
0a753a76 2866{
390b85e7 2867 rewind(pf);
68dc0745 2868 return;
0a753a76
PP
2869}
2870
2941a2e1
JH
2871DllExport int
2872win32_tmpfd(void)
0a753a76 2873{
b3122bc4
JH
2874 char prefix[MAX_PATH+1];
2875 char filename[MAX_PATH+1];
2876 DWORD len = GetTempPath(MAX_PATH, prefix);
2877 if (len && len < MAX_PATH) {
2878 if (GetTempFileName(prefix, "plx", 0, filename)) {
2879 HANDLE fh = CreateFile(filename,
2880 DELETE | GENERIC_READ | GENERIC_WRITE,
2881 0,
2882 NULL,
2883 CREATE_ALWAYS,
2884 FILE_ATTRIBUTE_NORMAL
2885 | FILE_FLAG_DELETE_ON_CLOSE,
2886 NULL);
2887 if (fh != INVALID_HANDLE_VALUE) {
c623ac67 2888 int fd = win32_open_osfhandle((intptr_t)fh, 0);
b3122bc4 2889 if (fd >= 0) {
2b01189b 2890 PERL_DEB(dTHX;)
b3122bc4
JH
2891 DEBUG_p(PerlIO_printf(Perl_debug_log,
2892 "Created tmpfile=%s\n",filename));
2941a2e1 2893 return fd;
b3122bc4
JH
2894 }
2895 }
2896 }
2897 }
2941a2e1
JH
2898 return -1;
2899}
2900
2901DllExport FILE*
2902win32_tmpfile(void)
2903{
2904 int fd = win32_tmpfd();
2905 if (fd >= 0)
2906 return win32_fdopen(fd, "w+b");
b3122bc4 2907 return NULL;
0a753a76
PP
2908}
2909
68dc0745
PP
2910DllExport void
2911win32_abort(void)
0a753a76 2912{
390b85e7 2913 abort();
68dc0745 2914 return;
0a753a76
PP
2915}
2916
68dc0745 2917DllExport int
c623ac67 2918win32_fstat(int fd, Stat_t *sbufptr)
0a753a76 2919{
378eeda7 2920#if defined(WIN64) || defined(USE_LARGE_FILES)
8cbe99e5 2921 return _fstati64(fd, sbufptr);
378eeda7 2922#else
8cbe99e5 2923 return fstat(fd, sbufptr);
2a07f407 2924#endif
0a753a76
PP
2925}
2926
68dc0745
PP
2927DllExport int
2928win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 2929{
390b85e7 2930 return _pipe(pfd, size, mode);
0a753a76
PP
2931}
2932
8c0134a8
NIS
2933DllExport PerlIO*
2934win32_popenlist(const char *mode, IV narg, SV **args)
2935{
073dd035 2936 Perl_croak_nocontext("List form of pipe open not implemented");
8c0134a8
NIS
2937 return NULL;
2938}
2939
50892819
GS
2940/*
2941 * a popen() clone that respects PERL5SHELL
00b02797
JH
2942 *
2943 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
50892819
GS
2944 */
2945
00b02797 2946DllExport PerlIO*
68dc0745 2947win32_popen(const char *command, const char *mode)
0a753a76 2948{
4b556e6c 2949#ifdef USE_RTL_POPEN
390b85e7 2950 return _popen(command, mode);
50892819
GS
2951#else
2952 int p[2];
2953 int parent, child;
2954 int stdfd, oldfd;
2955 int ourmode;
2956 int childpid;
1095be37
GS
2957 DWORD nhandle;
2958 HANDLE old_h;
2959 int lock_held = 0;
50892819
GS
2960
2961 /* establish which ends read and write */
2962 if (strchr(mode,'w')) {
2963 stdfd = 0; /* stdin */
2964 parent = 1;
2965 child = 0;
1095be37 2966 nhandle = STD_INPUT_HANDLE;
50892819
GS
2967 }
2968 else if (strchr(mode,'r')) {
2969 stdfd = 1; /* stdout */
2970 parent = 0;
2971 child = 1;
1095be37 2972 nhandle = STD_OUTPUT_HANDLE;
50892819
GS
2973 }
2974 else
2975 return NULL;
2976
2977 /* set the correct mode */
2978 if (strchr(mode,'b'))
2979 ourmode = O_BINARY;
2980 else if (strchr(mode,'t'))
2981 ourmode = O_TEXT;
2982 else
2983 ourmode = _fmode & (O_TEXT | O_BINARY);
2984
2985 /* the child doesn't inherit handles */
2986 ourmode |= O_NOINHERIT;
2987
1095be37 2988 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS
2989 return NULL;
2990
498d7dc4
GS
2991 /* save the old std handle (this needs to happen before the
2992 * dup2(), since that might call SetStdHandle() too) */
2993 OP_REFCNT_LOCK;
2994 lock_held = 1;
2995 old_h = GetStdHandle(nhandle);
2996
564914cd
AS
2997 /* save current stdfd */
2998 if ((oldfd = win32_dup(stdfd)) == -1)
2999 goto cleanup;
3000
50892819
GS
3001 /* make stdfd go to child end of pipe (implicitly closes stdfd) */
3002 /* stdfd will be inherited by the child */
3003 if (win32_dup2(p[child], stdfd) == -1)
3004 goto cleanup;
3005
3006 /* close the child end in parent */
3007 win32_close(p[child]);
3008
498d7dc4 3009 /* set the new std handle (in case dup2() above didn't) */
1095be37
GS
3010 SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
3011
50892819 3012 /* start the child */
4f63d024 3013 {
acfe0abc 3014 dTHX;
c5be433b 3015 if ((childpid = do_spawn_nowait((char*)command)) == -1)
4f63d024 3016 goto cleanup;
50892819 3017
498d7dc4
GS
3018 /* revert stdfd to whatever it was before */
3019 if (win32_dup2(oldfd, stdfd) == -1)
3020 goto cleanup;
3021
564914cd
AS
3022 /* close saved handle */
3023 win32_close(oldfd);
3024
498d7dc4
GS
3025 /* restore the old std handle (this needs to happen after the
3026 * dup2(), since that might call SetStdHandle() too */
1095be37
GS
3027 if (lock_held) {
3028 SetStdHandle(nhandle, old_h);
3029 OP_REFCNT_UNLOCK;
3030 lock_held = 0;
3031 }
3032
4f63d024 3033 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1
R
3034
3035 /* set process id so that it can be returned by perl's open() */
3036 PL_forkprocess = childpid;
4f63d024 3037 }
50892819
GS
3038
3039 /* we have an fd, return a file stream */
00b02797 3040 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS
3041
3042cleanup:
3043 /* we don't need to check for errors here */
3044 win32_close(p[0]);
3045 win32_close(p[1]);
564914cd
AS
3046 if (oldfd != -1) {
3047 win32_dup2(oldfd, stdfd);
3048 win32_close(oldfd);
3049 }
1095be37
GS
3050 if (lock_held) {
3051 SetStdHandle(nhandle, old_h);
3052 OP_REFCNT_UNLOCK;
3053 lock_held = 0;
3054 }
50892819
GS
3055 return (NULL);
3056
4b556e6c 3057#endif /* USE_RTL_POPEN */
0a753a76
PP
3058}
3059
50892819
GS
3060/*
3061 * pclose() clone
3062 */
3063
68dc0745 3064DllExport int
00b02797 3065win32_pclose(PerlIO *pf)
0a753a76 3066{
4b556e6c 3067#ifdef USE_RTL_POPEN
390b85e7 3068 return _pclose(pf);
50892819 3069#else
acfe0abc 3070 dTHX;
e17cb2a9
JD
3071 int childpid, status;
3072 SV *sv;
3073
00b02797 3074 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3075
e17cb2a9
JD
3076 if (SvIOK(sv))
3077 childpid = SvIVX(sv);
3078 else
3079 childpid = 0;
50892819
GS
3080
3081 if (!childpid) {
3082 errno = EBADF;
3083 return -1;
3084 }
3085
00b02797
JH
3086#ifdef USE_PERLIO
3087 PerlIO_close(pf);
3088#else
3089 fclose(pf);
3090#endif
e17cb2a9
JD
3091 SvIVX(sv) = 0;
3092
0aaad0ff
GS
3093 if (win32_waitpid(childpid, &status, 0) == -1)
3094 return -1;
50892819 3095
0aaad0ff 3096 return status;
50892819 3097
4b556e6c 3098#endif /* USE_RTL_POPEN */
0a753a76 3099}
6b980173 3100
6b980173
JD
3101DllExport int
3102win32_link(const char *oldname, const char *newname)
3103{
04a2c3d9 3104 dTHXa(NULL);
82867ecf
GS
3105 WCHAR wOldName[MAX_PATH+1];
3106 WCHAR wNewName[MAX_PATH+1];
6b980173 3107
8c56068e
JD
3108 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3109 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
04a2c3d9 3110 ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
8cbe99e5 3111 CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173
JD
3112 {
3113 return 0;
3114 }
2b42d7ed
TC
3115 /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for
3116 both permissions errors and if the source is a directory, while
3117 POSIX wants EACCES and EPERM respectively.
3118
3119 Determined by experimentation on Windows 7 x64 SP1, since MS
3120 don't document what error codes are returned.
3121 */
3122 switch (GetLastError()) {
3123 case ERROR_BAD_NET_NAME:
3124 case ERROR_BAD_NETPATH:
3125 case ERROR_BAD_PATHNAME:
3126 case ERROR_FILE_NOT_FOUND:
3127 case ERROR_FILENAME_EXCED_RANGE:
3128 case ERROR_INVALID_DRIVE:
3129 case ERROR_PATH_NOT_FOUND:
3130 errno = ENOENT;
3131 break;
3132 case ERROR_ALREADY_EXISTS:
3133 errno = EEXIST;
3134 break;
3135 case ERROR_ACCESS_DENIED:
3136 errno = EACCES;
3137 break;
3138 case ERROR_NOT_SAME_DEVICE:
3139 errno = EXDEV;
3140 break;
e41416c3
CM
3141 case ERROR_DISK_FULL:
3142 errno = ENOSPC;
3143 break;
3144 case ERROR_NOT_ENOUGH_QUOTA:
3145 errno = EDQUOT;
3146 break;
2b42d7ed
TC
3147 default:
3148 /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */
3149 errno = EINVAL;
3150 break;
3151 }
6b980173
JD
3152 return -1;
3153}
0a753a76 3154
68dc0745 3155DllExport int
8d9b2e3c 3156win32_rename(const char *oname, const char *newname)
e24c7c18 3157{
65cb15a1 3158 char szOldName[MAX_PATH+1];
7fac1903 3159 BOOL bResult;
8cbe99e5 3160 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
acfe0abc 3161 dTHX;
65cb15a1 3162
8cbe99e5
JD
3163 if (stricmp(newname, oname))
3164 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3165 strcpy(szOldName, PerlDir_mapA(oname));
3166
3167 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3168 if (!bResult) {
3169 DWORD err = GetLastError();
3170 switch (err) {
3171 case ERROR_BAD_NET_NAME:
3172 case ERROR_BAD_NETPATH:
3173 case ERROR_BAD_PATHNAME:
3174 case ERROR_FILE_NOT_FOUND:
3175 case ERROR_FILENAME_EXCED_RANGE:
3176 case ERROR_INVALID_DRIVE:
3177 case ERROR_NO_MORE_FILES:
3178 case ERROR_PATH_NOT_FOUND:
3179 errno = ENOENT;
3180 break;
e41416c3
CM
3181 case ERROR_DISK_FULL:
3182 errno = ENOSPC;
3183 break;
3184 case ERROR_NOT_ENOUGH_QUOTA:
3185 errno = EDQUOT;
3186 break;
8cbe99e5
JD
3187 default:
3188 errno = EACCES;
3189 break;
3190 }
3191 return -1;
e24c7c18 3192 }
8cbe99e5 3193 return 0;
e24c7c18
GS
3194}
3195
3196DllExport int
68dc0745 3197win32_setmode(int fd, int mode)
0a753a76 3198{
390b85e7 3199 return setmode(fd, mode);
0a753a76
PP
3200}
3201
4a9d6100
GS
3202DllExport int
3203win32_chsize(int fd, Off_t size)
3204{
3205#if defined(WIN64) || defined(USE_LARGE_FILES)
3206 int retval = 0;
3207 Off_t cur, end, extend;
3208
3209 cur = win32_tell(fd);
3210 if (cur < 0)
3211 return -1;
3212 end = win32_lseek(fd, 0, SEEK_END);
3213 if (end < 0)
3214 return -1;
3215 extend = size - end;
3216 if (extend == 0) {
3217 /* do nothing */
3218 }
3219 else if (extend > 0) {
3220 /* must grow the file, padding with nulls */
3221 char b[4096];
3222 int oldmode = win32_setmode(fd, O_BINARY);
3223 size_t count;
3224 memset(b, '\0', sizeof(b));
3225 do {
3226 count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3227 count = win32_write(fd, b, count);
21424390 3228 if ((int)count < 0) {
4a9d6100
GS
3229 retval = -1;
3230 break;
3231 }
3232 } while ((extend -= count) > 0);
3233 win32_setmode(fd, oldmode);
3234 }
3235 else {
3236 /* shrink the file */
3237 win32_lseek(fd, size, SEEK_SET);
3238 if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3239 errno = EACCES;
3240 retval = -1;
3241 }
3242 }
3243finish:
3244 win32_lseek(fd, cur, SEEK_SET);
3245 return retval;
3246#else
8859a7a0 3247 return chsize(fd, (long)size);
4a9d6100
GS
3248#endif
3249}
3250
c623ac67
GS
3251DllExport Off_t
3252win32_lseek(int fd, Off_t offset, int origin)
96e4d5b1 3253{
c623ac67
GS
3254#if defined(WIN64) || defined(USE_LARGE_FILES)
3255 return _lseeki64(fd, offset, origin);
3256#else
8859a7a0 3257 return lseek(fd, (long)offset, origin);
c623ac67 3258#endif
96e4d5b1
PP
3259}
3260
c623ac67 3261DllExport Off_t
96e4d5b1
PP
3262win32_tell(int fd)
3263{
c623ac67
GS
3264#if defined(WIN64) || defined(USE_LARGE_FILES)
3265 return _telli64(fd);
3266#else
390b85e7 3267 return tell(fd);
c623ac67 3268#endif
96e4d5b1
PP
3269}
3270
68dc0745
PP
3271DllExport int
3272win32_open(const char *path, int flag, ...)
0a753a76 3273{
04a2c3d9 3274 dTHXa(NULL);
68dc0745
PP
3275 va_list ap;
3276 int pmode;
0a753a76
PP
3277
3278 va_start(ap, flag);
3279 pmode = va_arg(ap, int);
3280 va_end(ap);
3281
68dc0745 3282 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
3283 path = "NUL";
3284
04a2c3d9 3285 aTHXa(PERL_GET_THX);
7766f137 3286 return open(PerlDir_mapA(path), flag, pmode);
0a753a76
PP
3287}
3288
00b02797
JH
3289/* close() that understands socket */
3290extern int my_close(int); /* in win32sck.c */
3291
68dc0745
PP
3292DllExport int
3293win32_close(int fd)
0a753a76 3294{
19253ae6
DD
3295#ifdef WIN32_NO_SOCKETS
3296 return close(fd);
3297#else
00b02797 3298 return my_close(fd);
19253ae6 3299#endif
0a753a76
PP
3300}
3301
68dc0745 3302DllExport int
96e4d5b1
PP
3303win32_eof(int fd)
3304{
390b85e7 3305 return eof(fd);
96e4d5b1
PP
3306}
3307
3308DllExport int
4342f4d6
JD
3309win32_isatty(int fd)
3310{
3311 /* The Microsoft isatty() function returns true for *all*
3312 * character mode devices, including "nul". Our implementation
3313 * should only return true if the handle has a console buffer.
3314 */
3315 DWORD mode;
3316 HANDLE fh = (HANDLE)_get_osfhandle(fd);
3317 if (fh == (HANDLE)-1) {
3318 /* errno is already set to EBADF */
3319 return 0;
3320 }
3321
3322 if (GetConsoleMode(fh, &mode))
3323 return 1;
3324
3325 errno = ENOTTY;
3326 return 0;
3327}
3328
3329DllExport int
68dc0745 3330win32_dup(int fd)
0a753a76 3331{
390b85e7 3332 return dup(fd);
0a753a76
PP
3333}
3334
68dc0745
PP
3335DllExport int
3336win32_dup2(int fd1,int fd2)
0a753a76 3337{
390b85e7 3338 return dup2(fd1,fd2);
0a753a76
PP
3339}
3340
68dc0745 3341DllExport int
3e3baf6d 3342win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 3343{
390b85e7 3344 return read(fd, buf, cnt);
0a753a76
PP
3345}
3346
68dc0745 3347DllExport int
3e3baf6d 3348win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 3349{
390b85e7 3350 return write(fd, buf, cnt);
0a753a76
PP
3351}
3352
68dc0745 3353DllExport int
5aabfad6
PP
3354win32_mkdir(const char *dir, int mode)
3355{
acfe0abc 3356 dTHX;
7766f137 3357 return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
5aabfad6 3358}
96e4d5b1 3359
5aabfad6
PP
3360DllExport int
3361win32_rmdir(const char *dir)
3362{
acfe0abc 3363 dTHX;
7766f137 3364 return rmdir(PerlDir_mapA(dir));
5aabfad6 3365}
96e4d5b1 3366
5aabfad6
PP
3367DllExport int
3368win32_chdir(const char *dir)
3369{
9ec3348a
JH
3370 if (!dir) {
3371 errno = ENOENT;
3372 return -1;
3373 }
390b85e7 3374 return chdir(dir);
5aabfad6 3375}
96e4d5b1 3376
7766f137
GS
3377DllExport int
3378win32_access(const char *path, int mode)
3379{
acfe0abc 3380 dTHX;
7766f137
GS
3381 return access(PerlDir_mapA(path), mode);
3382}
3383
3384DllExport int
3385win32_chmod(const char *path, int mode)
3386{
acfe0abc 3387 dTHX;
7766f137
GS
3388 return chmod(PerlDir_mapA(path), mode);
3389}
3390
3391
0aaad0ff 3392static char *
dd7038b3 3393create_command_line(char *cname, STRLEN clen, const char * const *args)
0aaad0ff 3394{
2b01189b 3395 PERL_DEB(dTHX;)
b309b8ae
JH
3396 int index, argc;
3397 char *cmd, *ptr;
3398 const char *arg;
3399 STRLEN len = 0;
81bc1258 3400 bool bat_file = FALSE;
b309b8ae 3401 bool cmd_shell = FALSE;
7b11e424 3402 bool dumb_shell = FALSE;
b309b8ae 3403 bool extra_quotes = FALSE;
dd7038b3 3404 bool quote_next = FALSE;
81bc1258
JH
3405
3406 if (!cname)
3407 cname = (char*)args[0];
b309b8ae
JH
3408
3409 /* The NT cmd.exe shell has the following peculiarity that needs to be
3410 * worked around. It strips a leading and trailing dquote when any
3411 * of the following is true:
3412 * 1. the /S switch was used
3413 * 2. there are more than two dquotes
3414 * 3. there is a special character from this set: &<>()@^|
3415 * 4. no whitespace characters within the two dquotes
3416 * 5. string between two dquotes isn't an executable file
3417 * To work around this, we always add a leading and trailing dquote
3418 * to the string, if the first argument is either "cmd.exe" or "cmd",
3419 * and there were at least two or more arguments passed to cmd.exe
3420 * (not including switches).
dd7038b3
JH
3421 * XXX the above rules (from "cmd /?") don't seem to be applied
3422 * always, making for the convolutions below :-(
b309b8ae 3423 */
81bc1258 3424 if (cname) {
dd7038b3
JH
3425 if (!clen)
3426 clen = strlen(cname);
3427
81bc1258
JH
3428 if (clen > 4
3429 && (stricmp(&cname[clen-4], ".bat") == 0
8cbe99e5 3430 || (stricmp(&cname[clen-4], ".cmd") == 0)))
81bc1258
JH
3431 {
3432 bat_file = TRUE;
8cbe99e5 3433 len += 3;
81bc1258 3434 }
dd7038b3
JH
3435 else {
3436 char *exe = strrchr(cname, '/');
3437 char *exe2 = strrchr(cname, '\\');
3438 if (exe2 > exe)
3439 exe = exe2;
3440 if (exe)
3441 ++exe;
3442 else
3443 exe = cname;
3444 if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
3445 cmd_shell = TRUE;
3446 len += 3;
3447 }
7b11e424
JH
3448 else if (stricmp(exe, "command.com") == 0
3449 || stricmp(exe, "command") == 0)
3450 {
3451 dumb_shell = TRUE;
3452 }
81bc1258 3453 }
b309b8ae 3454 }
0aaad0ff 3455
b309b8ae
JH
3456 DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
3457 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3458 STRLEN curlen = strlen(arg);
3459 if (!(arg[0] == '"' && arg[curlen-1] == '"'))
3460 len += 2; /* assume quoting needed (worst case) */
3461 len += curlen + 1;
3462 DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
3463 }
3464 DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
0aaad0ff 3465
b309b8ae 3466 argc = index;
a02a5408 3467 Newx(cmd, len, char);
0aaad0ff 3468 ptr = cmd;
0aaad0ff 3469
8cbe99e5 3470 if (bat_file) {
81bc1258
JH
3471 *ptr++ = '"';
3472 extra_quotes = TRUE;
3473 }
3474
0aaad0ff 3475 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
b309b8ae
JH
3476 bool do_quote = 0;
3477 STRLEN curlen = strlen(arg);
3478
81bc1258
JH
3479 /* we want to protect empty arguments and ones with spaces with
3480 * dquotes, but only if they aren't already there */
7b11e424
JH
3481 if (!dumb_shell) {
3482 if (!curlen) {
3483 do_quote = 1;
3484 }
02ef22d5
JH
3485 else if (quote_next) {
3486 /* see if it really is multiple arguments pretending to
3487 * be one and force a set of quotes around it */
3488 if (*find_next_space(arg))
3489 do_quote = 1;
3490 }
7b11e424
JH
3491 else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
3492 STRLEN i = 0;
3493 while (i < curlen) {
3494 if (isSPACE(arg[i])) {
3495 do_quote = 1;
02ef22d5
JH
3496 }
3497 else if (arg[i] == '"') {
3498 do_quote = 0;
7b11e424
JH
3499 break;
3500 }
3501 i++;
b309b8ae 3502 }
b309b8ae 3503 }
dd7038b3 3504 }
b309b8ae
JH
3505
3506 if (do_quote)
3507 *ptr++ = '"';
3508
18a945d4 3509 strcpy(ptr, arg);
b309b8ae
JH
3510 ptr += curlen;
3511
3512 if (do_quote)
3513 *ptr++ = '"';
3514
3515 if (args[index+1])
3516 *ptr++ = ' ';
3517
81bc1258
JH
3518 if (!extra_quotes
3519 && cmd_shell
11998fdb
GS
3520 && curlen >= 2
3521 && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
3522 && stricmp(arg+curlen-2, "/c") == 0)
b309b8ae 3523 {
dd7038b3
JH
3524 /* is there a next argument? */
3525 if (args[index+1]) {
3526 /* are there two or more next arguments? */
3527 if (args[index+2]) {
3528 *ptr++ = '"';
3529 extra_quotes = TRUE;
3530 }
3531 else {
02ef22d5 3532 /* single argument, force quoting if it has spaces */
dd7038b3
JH
3533 quote_next = TRUE;
3534 }
3535 }
b309b8ae 3536 }
0aaad0ff
GS
3537 }
3538
b309b8ae
JH
3539 if (extra_quotes)
3540 *ptr++ = '"';
3541
3542 *ptr = '\0';
3543
0aaad0ff
GS
3544 return cmd;
3545}
3546
3547static char *
3548qualified_path(const char *cmd)
3549{
3550 char *pathstr;
3551 char *fullcmd, *curfullcmd;
3552 STRLEN cmdlen = 0;
3553 int has_slash = 0;
3554
3555 if (!cmd)
4e205ed6 3556 return NULL;
0aaad0ff
GS
3557 fullcmd = (char*)cmd;
3558 while (*fullcmd) {
3559 if (*fullcmd == '/' || *fullcmd == '\\')
3560 has_slash++;
3561 fullcmd++;
3562 cmdlen++;
3563 }
3564
3565 /* look in PATH */
04a2c3d9
DD
3566 {
3567 dTHX;
3568 pathstr = PerlEnv_getenv("PATH");
3569 }
1928965c
JD
3570 /* worst case: PATH is a single directory; we need additional space
3571 * to append "/", ".exe" and trailing "\0" */
a02a5408 3572 Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
0aaad0ff
GS
3573 curfullcmd = fullcmd;
3574
3575 while (1) {
3576 DWORD res;
3577
3578 /* start by appending