This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove sources of "unreferenced label" warning on Win32
[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
97cb92d6 45#if !defined(PERLIO_IS_STDIO)
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);
f06c8825
TC
135static int do_spawn2_handles(pTHX_ const char *cmd, int exectype,
136 const int *handles);
137static int do_spawnvp_handles(int mode, const char *cmdname,
138 const char * const *argv, const int *handles);
aac983ac
TC
139static PerlIO * do_popen(const char *mode, const char *command, IV narg,
140 SV **args);
04a2c3d9 141static long find_pid(pTHX_ int pid);
e2cd629f
SH
142static void remove_dead_process(long child);
143static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
721b2674 144static int my_killpg(int pid, int sig);
e2cd629f
SH
145static int my_kill(int pid, int sig);
146static void out_of_memory(void);
00a0ae28 147static char* wstr_to_str(const wchar_t* wstr);
e2cd629f
SH
148static long filetime_to_clock(PFILETIME ft);
149static BOOL filetime_from_time(PFILETIME ft, time_t t);
150static char* create_command_line(char *cname, STRLEN clen,
aac983ac 151 const char * const *args);
e2cd629f
SH
152static char* qualified_path(const char *cmd);
153static void ansify_path(void);
154static LRESULT win32_process_message(HWND hwnd, UINT msg,
155 WPARAM wParam, LPARAM lParam);
156
157#ifdef USE_ITHREADS
04a2c3d9 158static long find_pseudo_pid(pTHX_ int pid);
e2cd629f
SH
159static void remove_dead_pseudo_process(long child);
160static HWND get_hwnd_delay(pTHX, long child, DWORD tries);
161#endif
162
163#ifdef HAVE_INTERP_INTERN
164static void win32_csighandler(int sig);
165#endif
166
167START_EXTERN_C
168HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
169char w32_module_name[MAX_PATH+1];
b47a847f
DD
170#ifdef WIN32_DYN_IOINFO_SIZE
171Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
172#endif
e2cd629f
SH
173END_EXTERN_C
174
175static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
176
177#ifdef SET_INVALID_PARAMETER_HANDLER
d52ca586
SH
178static BOOL silent_invalid_parameter_handler = FALSE;
179
180static BOOL
181set_silent_invalid_parameter_handler(BOOL newvalue)
182{
d52ca586 183 BOOL oldvalue = silent_invalid_parameter_handler;
adb86be5 184# ifdef _DEBUG
d52ca586 185 silent_invalid_parameter_handler = newvalue;
d52ca586 186# endif
adb86be5 187 return oldvalue;
d52ca586
SH
188}
189
e2cd629f
SH
190static void
191my_invalid_parameter_handler(const wchar_t* expression,
0448a0bd
SH
192 const wchar_t* function,
193 const wchar_t* file,
194 unsigned int line,
195 uintptr_t pReserved)
196{
197# ifdef _DEBUG
00a0ae28
SH
198 char* ansi_expression;
199 char* ansi_function;
200 char* ansi_file;
d52ca586
SH
201 if (silent_invalid_parameter_handler)
202 return;
00a0ae28
SH
203 ansi_expression = wstr_to_str(expression);
204 ansi_function = wstr_to_str(function);
205 ansi_file = wstr_to_str(file);
206 fprintf(stderr, "Invalid parameter detected in function %s. "
207 "File: %s, line: %d\n", ansi_function, ansi_file, line);
208 fprintf(stderr, "Expression: %s\n", ansi_expression);
209 free(ansi_expression);
210 free(ansi_function);
211 free(ansi_file);
0448a0bd
SH
212# endif
213}
214#endif
215
2fa86c13
GS
216EXTERN_C void
217set_w32_module_name(void)
218{
aa2b96ec 219 /* this function may be called at DLL_PROCESS_ATTACH time */
2fa86c13 220 char* ptr;
aa2b96ec
JD
221 HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
222 ? GetModuleHandle(NULL)
223 : w32_perldll_handle);
2fa86c13 224
0e7b7035
SH
225 WCHAR modulename[MAX_PATH];
226 WCHAR fullname[MAX_PATH];
227 char *ansi;
228
229 DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
230 (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
231 GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
232
233 GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
234
235 /* Make sure we get an absolute pathname in case the module was loaded
236 * explicitly by LoadLibrary() with a relative path. */
237 GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
238
239 /* Make sure we start with the long path name of the module because we
240 * later scan for pathname components to match "5.xx" to locate
241 * compatible sitelib directories, and the short pathname might mangle
242 * this path segment (e.g. by removing the dot on NTFS to something
243 * like "5xx~1.yy") */
244 if (pfnGetLongPathNameW)
245 pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
246
247 /* remove \\?\ prefix */
248 if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
249 memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
250
251 ansi = win32_ansipath(fullname);
252 my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
253 win32_free(ansi);
2fa86c13
GS
254
255 /* normalize to forward slashes */
256 ptr = w32_module_name;
257 while (*ptr) {
258 if (*ptr == '\\')
259 *ptr = '/';
260 ++ptr;
261 }
262}
263
c5be433b 264/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 265static char*
c5be433b 266get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
349ad1fe
GS
267{
268 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
00dc2f4f
GS
269 HKEY handle;
270 DWORD type;
271 const char *subkey = "Software\\Perl";
4e205ed6 272 char *str = NULL;
00dc2f4f
GS
273 long retval;
274
275 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
349ad1fe 276 if (retval == ERROR_SUCCESS) {
51371543
GS
277 DWORD datalen;
278 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
1c94caf4
GS
279 if (retval == ERROR_SUCCESS
280 && (type == REG_SZ || type == REG_EXPAND_SZ))
281 {
acfe0abc 282 dTHX;
c5be433b 283 if (!*svp)
c2b90b61 284 *svp = sv_2mortal(newSVpvs(""));
c5be433b 285 SvGROW(*svp, datalen);
51371543 286 retval = RegQueryValueEx(handle, valuename, 0, NULL,
c5be433b 287 (PBYTE)SvPVX(*svp), &datalen);
51371543 288 if (retval == ERROR_SUCCESS) {
c5be433b
GS
289 str = SvPVX(*svp);
290 SvCUR_set(*svp,datalen-1);
51371543 291 }
00dc2f4f
GS
292 }
293 RegCloseKey(handle);
294 }
349ad1fe 295 return str;
00dc2f4f
GS
296}
297
c5be433b 298/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 299static char*
c5be433b 300get_regstr(const char *valuename, SV **svp)
00dc2f4f 301{
c5be433b 302 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
349ad1fe 303 if (!str)
c5be433b 304 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
349ad1fe 305 return str;
00dc2f4f
GS
306}
307
c5be433b 308/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
e5a95ffb 309static char *
e6a0bbf8 310get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
00dc2f4f 311{
dc9e4912 312 char base[10];
e5a95ffb 313 va_list ap;
e24c7c18 314 char mod_name[MAX_PATH+1];
00dc2f4f 315 char *ptr;
e5a95ffb
GS
316 char *optr;
317 char *strip;
273cf8d1 318 STRLEN baselen;
e5a95ffb
GS
319
320 va_start(ap, trailing_path);
321 strip = va_arg(ap, char *);
322
273cf8d1
GS
323 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
324 baselen = strlen(base);
dc9e4912 325
8ac9c18d 326 if (!*w32_module_name) {
2fa86c13 327 set_w32_module_name();
95140b98 328 }
8ac9c18d 329 strcpy(mod_name, w32_module_name);
95140b98 330 ptr = strrchr(mod_name, '/');
e5a95ffb
GS
331 while (ptr && strip) {
332 /* look for directories to skip back */
333 optr = ptr;
00dc2f4f 334 *ptr = '\0';
95140b98 335 ptr = strrchr(mod_name, '/');
1c39adb2
GS
336 /* avoid stripping component if there is no slash,
337 * or it doesn't match ... */
e5a95ffb 338 if (!ptr || stricmp(ptr+1, strip) != 0) {
273cf8d1 339 /* ... but not if component matches m|5\.$patchlevel.*| */
1c39adb2 340 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
273cf8d1
GS
341 && strncmp(strip, base, baselen) == 0
342 && strncmp(ptr+1, base, baselen) == 0))
95140b98
GS
343 {
344 *optr = '/';
80252599
GS
345 ptr = optr;
346 }
00dc2f4f 347 }
e5a95ffb 348 strip = va_arg(ap, char *);
00dc2f4f 349 }
e5a95ffb
GS
350 if (!ptr) {
351 ptr = mod_name;
352 *ptr++ = '.';
95140b98 353 *ptr = '/';
00dc2f4f 354 }
e5a95ffb
GS
355 va_end(ap);
356 strcpy(++ptr, trailing_path);
357
dc9e4912 358 /* only add directory if it exists */
349ad1fe 359 if (GetFileAttributes(mod_name) != (DWORD) -1) {
dc9e4912 360 /* directory exists */
acfe0abc 361 dTHX;
c5be433b 362 if (!*prev_pathp)
c2b90b61 363 *prev_pathp = sv_2mortal(newSVpvs(""));
f0c8bec2 364 else if (SvPVX(*prev_pathp))
46e2868e 365 sv_catpvs(*prev_pathp, ";");
c5be433b 366 sv_catpv(*prev_pathp, mod_name);
e6a0bbf8
NC
367 if(len)
368 *len = SvCUR(*prev_pathp);
c5be433b 369 return SvPVX(*prev_pathp);
00dc2f4f 370 }
00dc2f4f 371
4e205ed6 372 return NULL;
00dc2f4f
GS
373}
374
73f2c082 375EXTERN_C char *
e6a0bbf8 376win32_get_privlib(const char *pl, STRLEN *const len)
00dc2f4f 377{
e5a95ffb
GS
378 char *stdlib = "lib";
379 char buffer[MAX_PATH+1];
4e205ed6 380 SV *sv = NULL;
00dc2f4f 381
e5a95ffb
GS
382 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
383 sprintf(buffer, "%s-%s", stdlib, pl);
c5be433b
GS
384 if (!get_regstr(buffer, &sv))
385 (void)get_regstr(stdlib, &sv);
00dc2f4f 386
e5a95ffb 387 /* $stdlib .= ";$EMD/../../lib" */
e6a0bbf8 388 return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
00dc2f4f
GS
389}
390
4ea817c6 391static char *
e6a0bbf8
NC
392win32_get_xlib(const char *pl, const char *xlib, const char *libname,
393 STRLEN *const len)
00dc2f4f 394{
e5a95ffb 395 char regstr[40];
e24c7c18 396 char pathstr[MAX_PATH+1];
4e205ed6
SP
397 SV *sv1 = NULL;
398 SV *sv2 = NULL;
00dc2f4f 399
4ea817c6
GS
400 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
401 sprintf(regstr, "%s-%s", xlib, pl);
c5be433b 402 (void)get_regstr(regstr, &sv1);
e5a95ffb 403
4ea817c6
GS
404 /* $xlib .=
405 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
406 sprintf(pathstr, "%s/%s/lib", libname, pl);
e6a0bbf8 407 (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
00dc2f4f 408
4ea817c6
GS
409 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
410 (void)get_regstr(xlib, &sv2);
00dc2f4f 411
4ea817c6
GS
412 /* $xlib .=
413 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
414 sprintf(pathstr, "%s/lib", libname);
e6a0bbf8 415 (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
e5a95ffb 416
51371543 417 if (!sv1 && !sv2)
4e205ed6 418 return NULL;
e6a0bbf8
NC
419 if (!sv1) {
420 sv1 = sv2;
421 } else if (sv2) {
04a2c3d9 422 dTHX;
46e2868e 423 sv_catpv(sv1, ";");
e6a0bbf8
NC
424 sv_catsv(sv1, sv2);
425 }
e5a95ffb 426
e6a0bbf8
NC
427 if (len)
428 *len = SvCUR(sv1);
349ad1fe 429 return SvPVX(sv1);
68dc0745 430}
0a753a76 431
73f2c082 432EXTERN_C char *
e6a0bbf8 433win32_get_sitelib(const char *pl, STRLEN *const len)
4ea817c6 434{
e6a0bbf8 435 return win32_get_xlib(pl, "sitelib", "site", len);
4ea817c6
GS
436}
437
438#ifndef PERL_VENDORLIB_NAME
439# define PERL_VENDORLIB_NAME "vendor"
440#endif
441
73f2c082 442EXTERN_C char *
e6a0bbf8 443win32_get_vendorlib(const char *pl, STRLEN *const len)
4ea817c6 444{
e6a0bbf8 445 return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
4ea817c6 446}
b4793f7f 447
2d7a9237 448static BOOL
08039b81 449has_shell_metachars(const char *ptr)
68dc0745
PP
450{
451 int inquote = 0;
452 char quote = '\0';
453
454 /*
455 * Scan string looking for redirection (< or >) or pipe
e200fe59
JD
456 * characters (|) that are not in a quoted string.
457 * Shell variable interpolation (%VAR%) can also happen inside strings.
68dc0745 458 */
9404a519 459 while (*ptr) {
68dc0745 460 switch(*ptr) {
e200fe59
JD
461 case '%':
462 return TRUE;
68dc0745
PP
463 case '\'':
464 case '\"':
9404a519
GS
465 if (inquote) {
466 if (quote == *ptr) {
68dc0745
PP
467 inquote = 0;
468 quote = '\0';
0a753a76 469 }
68dc0745
PP
470 }
471 else {
472 quote = *ptr;
473 inquote++;
474 }
475 break;
476 case '>':
477 case '<':
478 case '|':
9404a519 479 if (!inquote)
68dc0745
PP
480 return TRUE;
481 default:
482 break;
0a753a76 483 }
68dc0745
PP
484 ++ptr;
485 }
486 return FALSE;
0a753a76
PP
487}
488
32e30700 489#if !defined(PERL_IMPLICIT_SYS)
68dc0745
PP
490/* since the current process environment is being updated in util.c
491 * the library functions will get the correct environment
492 */
493PerlIO *
79d39d80 494Perl_my_popen(pTHX_ const char *cmd, const char *mode)
0a753a76 495{
45bc9206 496 PERL_FLUSHALL_FOR_CHILD;
0a753a76 497 return win32_popen(cmd, mode);
0a753a76
PP
498}
499
68dc0745 500long
4f63d024 501Perl_my_pclose(pTHX_ PerlIO *fp)
0a753a76
PP
502{
503 return win32_pclose(fp);
504}
c69f6586 505#endif
0a753a76 506
0cb96387
GS
507DllExport unsigned long
508win32_os_id(void)
0a753a76 509{
aeecf691 510 return (unsigned long)g_osver.dwPlatformId;
0a753a76
PP
511}
512
7766f137
GS
513DllExport int
514win32_getpid(void)
515{
516#ifdef USE_ITHREADS
acfe0abc 517 dTHX;
7766f137
GS
518 if (w32_pseudo_id)
519 return -((int)w32_pseudo_id);
520#endif
8cbe99e5 521 return _getpid();
7766f137
GS
522}
523
ce1da67e
GS
524/* Tokenize a string. Words are null-separated, and the list
525 * ends with a doubled null. Any character (except null and
526 * including backslash) may be escaped by preceding it with a
527 * backslash (the backslash will be stripped).
528 * Returns number of words in result buffer.
529 */
530static long
dff6d3cd 531tokenize(const char *str, char **dest, char ***destv)
ce1da67e 532{
4e205ed6 533 char *retstart = NULL;
ce1da67e
GS
534 char **retvstart = 0;
535 int items = -1;
536 if (str) {
537 int slen = strlen(str);
eb578fdb
KW
538 char *ret;
539 char **retv;
a02a5408
JC
540 Newx(ret, slen+2, char);
541 Newx(retv, (slen+3)/2, char*);
ce1da67e
GS
542
543 retstart = ret;
544 retvstart = retv;
545 *retv = ret;
546 items = 0;
547 while (*str) {
548 *ret = *str++;
549 if (*ret == '\\' && *str)
550 *ret = *str++;
551 else if (*ret == ' ') {
552 while (*str == ' ')
553 str++;
554 if (ret == retstart)
555 ret--;
556 else {
557 *ret = '\0';
558 ++items;
559 if (*str)
560 *++retv = ret+1;
561 }
562 }
563 else if (!*str)
564 ++items;
565 ret++;
566 }
4e205ed6 567 retvstart[items] = NULL;
ce1da67e
GS
568 *ret++ = '\0';
569 *ret = '\0';
570 }
571 *dest = retstart;
572 *destv = retvstart;
573 return items;
574}
575
576static void
2d7a9237 577get_shell(void)
0a753a76 578{
acfe0abc 579 dTHX;
ce1da67e 580 if (!w32_perlshell_tokens) {
174c211a
GS
581 /* we don't use COMSPEC here for two reasons:
582 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
583 * uncontrolled unportability of the ensuing scripts.
584 * 2. PERL5SHELL could be set to a shell that may not be fit for
585 * interactive use (which is what most programs look in COMSPEC
586 * for).
587 */
8cbe99e5 588 const char* defaultshell = "cmd.exe /x/d/c";
2fb9ab56 589 const char *usershell = PerlEnv_getenv("PERL5SHELL");
ce1da67e
GS
590 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
591 &w32_perlshell_tokens,
592 &w32_perlshell_vec);
68dc0745 593 }
0a753a76
PP
594}
595
68dc0745 596int
54725af6 597Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
0a753a76 598{
68dc0745 599 char **argv;
2d7a9237 600 char *str;
68dc0745 601 int status;
2d7a9237 602 int flag = P_WAIT;
68dc0745 603 int index = 0;
68dc0745 604
7918f24d
NC
605 PERL_ARGS_ASSERT_DO_ASPAWN;
606
2d7a9237
GS
607 if (sp <= mark)
608 return -1;
68dc0745 609
ce1da67e 610 get_shell();
a02a5408 611 Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS
612
613 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
614 ++mark;
615 flag = SvIVx(*mark);
68dc0745
PP
616 }
617
9404a519 618 while (++mark <= sp) {
bb897dfc 619 if (*mark && (str = SvPV_nolen(*mark)))
2d7a9237
GS
620 argv[index++] = str;
621 else
622 argv[index++] = "";
68dc0745
PP
623 }
624 argv[index++] = 0;
3fadfdf1 625
2d7a9237 626 status = win32_spawnvp(flag,
bb897dfc 627 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
628 (const char* const*)argv);
629
80252599 630 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
2d7a9237 631 /* possible shell-builtin, invoke with shell */
ce1da67e
GS
632 int sh_items;
633 sh_items = w32_perlshell_items;
2d7a9237
GS
634 while (--index >= 0)
635 argv[index+sh_items] = argv[index];
ce1da67e
GS
636 while (--sh_items >= 0)
637 argv[sh_items] = w32_perlshell_vec[sh_items];
3fadfdf1 638
2d7a9237 639 status = win32_spawnvp(flag,
bb897dfc 640 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
641 (const char* const*)argv);
642 }
68dc0745 643
922b1888 644 if (flag == P_NOWAIT) {
40c7cc6d 645 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS
646 }
647 else {
50892819 648 if (status < 0) {
0453d815 649 if (ckWARN(WARN_EXEC))
f98bc0c6 650 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
50892819
GS
651 status = 255 * 256;
652 }
653 else
654 status *= 256;
b28d0864 655 PL_statusvalue = status;
5aabfad6 656 }
ce1da67e 657 Safefree(argv);
50892819 658 return (status);
68dc0745
PP
659}
660
dd7038b3
JH
661/* returns pointer to the next unquoted space or the end of the string */
662static char*
663find_next_space(const char *s)
664{
665 bool in_quotes = FALSE;
666 while (*s) {
667 /* ignore doubled backslashes, or backslash+quote */
668 if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
669 s += 2;
670 }
671 /* keep track of when we're within quotes */
672 else if (*s == '"') {
673 s++;
674 in_quotes = !in_quotes;
675 }
676 /* break it up only at spaces that aren't in quotes */
677 else if (!in_quotes && isSPACE(*s))
678 return (char*)s;
679 else
680 s++;
681 }
682 return (char*)s;
683}
684
54725af6 685static int
f06c8825
TC
686do_spawn2(pTHX_ const char *cmd, int exectype) {
687 return do_spawn2_handles(aTHX_ cmd, exectype, NULL);
688}
689
690static int
691do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles)
68dc0745
PP
692{
693 char **a;
694 char *s;
695 char **argv;
696 int status = -1;
697 BOOL needToTry = TRUE;
2d7a9237 698 char *cmd2;
68dc0745 699
2d7a9237
GS
700 /* Save an extra exec if possible. See if there are shell
701 * metacharacters in it */
e200fe59 702 if (!has_shell_metachars(cmd)) {
a02a5408
JC
703 Newx(argv, strlen(cmd) / 2 + 2, char*);
704 Newx(cmd2, strlen(cmd) + 1, char);
68dc0745
PP
705 strcpy(cmd2, cmd);
706 a = argv;
707 for (s = cmd2; *s;) {
de030af3 708 while (*s && isSPACE(*s))
68dc0745
PP
709 s++;
710 if (*s)
711 *(a++) = s;
dd7038b3 712 s = find_next_space(s);
9404a519 713 if (*s)
68dc0745 714 *s++ = '\0';
0a753a76 715 }
4e205ed6 716 *a = NULL;
ce1da67e 717 if (argv[0]) {
6890e559
GS
718 switch (exectype) {
719 case EXECF_SPAWN:
720 status = win32_spawnvp(P_WAIT, argv[0],
721 (const char* const*)argv);
722 break;
723 case EXECF_SPAWN_NOWAIT:
f06c8825
TC
724 status = do_spawnvp_handles(P_NOWAIT, argv[0],
725 (const char* const*)argv, handles);
6890e559
GS
726 break;
727 case EXECF_EXEC:
728 status = win32_execvp(argv[0], (const char* const*)argv);
729 break;
730 }
2d7a9237 731 if (status != -1 || errno == 0)
68dc0745 732 needToTry = FALSE;
0a753a76 733 }
0a753a76 734 Safefree(argv);
68dc0745
PP
735 Safefree(cmd2);
736 }
2d7a9237 737 if (needToTry) {
ce1da67e
GS
738 char **argv;
739 int i = -1;
740 get_shell();
a02a5408 741 Newx(argv, w32_perlshell_items + 2, char*);
ce1da67e
GS
742 while (++i < w32_perlshell_items)
743 argv[i] = w32_perlshell_vec[i];
08039b81 744 argv[i++] = (char *)cmd;
4e205ed6 745 argv[i] = NULL;
6890e559
GS
746 switch (exectype) {
747 case EXECF_SPAWN:
748 status = win32_spawnvp(P_WAIT, argv[0],
749 (const char* const*)argv);
750 break;
751 case EXECF_SPAWN_NOWAIT:
f06c8825
TC
752 status = do_spawnvp_handles(P_NOWAIT, argv[0],
753 (const char* const*)argv, handles);
6890e559
GS
754 break;
755 case EXECF_EXEC:
756 status = win32_execvp(argv[0], (const char* const*)argv);
757 break;
758 }
ce1da67e
GS
759 cmd = argv[0];
760 Safefree(argv);
68dc0745 761 }
922b1888 762 if (exectype == EXECF_SPAWN_NOWAIT) {
40c7cc6d 763 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS
764 }
765 else {
50892819 766 if (status < 0) {
0453d815 767 if (ckWARN(WARN_EXEC))
f98bc0c6 768 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
50892819
GS
769 (exectype == EXECF_EXEC ? "exec" : "spawn"),
770 cmd, strerror(errno));
771 status = 255 * 256;
772 }
773 else
774 status *= 256;
b28d0864 775 PL_statusvalue = status;
5aabfad6 776 }
50892819 777 return (status);
0a753a76
PP
778}
779
6890e559 780int
54725af6 781Perl_do_spawn(pTHX_ char *cmd)
6890e559 782{
7918f24d
NC
783 PERL_ARGS_ASSERT_DO_SPAWN;
784
54725af6 785 return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
6890e559
GS
786}
787
2d7a9237 788int
54725af6 789Perl_do_spawn_nowait(pTHX_ char *cmd)
2d7a9237 790{
7918f24d
NC
791 PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
792
54725af6 793 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
2d7a9237
GS
794}
795
6890e559 796bool
79d39d80 797Perl_do_exec(pTHX_ const char *cmd)
6890e559 798{
7918f24d
NC
799 PERL_ARGS_ASSERT_DO_EXEC;
800
08039b81 801 do_spawn2(aTHX_ cmd, EXECF_EXEC);
6890e559
GS
802 return FALSE;
803}
804
68dc0745
PP
805/* The idea here is to read all the directory names into a string table
806 * (separated by nulls) and when one of the other dir functions is called
807 * return the pointer to the current file name.
808 */
c5be433b 809DllExport DIR *
0e06f75d 810win32_opendir(const char *filename)
0a753a76 811{
04a2c3d9 812 dTHXa(NULL);
95136add 813 DIR *dirp;
9404a519
GS
814 long len;
815 long idx;
816 char scanname[MAX_PATH+3];
8cbe99e5 817 WCHAR wscanname[sizeof(scanname)];
35cf1ab6 818 WIN32_FIND_DATAW wFindData;
35cf1ab6 819 char buffer[MAX_PATH*2];
8cbe99e5 820 BOOL use_default;
9404a519
GS
821
822 len = strlen(filename);
525f9ba8
AD
823 if (len == 0) {
824 errno = ENOENT;
9404a519 825 return NULL;
525f9ba8
AD
826 }
827 if (len > MAX_PATH) {
828 errno = ENAMETOOLONG;
24caa93f 829 return NULL;
525f9ba8
AD
830 }
831
68dc0745 832 /* Get us a DIR structure */
a02a5408 833 Newxz(dirp, 1, DIR);
68dc0745
PP
834
835 /* Create the search pattern */
836 strcpy(scanname, filename);
23db2e2d
GS
837
838 /* bare drive name means look in cwd for drive */
839 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
840 scanname[len++] = '.';
841 scanname[len++] = '/';
842 }
843 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
9404a519 844 scanname[len++] = '/';
23db2e2d 845 }
9404a519
GS
846 scanname[len++] = '*';
847 scanname[len] = '\0';
68dc0745
PP
848
849 /* do the FindFirstFile call */
8cbe99e5 850 MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
04a2c3d9 851 aTHXa(PERL_GET_THX);
8cbe99e5
JD
852 dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
853
8c56068e 854 if (dirp->handle == INVALID_HANDLE_VALUE) {
95136add 855 DWORD err = GetLastError();
21e72512 856 /* FindFirstFile() fails on empty drives! */
95136add
GS
857 switch (err) {
858 case ERROR_FILE_NOT_FOUND:
859 return dirp;
860 case ERROR_NO_MORE_FILES:
861 case ERROR_PATH_NOT_FOUND:
862 errno = ENOENT;
863 break;
864 case ERROR_NOT_ENOUGH_MEMORY:
865 errno = ENOMEM;
866 break;
867 default:
868 errno = EINVAL;
869 break;
870 }
871 Safefree(dirp);
68dc0745
PP
872 return NULL;
873 }
874
8cbe99e5
JD
875 use_default = FALSE;
876 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
877 wFindData.cFileName, -1,
878 buffer, sizeof(buffer), NULL, &use_default);
879 if (use_default && *wFindData.cAlternateFileName) {
35cf1ab6 880 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
8cbe99e5
JD
881 wFindData.cAlternateFileName, -1,
882 buffer, sizeof(buffer), NULL, NULL);
35cf1ab6 883 }
8cbe99e5 884
68dc0745
PP
885 /* now allocate the first part of the string table for
886 * the filenames that we find.
887 */
8cbe99e5 888 idx = strlen(buffer)+1;
95136add 889 if (idx < 256)
35cf1ab6 890 dirp->size = 256;
95136add
GS
891 else
892 dirp->size = idx;
a02a5408 893 Newx(dirp->start, dirp->size, char);
8cbe99e5 894 strcpy(dirp->start, buffer);
95136add
GS
895 dirp->nfiles++;
896 dirp->end = dirp->curr = dirp->start;
897 dirp->end += idx;
898 return dirp;
0a753a76
PP
899}
900
901
68dc0745
PP
902/* Readdir just returns the current string pointer and bumps the
903 * string pointer to the nDllExport entry.
904 */
c5be433b 905DllExport struct direct *
ce2e26e5 906win32_readdir(DIR *dirp)
0a753a76 907{
95136add 908 long len;
0a753a76 909
68dc0745
PP
910 if (dirp->curr) {
911 /* first set up the structure to return */
912 len = strlen(dirp->curr);
0f38926b 913 strcpy(dirp->dirstr.d_name, dirp->curr);
68dc0745 914 dirp->dirstr.d_namlen = len;
0a753a76 915
68dc0745 916 /* Fake an inode */
0f38926b 917 dirp->dirstr.d_ino = dirp->curr - dirp->start;
0a753a76 918
95136add 919 /* Now set up for the next call to readdir */
68dc0745 920 dirp->curr += len + 1;
95136add 921 if (dirp->curr >= dirp->end) {
35cf1ab6 922 BOOL res;
35cf1ab6 923 char buffer[MAX_PATH*2];
95136add 924
60b22aca
JD
925 if (dirp->handle == INVALID_HANDLE_VALUE) {
926 res = 0;
927 }
95136add
GS
928 /* finding the next file that matches the wildcard
929 * (which should be all of them in this directory!).
95136add 930 */
8cbe99e5 931 else {
35cf1ab6
JD
932 WIN32_FIND_DATAW wFindData;
933 res = FindNextFileW(dirp->handle, &wFindData);
934 if (res) {
935 BOOL use_default = FALSE;
936 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
937 wFindData.cFileName, -1,
938 buffer, sizeof(buffer), NULL, &use_default);
939 if (use_default && *wFindData.cAlternateFileName) {
940 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
941 wFindData.cAlternateFileName, -1,
942 buffer, sizeof(buffer), NULL, NULL);
943 }
35cf1ab6
JD
944 }
945 }
95136add 946 if (res) {
0f38926b 947 long endpos = dirp->end - dirp->start;
8cbe99e5 948 long newsize = endpos + strlen(buffer) + 1;
95136add 949 /* bump the string table size by enough for the
022735b4 950 * new name and its null terminator */
0f38926b
GS
951 while (newsize > dirp->size) {
952 long curpos = dirp->curr - dirp->start;
95136add
GS
953 dirp->size *= 2;
954 Renew(dirp->start, dirp->size, char);
0f38926b 955 dirp->curr = dirp->start + curpos;
95136add 956 }
8cbe99e5 957 strcpy(dirp->start + endpos, buffer);
0f38926b 958 dirp->end = dirp->start + newsize;
95136add
GS
959 dirp->nfiles++;
960 }
60b22aca 961 else {
95136add 962 dirp->curr = NULL;
60b22aca
JD
963 if (dirp->handle != INVALID_HANDLE_VALUE) {
964 FindClose(dirp->handle);
965 dirp->handle = INVALID_HANDLE_VALUE;
966 }
967 }
68dc0745 968 }
68dc0745 969 return &(dirp->dirstr);
3fadfdf1 970 }
68dc0745
PP
971 else
972 return NULL;
0a753a76
PP
973}
974
68dc0745 975/* Telldir returns the current string pointer position */
c5be433b 976DllExport long
ce2e26e5 977win32_telldir(DIR *dirp)
0a753a76 978{
60b22aca 979 return dirp->curr ? (dirp->curr - dirp->start) : -1;
0a753a76
PP
980}
981
982
68dc0745 983/* Seekdir moves the string pointer to a previously saved position
95136add 984 * (returned by telldir).
68dc0745 985 */
c5be433b 986DllExport void
ce2e26e5 987win32_seekdir(DIR *dirp, long loc)
0a753a76 988{
60b22aca 989 dirp->curr = loc == -1 ? NULL : dirp->start + loc;
0a753a76
PP
990}
991
68dc0745 992/* Rewinddir resets the string pointer to the start */
c5be433b 993DllExport void
ce2e26e5 994win32_rewinddir(DIR *dirp)
0a753a76
PP
995{
996 dirp->curr = dirp->start;
997}
998
68dc0745 999/* free the memory allocated by opendir */
c5be433b 1000DllExport int
ce2e26e5 1001win32_closedir(DIR *dirp)
0a753a76 1002{
95136add 1003 if (dirp->handle != INVALID_HANDLE_VALUE)
0f38926b 1004 FindClose(dirp->handle);
0a753a76
PP
1005 Safefree(dirp->start);
1006 Safefree(dirp);
68dc0745 1007 return 1;
0a753a76
PP
1008}
1009
60b22aca
JD
1010/* duplicate a open DIR* for interpreter cloning */
1011DllExport DIR *
1012win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
1013{
1014 dVAR;
1015 PerlInterpreter *const from = param->proto_perl;
f76b679e 1016 PerlInterpreter *const to = (PerlInterpreter *)PERL_GET_THX;
60b22aca
JD
1017
1018 long pos;
1019 DIR *dup;
1020
1021 /* switch back to original interpreter because win32_readdir()
1022 * might Renew(dirp->start).
1023 */
1024 if (from != to) {
1025 PERL_SET_THX(from);
1026 }
1027
1028 /* mark current position; read all remaining entries into the
1029 * cache, and then restore to current position.
1030 */
1031 pos = win32_telldir(dirp);
1032 while (win32_readdir(dirp)) {
1033 /* read all entries into cache */
1034 }
1035 win32_seekdir(dirp, pos);
1036
1037 /* switch back to new interpreter to allocate new DIR structure */
1038 if (from != to) {
1039 PERL_SET_THX(to);
1040 }
1041
1042 Newx(dup, 1, DIR);
1043 memcpy(dup, dirp, sizeof(DIR));
1044
1045 Newx(dup->start, dirp->size, char);
1046 memcpy(dup->start, dirp->start, dirp->size);
1047
1048 dup->end = dup->start + (dirp->end - dirp->start);
1049 if (dirp->curr)
1050 dup->curr = dup->start + (dirp->curr - dirp->start);
1051
1052 return dup;
1053}
0a753a76 1054
68dc0745
PP
1055/*
1056 * various stubs
1057 */
0a753a76
PP
1058
1059
68dc0745
PP
1060/* Ownership
1061 *
1062 * Just pretend that everyone is a superuser. NT will let us know if
1063 * we don\'t really have permission to do something.
1064 */
0a753a76
PP
1065
1066#define ROOT_UID ((uid_t)0)
1067#define ROOT_GID ((gid_t)0)
1068
68dc0745
PP
1069uid_t
1070getuid(void)
0a753a76 1071{
68dc0745 1072 return ROOT_UID;
0a753a76
PP
1073}
1074
68dc0745
PP
1075uid_t
1076geteuid(void)
0a753a76 1077{
68dc0745 1078 return ROOT_UID;
0a753a76
PP
1079}
1080
68dc0745
PP
1081gid_t
1082getgid(void)
0a753a76 1083{
68dc0745 1084 return ROOT_GID;
0a753a76
PP
1085}
1086
68dc0745
PP
1087gid_t
1088getegid(void)
0a753a76 1089{
68dc0745 1090 return ROOT_GID;
0a753a76
PP
1091}
1092
68dc0745 1093int
22239a37 1094setuid(uid_t auid)
3fadfdf1 1095{
22239a37 1096 return (auid == ROOT_UID ? 0 : -1);
0a753a76
PP
1097}
1098
68dc0745 1099int
22239a37 1100setgid(gid_t agid)
0a753a76 1101{
22239a37 1102 return (agid == ROOT_GID ? 0 : -1);
0a753a76
PP
1103}
1104
73f2c082 1105EXTERN_C char *
e34ffe5a
GS
1106getlogin(void)
1107{
acfe0abc 1108 dTHX;
3352bfcb
GS
1109 char *buf = w32_getlogin_buffer;
1110 DWORD size = sizeof(w32_getlogin_buffer);
e34ffe5a
GS
1111 if (GetUserName(buf,&size))
1112 return buf;
1113 return (char*)NULL;
1114}
1115
b990f8c8
GS
1116int
1117chown(const char *path, uid_t owner, gid_t group)
1118{
1119 /* XXX noop */
1c1c7f20 1120 return 0;
b990f8c8
GS
1121}
1122
00b02797
JH
1123/*
1124 * XXX this needs strengthening (for PerlIO)
1125 * -- BKS, 11-11-200
1126*/
1127int mkstemp(const char *path)
1128{
1129 dTHX;
1130 char buf[MAX_PATH+1];
1131 int i = 0, fd = -1;
1132
1133retry:
1134 if (i++ > 10) { /* give up */
1135 errno = ENOENT;
1136 return -1;
1137 }
1138 if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1139 errno = ENOENT;
1140 return -1;
1141 }
1142 fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1143 if (fd == -1)
1144 goto retry;
1145 return fd;
1146}
1147
0aaad0ff 1148static long
04a2c3d9 1149find_pid(pTHX_ int pid)
0a753a76 1150{
7766f137
GS
1151 long child = w32_num_children;
1152 while (--child >= 0) {
eb160463 1153 if ((int)w32_child_pids[child] == pid)
0aaad0ff
GS
1154 return child;
1155 }
1156 return -1;
1157}
1158
1159static void
1160remove_dead_process(long child)
1161{
1162 if (child >= 0) {
acfe0abc 1163 dTHX;
0aaad0ff 1164 CloseHandle(w32_child_handles[child]);
c00206c8 1165 Move(&w32_child_handles[child+1], &w32_child_handles[child],
0aaad0ff 1166 (w32_num_children-child-1), HANDLE);
c00206c8 1167 Move(&w32_child_pids[child+1], &w32_child_pids[child],
0aaad0ff
GS
1168 (w32_num_children-child-1), DWORD);
1169 w32_num_children--;
f55ee38a 1170 }
f55ee38a
GS
1171}
1172
7766f137
GS
1173#ifdef USE_ITHREADS
1174static long
04a2c3d9 1175find_pseudo_pid(pTHX_ int pid)
7766f137 1176{
7766f137
GS
1177 long child = w32_num_pseudo_children;
1178 while (--child >= 0) {
eb160463 1179 if ((int)w32_pseudo_child_pids[child] == pid)
7766f137
GS
1180 return child;
1181 }
1182 return -1;
1183}
1184
1185static void
1186remove_dead_pseudo_process(long child)
1187{
1188 if (child >= 0) {
acfe0abc 1189 dTHX;
7766f137 1190 CloseHandle(w32_pseudo_child_handles[child]);
c00206c8 1191 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
7766f137 1192 (w32_num_pseudo_children-child-1), HANDLE);
c00206c8 1193 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
7766f137 1194 (w32_num_pseudo_children-child-1), DWORD);
aeecf691
JD
1195 Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1196 (w32_num_pseudo_children-child-1), HWND);
8a3cb9c6
JD
1197 Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child],
1198 (w32_num_pseudo_children-child-1), char);
7766f137
GS
1199 w32_num_pseudo_children--;
1200 }
1201}
8a3cb9c6
JD
1202
1203void
1204win32_wait_for_children(pTHX)
1205{
1206 if (w32_pseudo_children && w32_num_pseudo_children) {
1207 long child = 0;
1208 long count = 0;
1209 HANDLE handles[MAXIMUM_WAIT_OBJECTS];
1210
1211 for (child = 0; child < w32_num_pseudo_children; ++child) {
1212 if (!w32_pseudo_child_sigterm[child])
1213 handles[count++] = w32_pseudo_child_handles[child];
1214 }
1215 /* XXX should use MsgWaitForMultipleObjects() to continue
1216 * XXX processing messages while we wait.
1217 */
1218 WaitForMultipleObjects(count, handles, TRUE, INFINITE);
1219
1220 while (w32_num_pseudo_children)
1221 CloseHandle(w32_pseudo_child_handles[--w32_num_pseudo_children]);
1222 }
1223}
7766f137
GS
1224#endif
1225
542cb85f
JD
1226static int
1227terminate_process(DWORD pid, HANDLE process_handle, int sig)
1228{
1229 switch(sig) {
1230 case 0:
1231 /* "Does process exist?" use of kill */
1232 return 1;
1233 case 2:
1234 if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1235 return 1;
1236 break;
1237 case SIGBREAK:
1238 case SIGTERM:
1239 if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1240 return 1;
1241 break;
1242 default: /* For now be backwards compatible with perl 5.6 */
1243 case 9:
1244 /* Note that we will only be able to kill processes owned by the
1245 * current process owner, even when we are running as an administrator.
1246 * To kill processes of other owners we would need to set the
1247 * 'SeDebugPrivilege' privilege before obtaining the process handle.
1248 */
1249 if (TerminateProcess(process_handle, sig))
1250 return 1;
1251 break;
1252 }
1253 return 0;
1254}
1255
721b2674
DD
1256/* returns number of processes killed */
1257static int
1258my_killpg(int pid, int sig)
542cb85f
JD
1259{
1260 HANDLE process_handle;
1261 HANDLE snapshot_handle;
1262 int killed = 0;
1263
1264 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1265 if (process_handle == NULL)
542cb85f
JD
1266 return 0;
1267
1268 killed += terminate_process(pid, process_handle, sig);
1269
8cbe99e5 1270 snapshot_handle = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
542cb85f
JD
1271 if (snapshot_handle != INVALID_HANDLE_VALUE) {
1272 PROCESSENTRY32 entry;
1273
1274 entry.dwSize = sizeof(entry);
8cbe99e5 1275 if (Process32First(snapshot_handle, &entry)) {
542cb85f 1276 do {
8cbe99e5 1277 if (entry.th32ParentProcessID == (DWORD)pid)
721b2674 1278 killed += my_killpg(entry.th32ProcessID, sig);
542cb85f
JD
1279 entry.dwSize = sizeof(entry);
1280 }
8cbe99e5 1281 while (Process32Next(snapshot_handle, &entry));
542cb85f
JD
1282 }
1283 CloseHandle(snapshot_handle);
1284 }
1285 CloseHandle(process_handle);
1286 return killed;
1287}
1288
721b2674 1289/* returns number of processes killed */
542cb85f
JD
1290static int
1291my_kill(int pid, int sig)
1292{
1293 int retval = 0;
1294 HANDLE process_handle;
1295
1296 if (sig < 0)
721b2674 1297 return my_killpg(pid, -sig);
542cb85f
JD
1298
1299 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af
JD
1300 /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
1301 if (process_handle != NULL) {
542cb85f
JD
1302 retval = terminate_process(pid, process_handle, sig);
1303 CloseHandle(process_handle);
1304 }
1305 return retval;
1306}
1307
d903973c 1308#ifdef USE_ITHREADS
17ce47a8
SH
1309/* Get a child pseudo-process HWND, with retrying and delaying/yielding.
1310 * The "tries" parameter is the number of retries to make, with a Sleep(1)
1311 * (waiting and yielding the time slot) between each try. Specifying 0 causes
1312 * only Sleep(0) (no waiting and potentially no yielding) to be used, so is not
1313 * recommended
1314 * Returns an hwnd != INVALID_HANDLE_VALUE (so be aware that NULL can be
1315 * returned) or croaks if the child pseudo-process doesn't schedule and deliver
1316 * a HWND in the time period allowed.
1317 */
d903973c 1318static HWND
17ce47a8
SH
1319get_hwnd_delay(pTHX, long child, DWORD tries)
1320{
d903973c 1321 HWND hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1322 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8
SH
1323
1324 /* Pseudo-process has not yet properly initialized since hwnd isn't set.
1325 * Fast sleep: On some NT kernels/systems, a Sleep(0) won't deschedule a
1326 * thread 100% of the time since threads are attached to a CPU for NUMA and
1327 * caching reasons, and the child thread was attached to a different CPU
1328 * therefore there is no workload on that CPU and Sleep(0) returns control
1329 * without yielding the time slot.
1330 * https://rt.perl.org/rt3/Ticket/Display.html?id=88840
1331 */
d903973c
DD
1332 Sleep(0);
1333 win32_async_check(aTHX);
17ce47a8 1334 hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1335 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8 1336
d903973c 1337 {
adb86be5 1338 unsigned int count = 0;
17ce47a8
SH
1339 /* No Sleep(1) if tries==0, just fail instead if we get this far. */
1340 while (count++ < tries) {
1341 Sleep(1);
1342 win32_async_check(aTHX);
1343 hwnd = w32_pseudo_child_message_hwnds[child];
1344 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
1345 }
d903973c 1346 }
17ce47a8
SH
1347
1348 Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled");
d903973c
DD
1349}
1350#endif
1351
f55ee38a
GS
1352DllExport int
1353win32_kill(int pid, int sig)
1354{
acfe0abc 1355 dTHX;
c66b022d 1356 long child;
7766f137
GS
1357#ifdef USE_ITHREADS
1358 if (pid < 0) {
1359 /* it is a pseudo-forked child */
04a2c3d9 1360 child = find_pseudo_pid(aTHX_ -pid);
7766f137 1361 if (child >= 0) {
85c508c3 1362 HANDLE hProcess = w32_pseudo_child_handles[child];
7e5f34c0 1363 switch (sig) {
17ce47a8
SH
1364 case 0:
1365 /* "Does process exist?" use of kill */
7e5f34c0 1366 return 0;
aeecf691 1367
17ce47a8
SH
1368 case 9: {
1369 /* kill -9 style un-graceful exit */
1370 /* Do a wait to make sure child starts and isn't in DLL
1371 * Loader Lock */
1372 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1373 if (TerminateThread(hProcess, sig)) {
1374 /* Allow the scheduler to finish cleaning up the other
1375 * thread.
1376 * Otherwise, if we ExitProcess() before another context
1377 * switch happens we will end up with a process exit
1378 * code of "sig" instead of our own exit status.
1379 * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
1380 */
1381 Sleep(0);
1382 remove_dead_pseudo_process(child);
1383 return 0;
1384 }
1385 break;
1386 }
1387
1388 default: {
1389 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1390 /* We fake signals to pseudo-processes using Win32
1391 * message queue. */
1392 if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1393 PostThreadMessage(-pid, WM_USER_KILL, sig, 0))
1394 {
1395 /* Don't wait for child process to terminate after we send a
1396 * SIGTERM because the child may be blocked in a system call
1397 * and never receive the signal.
1398 */
1399 if (sig == SIGTERM) {
1400 Sleep(0);
1401 w32_pseudo_child_sigterm[child] = 1;
1402 }
1403 /* It might be us ... */
1404 PERL_ASYNC_CHECK();
1405 return 0;
1406 }
1407 break;
1408 }
1409 } /* switch */
7766f137 1410 }
68dc0745 1411 }
7766f137
GS
1412 else
1413#endif
1414 {
04a2c3d9 1415 child = find_pid(aTHX_ pid);
7766f137 1416 if (child >= 0) {
542cb85f
JD
1417 if (my_kill(pid, sig)) {
1418 DWORD exitcode = 0;
1419 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1420 exitcode != STILL_ACTIVE)
1421 {
1422 remove_dead_process(child);
1423 }
1424 return 0;
7e5f34c0 1425 }
7766f137
GS
1426 }
1427 else {
8cbe99e5 1428 if (my_kill(pid, sig))
48db714f 1429 return 0;
7766f137
GS
1430 }
1431 }
1432 errno = EINVAL;
1433 return -1;
0a753a76 1434}
fbbbcc48 1435
68dc0745 1436DllExport int
c623ac67 1437win32_stat(const char *path, Stat_t *sbuf)
0a753a76 1438{
3fadfdf1 1439 char buffer[MAX_PATH+1];
68dc0745 1440 int l = strlen(path);
04a2c3d9 1441 dTHX;
67fbe06e 1442 int res;
6b980173 1443 int nlink = 1;
44221b20 1444 BOOL expect_dir = FALSE;
0a753a76 1445
cba61fe1
JD
1446 GV *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT",
1447 GV_NOTQUAL, SVt_PV);
1448 BOOL sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy));
1449
68dc0745
PP
1450 if (l > 1) {
1451 switch(path[l - 1]) {
e1dbac94 1452 /* FindFirstFile() and stat() are buggy with a trailing
44221b20 1453 * slashes, except for the root directory of a drive */
68dc0745 1454 case '\\':
44221b20
JD
1455 case '/':
1456 if (l > sizeof(buffer)) {
0b96339f
JD
1457 errno = ENAMETOOLONG;
1458 return -1;
1459 }
44221b20
JD
1460 --l;
1461 strncpy(buffer, path, l);
1462 /* remove additional trailing slashes */
1463 while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
1464 --l;
1465 /* add back slash if we otherwise end up with just a drive letter */
1466 if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
1467 buffer[l++] = '\\';
1468 buffer[l] = '\0';
1469 path = buffer;
1470 expect_dir = TRUE;
e1dbac94 1471 break;
44221b20 1472
23db2e2d 1473 /* FindFirstFile() is buggy with "x:", so add a dot :-( */
e1dbac94
GS
1474 case ':':
1475 if (l == 2 && isALPHA(path[0])) {
426c1a18
GS
1476 buffer[0] = path[0];
1477 buffer[1] = ':';
1478 buffer[2] = '.';
1479 buffer[3] = '\0';
e1dbac94 1480 l = 3;
426c1a18 1481 path = buffer;
e1dbac94
GS
1482 }
1483 break;
68dc0745
PP
1484 }
1485 }
6b980173 1486
8c56068e
JD
1487 path = PerlDir_mapA(path);
1488 l = strlen(path);
cba61fe1
JD
1489
1490 if (!sloppy) {
1491 /* We must open & close the file once; otherwise file attribute changes */
1492 /* might not yet have propagated to "other" hard links of the same file. */
1493 /* This also gives us an opportunity to determine the number of links. */
1494 HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
1495 if (handle != INVALID_HANDLE_VALUE) {
1496 BY_HANDLE_FILE_INFORMATION bhi;
1497 if (GetFileInformationByHandle(handle, &bhi))
1498 nlink = bhi.nNumberOfLinks;
1499 CloseHandle(handle);
1500 }
7fac1903 1501 }
6b980173 1502
8c56068e 1503 /* path will be mapped correctly above */
c623ac67 1504#if defined(WIN64) || defined(USE_LARGE_FILES)
8c56068e 1505 res = _stati64(path, sbuf);
c623ac67 1506#else
8c56068e 1507 res = stat(path, sbuf);
c623ac67 1508#endif
426c1a18 1509 sbuf->st_nlink = nlink;
6b980173 1510
24caa93f
GS
1511 if (res < 0) {
1512 /* CRT is buggy on sharenames, so make sure it really isn't.
1513 * XXX using GetFileAttributesEx() will enable us to set
426c1a18 1514 * sbuf->st_*time (but note that's not available on the
24caa93f 1515 * Windows of 1995) */
8c56068e 1516 DWORD r = GetFileAttributesA(path);
24caa93f 1517 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
426c1a18 1518 /* sbuf may still contain old garbage since stat() failed */
c623ac67 1519 Zero(sbuf, 1, Stat_t);
426c1a18 1520 sbuf->st_mode = S_IFDIR | S_IREAD;
24caa93f
GS
1521 errno = 0;
1522 if (!(r & FILE_ATTRIBUTE_READONLY))
426c1a18 1523 sbuf->st_mode |= S_IWRITE | S_IEXEC;
24caa93f
GS
1524 return 0;
1525 }
1526 }
24caa93f 1527 else {
e1dbac94
GS
1528 if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1529 && (path[2] == '\\' || path[2] == '/'))
2293b0e9
AB
1530 {
1531 /* The drive can be inaccessible, some _stat()s are buggy */
8c56068e 1532 if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
2293b0e9
AB
1533 errno = ENOENT;
1534 return -1;
1535 }
1536 }
44221b20
JD
1537 if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
1538 errno = ENOTDIR;
1539 return -1;
1540 }
038ae9a4
SH
1541 if (S_ISDIR(sbuf->st_mode)) {
1542 /* Ensure the "write" bit is switched off in the mode for
378eeda7
SH
1543 * directories with the read-only attribute set. Some compilers
1544 * switch it on for directories, which is technically correct
038ae9a4
SH
1545 * (directories are indeed always writable unless denied by DACLs),
1546 * but we want stat() and -w to reflect the state of the read-only
1547 * attribute for symmetry with chmod(). */
1548 DWORD r = GetFileAttributesA(path);
1549 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_READONLY)) {
1550 sbuf->st_mode &= ~S_IWRITE;
1551 }
1552 }
2293b0e9 1553 }
67fbe06e 1554 return res;
0a753a76
PP
1555}
1556
bb27e7b6
JH
1557#define isSLASH(c) ((c) == '/' || (c) == '\\')
1558#define SKIP_SLASHES(s) \
1559 STMT_START { \
1560 while (*(s) && isSLASH(*(s))) \
1561 ++(s); \
1562 } STMT_END
1563#define COPY_NONSLASHES(d,s) \
1564 STMT_START { \
1565 while (*(s) && !isSLASH(*(s))) \
1566 *(d)++ = *(s)++; \
1567 } STMT_END
1568
8ac9c18d
GS
1569/* Find the longname of a given path. path is destructively modified.
1570 * It should have space for at least MAX_PATH characters. */
1571DllExport char *
1572win32_longpath(char *path)
1573{
1574 WIN32_FIND_DATA fdata;
1575 HANDLE fhand;
1576 char tmpbuf[MAX_PATH+1];
1577 char *tmpstart = tmpbuf;
1578 char *start = path;
1579 char sep;
1580 if (!path)
4e205ed6 1581 return NULL;
8ac9c18d
GS
1582
1583 /* drive prefix */
bb27e7b6 1584 if (isALPHA(path[0]) && path[1] == ':') {
8ac9c18d
GS
1585 start = path + 2;
1586 *tmpstart++ = path[0];
1587 *tmpstart++ = ':';
1588 }
1589 /* UNC prefix */
bb27e7b6 1590 else if (isSLASH(path[0]) && isSLASH(path[1])) {
8ac9c18d 1591 start = path + 2;
52fcf7ee
GS
1592 *tmpstart++ = path[0];
1593 *tmpstart++ = path[1];
bb27e7b6
JH
1594 SKIP_SLASHES(start);
1595 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
8ac9c18d 1596 if (*start) {
bb27e7b6
JH
1597 *tmpstart++ = *start++;
1598 SKIP_SLASHES(start);
1599 COPY_NONSLASHES(tmpstart,start); /* copy share name */
8ac9c18d
GS
1600 }
1601 }
8ac9c18d 1602 *tmpstart = '\0';
bb27e7b6
JH
1603 while (*start) {
1604 /* copy initial slash, if any */
1605 if (isSLASH(*start)) {
1606 *tmpstart++ = *start++;
1607 *tmpstart = '\0';
1608 SKIP_SLASHES(start);
1609 }
1610
1611 /* FindFirstFile() expands "." and "..", so we need to pass
1612 * those through unmolested */
1613 if (*start == '.'
1614 && (!start[1] || isSLASH(start[1])
1615 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1616 {
1617 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1618 *tmpstart = '\0';
1619 continue;
1620 }
1621
1622 /* if this is the end, bust outta here */
1623 if (!*start)
1624 break;
8ac9c18d 1625
bb27e7b6
JH
1626 /* now we're at a non-slash; walk up to next slash */
1627 while (*start && !isSLASH(*start))
8ac9c18d 1628 ++start;
8ac9c18d
GS
1629
1630 /* stop and find full name of component */
bb27e7b6 1631 sep = *start;
8ac9c18d
GS
1632 *start = '\0';
1633 fhand = FindFirstFile(path,&fdata);
bb27e7b6 1634 *start = sep;
8ac9c18d 1635 if (fhand != INVALID_HANDLE_VALUE) {
bb27e7b6
JH
1636 STRLEN len = strlen(fdata.cFileName);
1637 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1638 strcpy(tmpstart, fdata.cFileName);
1639 tmpstart += len;
1640 FindClose(fhand);
1641 }
1642 else {
1643 FindClose(fhand);
1644 errno = ERANGE;
4e205ed6 1645 return NULL;
bb27e7b6 1646 }
8ac9c18d
GS
1647 }
1648 else {
1649 /* failed a step, just return without side effects */
bf49b057 1650 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
bb27e7b6 1651 errno = EINVAL;
4e205ed6 1652 return NULL;
8ac9c18d
GS
1653 }
1654 }
1655 strcpy(path,tmpbuf);
1656 return path;
1657}
1658
aa2b96ec 1659static void
0934c9d9 1660out_of_memory(void)
aa2b96ec 1661{
4cbe3a7d
DD
1662 if (PL_curinterp)
1663 croak_no_mem();
ae6198af 1664 exit(1);
aa2b96ec
JD
1665}
1666
073dd035
DD
1667void
1668win32_croak_not_implemented(const char * fname)
1669{
1670 PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
1671
1672 Perl_croak_nocontext("%s not implemented!\n", fname);
1673}
1674
00a0ae28
SH
1675/* Converts a wide character (UTF-16) string to the Windows ANSI code page,
1676 * potentially using the system's default replacement character for any
1677 * unrepresentable characters. The caller must free() the returned string. */
1678static char*
1679wstr_to_str(const wchar_t* wstr)
1680{
1681 BOOL used_default = FALSE;
1682 size_t wlen = wcslen(wstr) + 1;
1683 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1684 NULL, 0, NULL, NULL);
f76b679e 1685 char* str = (char*)malloc(len);
00a0ae28
SH
1686 if (!str)
1687 out_of_memory();
1688 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1689 str, len, NULL, &used_default);
1690 return str;
1691}
1692
aa2b96ec
JD
1693/* The win32_ansipath() function takes a Unicode filename and converts it
1694 * into the current Windows codepage. If some characters cannot be mapped,
1695 * then it will convert the short name instead.
1696 *
1697 * The buffer to the ansi pathname must be freed with win32_free() when it
1698 * it no longer needed.
1699 *
1700 * The argument to win32_ansipath() must exist before this function is
1701 * called; otherwise there is no way to determine the short path name.
1702 *
1703 * Ideas for future refinement:
1704 * - Only convert those segments of the path that are not in the current
1705 * codepage, but leave the other segments in their long form.
1706 * - If the resulting name is longer than MAX_PATH, start converting
1707 * additional path segments into short names until the full name
1708 * is shorter than MAX_PATH. Shorten the filename part last!
1709 */
1710DllExport char *
1711win32_ansipath(const WCHAR *widename)
1712{
1713 char *name;
1714 BOOL use_default = FALSE;
1715 size_t widelen = wcslen(widename)+1;
1716 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1717 NULL, 0, NULL, NULL);
f76b679e 1718 name = (char*)win32_malloc(len);
aa2b96ec
JD
1719 if (!name)
1720 out_of_memory();
1721
1722 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1723 name, len, NULL, &use_default);
1724 if (use_default) {
aa2b96ec 1725 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af 1726 if (shortlen) {
f76b679e 1727 WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
ae6198af
JD
1728 if (!shortname)
1729 out_of_memory();
1730 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1731
1732 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1733 NULL, 0, NULL, NULL);
f76b679e 1734 name = (char*)win32_realloc(name, len);
ae6198af
JD
1735 if (!name)
1736 out_of_memory();
1737 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1738 name, len, NULL, NULL);
1739 win32_free(shortname);
1740 }
aa2b96ec
JD
1741 }
1742 return name;
1743}
1744
2c8ca683
DD
1745/* the returned string must be freed with win32_freeenvironmentstrings which is
1746 * implemented as a macro
1747 * void win32_freeenvironmentstrings(void* block)
1748 */
0551aaa8 1749DllExport char *
4f46e52b
KR
1750win32_getenvironmentstrings(void)
1751{
1752 LPWSTR lpWStr, lpWTmp;
1753 LPSTR lpStr, lpTmp;
1754 DWORD env_len, wenvstrings_len = 0, aenvstrings_len = 0;
1755
1756 /* Get the process environment strings */
1757 lpWTmp = lpWStr = (LPWSTR) GetEnvironmentStringsW();
fa467b9b 1758 for (wenvstrings_len = 1; *lpWTmp != '\0'; lpWTmp += env_len + 1) {
4f46e52b
KR
1759 env_len = wcslen(lpWTmp);
1760 /* calculate the size of the environment strings */
1761 wenvstrings_len += env_len + 1;
1762 }
1763
fa467b9b 1764 /* Get the number of bytes required to store the ACP encoded string */
4f46e52b 1765 aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
fa467b9b 1766 lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
4f46e52b
KR
1767 lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
1768 if(!lpTmp)
1769 out_of_memory();
1770
1771 /* Convert the string from UTF-16 encoding to ACP encoding */
1772 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
fa467b9b 1773 aenvstrings_len, NULL, NULL);
4f46e52b 1774
a6abe943 1775 FreeEnvironmentStringsW(lpWStr);
90674eaa 1776
4f46e52b
KR
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) {
c2b90b61 1790 curitem = sv_2mortal(newSVpvs(""));
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
4f79e9b1
SH
2613 /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno
2614 * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but
2615 * sys_nerr is still 43 and strerror() returns "Unknown error" for them.
2616 * We must therefore still roll our own messages for these codes, and
2617 * additionally map them to corresponding Windows (sockets) error codes
2618 * first to avoid getting the wrong system message.
cd6a3131
SH
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{
aac983ac 2936 get_shell();
8c0134a8 2937
aac983ac
TC
2938 return do_popen(mode, NULL, narg, args);
2939}
50892819 2940
aac983ac
TC
2941STATIC PerlIO*
2942do_popen(const char *mode, const char *command, IV narg, SV **args) {
50892819 2943 int p[2];
f06c8825 2944 int handles[3];
50892819 2945 int parent, child;
c161da64 2946 int stdfd;
50892819
GS
2947 int ourmode;
2948 int childpid;
1095be37 2949 DWORD nhandle;
1095be37 2950 int lock_held = 0;
aac983ac 2951 const char **args_pvs = NULL;
50892819
GS
2952
2953 /* establish which ends read and write */
2954 if (strchr(mode,'w')) {
2955 stdfd = 0; /* stdin */
2956 parent = 1;
2957 child = 0;
1095be37 2958 nhandle = STD_INPUT_HANDLE;
50892819
GS
2959 }
2960 else if (strchr(mode,'r')) {
2961 stdfd = 1; /* stdout */
2962 parent = 0;
2963 child = 1;
1095be37 2964 nhandle = STD_OUTPUT_HANDLE;
50892819
GS
2965 }
2966 else
2967 return NULL;
2968
2969 /* set the correct mode */
2970 if (strchr(mode,'b'))
2971 ourmode = O_BINARY;
2972 else if (strchr(mode,'t'))
2973 ourmode = O_TEXT;
2974 else
2975 ourmode = _fmode & (O_TEXT | O_BINARY);
2976
2977 /* the child doesn't inherit handles */
2978 ourmode |= O_NOINHERIT;
2979
1095be37 2980 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS
2981 return NULL;
2982
f06c8825
TC
2983 /* Previously this code redirected stdin/out temporarily so the
2984 child process inherited those handles, this caused race
2985 conditions when another thread was writing/reading those
2986 handles.
498d7dc4 2987
f06c8825
TC
2988 To avoid that we just feed the handles to CreateProcess() so
2989 the handles are redirected only in the child.
2990 */
2991 handles[child] = p[child];
2992 handles[parent] = -1;
2993 handles[2] = -1;
564914cd 2994
f06c8825 2995 /* CreateProcess() requires inheritable handles */
c161da64 2996 if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT,
f06c8825 2997 HANDLE_FLAG_INHERIT)) {
50892819 2998 goto cleanup;
f06c8825 2999 }
1095be37 3000
50892819 3001 /* start the child */
4f63d024 3002 {
acfe0abc 3003 dTHX;
50892819 3004
aac983ac
TC
3005 if (command) {
3006 if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
3007 goto cleanup;
3008
3009 }
3010 else {
3011 int i;
3012
3013 Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
3014 SAVEFREEPV(args_pvs);
3015 for (i = 0; i < narg; ++i)
3016 args_pvs[i] = SvPV_nolen(args[i]);
3017 args_pvs[i] = NULL;
3018
3019 if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) {
3020 if (errno == ENOEXEC || errno == ENOENT) {
3021 /* possible shell-builtin, invoke with shell */
3022 Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *);
3023 Copy(w32_perlshell_vec, args_pvs, w32_perlshell_items, const char *);
3024 if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1)
3025 goto cleanup;
3026 }
3027 else
3028 goto cleanup;
3029 }
3030 }
498d7dc4 3031
f06c8825 3032 win32_close(p[child]);
1095be37 3033
4f63d024 3034 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1
R
3035
3036 /* set process id so that it can be returned by perl's open() */
3037 PL_forkprocess = childpid;
4f63d024 3038 }
50892819
GS
3039
3040 /* we have an fd, return a file stream */
00b02797 3041 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS
3042
3043cleanup:
3044 /* we don't need to check for errors here */
3045 win32_close(p[0]);
3046 win32_close(p[1]);
f06c8825 3047
50892819 3048 return (NULL);
aac983ac
TC
3049}
3050
3051/*
3052 * a popen() clone that respects PERL5SHELL
3053 *
3054 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
3055 */
50892819 3056
aac983ac
TC
3057DllExport PerlIO*
3058win32_popen(const char *command, const char *mode)
3059{
3060#ifdef USE_RTL_POPEN
3061 return _popen(command, mode);
3062#else
3063 return do_popen(mode, command, 0, NULL);
4b556e6c 3064#endif /* USE_RTL_POPEN */
0a753a76
PP
3065}
3066
50892819
GS
3067/*
3068 * pclose() clone
3069 */
3070
68dc0745 3071DllExport int
00b02797 3072win32_pclose(PerlIO *pf)
0a753a76 3073{
4b556e6c 3074#ifdef USE_RTL_POPEN
390b85e7 3075 return _pclose(pf);
50892819 3076#else
acfe0abc 3077 dTHX;
e17cb2a9
JD
3078 int childpid, status;
3079 SV *sv;
3080
00b02797 3081 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3082
e17cb2a9
JD
3083 if (SvIOK(sv))
3084 childpid = SvIVX(sv);
3085 else
3086 childpid = 0;
50892819
GS
3087
3088 if (!childpid) {
3089 errno = EBADF;
3090 return -1;
3091 }
3092
00b02797
JH
3093#ifdef USE_PERLIO
3094 PerlIO_close(pf);
3095#else
3096 fclose(pf);
3097#endif
e17cb2a9
JD
3098 SvIVX(sv) = 0;
3099
0aaad0ff
GS
3100 if (win32_waitpid(childpid, &status, 0) == -1)
3101 return -1;
50892819 3102
0aaad0ff 3103 return status;
50892819 3104
4b556e6c 3105#endif /* USE_RTL_POPEN */
0a753a76 3106}
6b980173 3107
6b980173
JD
3108DllExport int
3109win32_link(const char *oldname, const char *newname)
3110{
04a2c3d9 3111 dTHXa(NULL);
82867ecf
GS
3112 WCHAR wOldName[MAX_PATH+1];
3113 WCHAR wNewName[MAX_PATH+1];
6b980173 3114
8c56068e
JD
3115 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3116 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
04a2c3d9 3117 ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
8cbe99e5 3118 CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173
JD
3119 {
3120 return 0;
3121 }
2b42d7ed
TC
3122 /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for
3123 both permissions errors and if the source is a directory, while
3124 POSIX wants EACCES and EPERM respectively.
3125
3126 Determined by experimentation on Windows 7 x64 SP1, since MS
3127 don't document what error codes are returned.
3128 */
3129 switch (GetLastError()) {
3130 case ERROR_BAD_NET_NAME:
3131 case ERROR_BAD_NETPATH:
3132 case ERROR_BAD_PATHNAME:
3133 case ERROR_FILE_NOT_FOUND:
3134 case ERROR_FILENAME_EXCED_RANGE:
3135 case ERROR_INVALID_DRIVE:
3136 case ERROR_PATH_NOT_FOUND:
3137 errno = ENOENT;
3138 break;
3139 case ERROR_ALREADY_EXISTS:
3140 errno = EEXIST;
3141 break;
3142 case ERROR_ACCESS_DENIED:
3143 errno = EACCES;
3144 break;
3145 case ERROR_NOT_SAME_DEVICE:
3146 errno = EXDEV;
3147 break;
e41416c3
CM
3148 case ERROR_DISK_FULL:
3149 errno = ENOSPC;
3150 break;
3151 case ERROR_NOT_ENOUGH_QUOTA:
3152 errno = EDQUOT;
3153 break;
2b42d7ed
TC
3154 default:
3155 /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */
3156 errno = EINVAL;
3157 break;
3158 }
6b980173
JD
3159 return -1;
3160}
0a753a76 3161
68dc0745 3162DllExport int
8d9b2e3c 3163win32_rename(const char *oname, const char *newname)
e24c7c18 3164{
65cb15a1 3165 char szOldName[MAX_PATH+1];
7fac1903 3166 BOOL bResult;
8cbe99e5 3167 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
acfe0abc 3168 dTHX;
65cb15a1 3169
8cbe99e5
JD
3170 if (stricmp(newname, oname))
3171 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3172 strcpy(szOldName, PerlDir_mapA(oname));
3173
3174 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3175 if (!bResult) {
3176 DWORD err = GetLastError();
3177 switch (err) {
3178 case ERROR_BAD_NET_NAME:
3179 case ERROR_BAD_NETPATH:
3180 case ERROR_BAD_PATHNAME:
3181 case ERROR_FILE_NOT_FOUND:
3182 case ERROR_FILENAME_EXCED_RANGE:
3183 case ERROR_INVALID_DRIVE:
3184 case ERROR_NO_MORE_FILES:
3185 case ERROR_PATH_NOT_FOUND:
3186 errno = ENOENT;
3187 break;
e41416c3
CM
3188 case ERROR_DISK_FULL:
3189 errno = ENOSPC;
3190 break;
3191 case ERROR_NOT_ENOUGH_QUOTA:
3192 errno = EDQUOT;
3193 break;
8cbe99e5
JD
3194 default:
3195 errno = EACCES;
3196 break;
3197 }
3198 return -1;
e24c7c18 3199 }
8cbe99e5 3200 return 0;
e24c7c18
GS
3201}
3202
3203DllExport int
68dc0745 3204win32_setmode(int fd, int mode)
0a753a76 3205{
390b85e7 3206 return setmode(fd, mode);
0a753a76
PP
3207}
3208
4a9d6100
GS
3209DllExport int
3210win32_chsize(int fd, Off_t size)
3211{
3212#if defined(WIN64) || defined(USE_LARGE_FILES)
3213 int retval = 0;
3214 Off_t cur, end, extend;
3215
3216 cur = win32_tell(fd);
3217 if (cur < 0)
3218 return -1;
3219 end = win32_lseek(fd, 0, SEEK_END);
3220 if (end < 0)
3221 return -1;
3222 extend = size - end;
3223 if (extend == 0) {
3224 /* do nothing */
3225 }
3226 else if (extend > 0) {
3227 /* must grow the file, padding with nulls */
3228 char b[4096];
3229 int oldmode = win32_setmode(fd, O_BINARY);
3230 size_t count;
3231 memset(b, '\0', sizeof(b));
3232 do {
3233 count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3234 count = win32_write(fd, b, count);
21424390 3235 if ((int)count < 0) {
4a9d6100
GS
3236 retval = -1;
3237 break;
3238 }
3239 } while ((extend -= count) > 0);
3240 win32_setmode(fd, oldmode);
3241 }
3242 else {
3243 /* shrink the file */
3244 win32_lseek(fd, size, SEEK_SET);
3245 if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3246 errno = EACCES;
3247 retval = -1;
3248 }
3249 }
4a9d6100
GS
3250 win32_lseek(fd, cur, SEEK_SET);
3251 return retval;
3252#else
8859a7a0 3253 return chsize(fd, (long)size);
4a9d6100
GS
3254#endif
3255}
3256
c623ac67
GS
3257DllExport Off_t
3258win32_lseek(int fd, Off_t offset, int origin)
96e4d5b1 3259{
c623ac67
GS
3260#if defined(WIN64) || defined(USE_LARGE_FILES)
3261 return _lseeki64(fd, offset, origin);
3262#else
8859a7a0 3263 return lseek(fd, (long)offset, origin);
c623ac67 3264#endif
96e4d5b1
PP
3265}
3266
c623ac67 3267DllExport Off_t
96e4d5b1
PP
3268win32_tell(int fd)
3269{
c623ac67
GS
3270#if defined(WIN64) || defined(USE_LARGE_FILES)
3271 return _telli64(fd);
3272#else
390b85e7 3273 return tell(fd);
c623ac67 3274#endif
96e4d5b1
PP
3275}
3276
68dc0745
PP
3277DllExport int
3278win32_open(const char *path, int flag, ...)
0a753a76 3279{
04a2c3d9 3280 dTHXa(NULL);
68dc0745
PP
3281 va_list ap;
3282 int pmode;
0a753a76
PP
3283
3284 va_start(ap, flag);
3285 pmode = va_arg(ap, int);
3286 va_end(ap);
3287
68dc0745 3288 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
3289 path = "NUL";
3290
04a2c3d9 3291 aTHXa(PERL_GET_THX);
7766f137 3292 return open(PerlDir_mapA(path), flag, pmode);
0a753a76
PP
3293}
3294
00b02797
JH
3295/* close() that understands socket */
3296extern int my_close(int); /* in win32sck.c */
3297
68dc0745
PP
3298DllExport int
3299win32_close(int fd)
0a753a76 3300{
19253ae6
DD
3301#ifdef WIN32_NO_SOCKETS
3302 return close(fd);
3303#else
00b02797 3304 return my_close(fd);
19253ae6 3305#endif
0a753a76
PP
3306}
3307
68dc0745 3308DllExport int
96e4d5b1
PP
3309win32_eof(int fd)
3310{
390b85e7 3311 return eof(fd);
96e4d5b1
PP
3312}
3313
3314DllExport int
4342f4d6
JD
3315win32_isatty(int fd)
3316{
3317 /* The Microsoft isatty() function returns true for *all*
3318 * character mode devices, including "nul". Our implementation
3319 * should only return true if the handle has a console buffer.
3320 */
3321 DWORD mode;
3322 HANDLE fh = (HANDLE)_get_osfhandle(fd);
3323 if (fh == (HANDLE)-1) {
3324 /* errno is already set to EBADF */
3325 return 0;
3326 }
3327
3328 if (GetConsoleMode(fh, &mode))
3329 return 1;
3330
3331 errno = ENOTTY;
3332 return 0;
3333}
3334
3335DllExport int
68dc0745 3336win32_dup(int fd)
0a753a76 3337{
390b85e7 3338 return dup(fd);
0a753a76
PP
3339}
3340
68dc0745
PP
3341DllExport int
3342win32_dup2(int fd1,int fd2)
0a753a76 3343{
390b85e7 3344 return dup2(fd1,fd2);
0a753a76
PP
3345}
3346
68dc0745 3347DllExport int
3e3baf6d 3348win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 3349{
390b85e7 3350 return read(fd, buf, cnt);
0a753a76
PP
3351}
3352
68dc0745 3353DllExport int
3e3baf6d 3354win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 3355{
390b85e7 3356 return write(fd, buf, cnt);
0a753a76
PP
3357}
3358
68dc0745 3359DllExport int
5aabfad6
PP
3360win32_mkdir(const char *dir, int mode)
3361{
acfe0abc 3362 dTHX;
7766f137 3363 return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
5aabfad6 3364}
96e4d5b1 3365
5aabfad6
PP
3366DllExport int
3367win32_rmdir(const char *dir)
3368{
acfe0abc 3369 dTHX;
7766f137 3370 return rmdir(PerlDir_mapA(dir));
5aabfad6 3371}
96e4d5b1 3372
5aabfad6
PP
3373DllExport int
3374win32_chdir(const char *dir)
3375{
9ec3348a
JH
3376 if (!dir) {
3377 errno = ENOENT;
3378 return -1;
3379 }
390b85e7 3380 return chdir(dir);
5aabfad6 3381}
96e4d5b1 3382
7766f137
GS
3383DllExport int
3384win32_access(const char *path, int mode)
3385{
acfe0abc 3386 dTHX;
7766f137
GS
3387 return access(PerlDir_mapA(path), mode);
3388}
3389
3390DllExport int
3391win32_chmod(const char *path, int mode)
3392{
acfe0abc 3393 dTHX;
7766f137
GS
3394 return chmod(PerlDir_mapA(path), mode);
3395}
3396
3397
0aaad0ff 3398static char *
dd7038b3 3399create_command_line(char *cname, STRLEN clen, const char * const *args)
0aaad0ff 3400{
2b01189b 3401 PERL_DEB(dTHX;)
b309b8ae
JH
3402 int index, argc;
3403 char *cmd, *ptr;
3404 const char *arg;
3405 STRLEN len = 0;
81bc1258 3406 bool bat_file = FALSE;
b309b8ae 3407 bool cmd_shell = FALSE;
7b11e424 3408 bool dumb_shell = FALSE;
b309b8ae 3409 bool extra_quotes = FALSE;
dd7038b3 3410 bool quote_next = FALSE;
81bc1258
JH
3411
3412 if (!cname)
3413 cname = (char*)args[0];
b309b8ae
JH
3414
3415 /* The NT cmd.exe shell has the following peculiarity that needs to be
3416 * worked around. It strips a leading and trailing dquote when any
3417 * of the following is true:
3418 * 1. the /S switch was used
3419 * 2. there are more than two dquotes
3420 * 3. there is a special character from this set: &<>()@^|
3421 * 4. no whitespace characters within the two dquotes
3422 * 5. string between two dquotes isn't an executable file
3423 * To work around this, we always add a leading and trailing dquote
3424 * to the string, if the first argument is either "cmd.exe" or "cmd",
3425 * and there were at least two or more arguments passed to cmd.exe
3426 * (not including switches).
dd7038b3
JH
3427 * XXX the above rules (from "cmd /?") don't seem to be applied
3428 * always, making for the convolutions below :-(
b309b8ae 3429 */
81bc1258 3430 if (cname) {
dd7038b3
JH
3431 if (!clen)
3432 clen = strlen(cname);
3433
81bc1258
JH
3434 if (clen > 4
3435 && (stricmp(&cname[clen-4], ".bat") == 0
8cbe99e5 3436 || (stricmp(&cname[clen-4], ".cmd") == 0)))
81bc1258
JH
3437 {
3438 bat_file = TRUE;
8cbe99e5 3439 len += 3;
81bc1258 3440 }
dd7038b3
JH
3441 else {
3442 char *exe = strrchr(cname, '/');
3443 char *exe2 = strrchr(cname, '\\');
3444 if (exe2 > exe)
3445 exe = exe2;
3446 if (exe)
3447 ++exe;
3448 else
3449 exe = cname;
3450 if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
3451 cmd_shell = TRUE;
3452 len += 3;
3453 }
7b11e424
JH
3454 else if (stricmp(exe, "command.com") == 0
3455 || stricmp(exe, "command") == 0)
3456 {
3457 dumb_shell = TRUE;
3458 }
81bc1258 3459 }
b309b8ae 3460 }
0aaad0ff 3461
b309b8ae
JH
3462 DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
3463 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3464 STRLEN curlen = strlen(arg);
3465 if (!(arg[0] == '"' && arg[curlen-1] == '"'))
3466 len += 2; /* assume quoting needed (worst case) */
3467 len += curlen + 1;
3468 DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
3469 }
3470 DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
0aaad0ff 3471
b309b8ae 3472 argc = index;
a02a5408 3473 Newx(cmd, len, char);
0aaad0ff 3474 ptr = cmd;
0aaad0ff 3475
8cbe99e5 3476 if (bat_file) {
81bc1258
JH
3477 *ptr++ = '"';
3478 extra_quotes = TRUE;
3479 }
3480
0aaad0ff 3481 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
b309b8ae
JH
3482 bool do_quote = 0;
3483 STRLEN curlen = strlen(arg);
3484
81bc1258
JH
3485 /* we want to protect empty arguments and ones with spaces with
3486 * dquotes, but only if they aren't already there */
7b11e424
JH
3487 if (!dumb_shell) {
3488 if (!curlen) {
3489 do_quote = 1;
3490 }
02ef22d5
JH
3491 else if (quote_next) {
3492 /* see if it really is multiple arguments pretending to
3493 * be one and force a set of quotes around it */
3494 if (*find_next_space(arg))
3495 do_quote = 1;
3496 }
7b11e424
JH
3497 else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
3498 STRLEN i = 0;
3499 while (i < curlen) {
3500 if (isSPACE(arg[i])) {
3501 do_quote = 1;
02ef22d5
JH
3502 }
3503 else if (arg[i] == '"') {
3504 do_quote = 0;
7b11e424
JH
3505 break;
3506 }
3507 i++;
b309b8ae 3508 }
b309b8ae 3509 }
dd7038b3 3510 }
b309b8ae
JH
3511
3512 if (do_quote)
3513 *ptr++ = '"';
3514
18a945d4 3515 strcpy(ptr, arg);
b309b8ae
JH
3516 ptr += curlen;
3517
3518 if (do_quote)
3519 *ptr++ = '"';
3520
3521 if (args[index+1])
3522 *ptr++ = ' ';
3523
81bc1258
JH
3524 if (!extra_quotes
3525 && cmd_shell
11998fdb
GS
3526 && curlen >= 2
3527 && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
3528 && stricmp(arg+curlen-2, "/c") == 0)
b309b8ae 3529 {
dd7038b3
JH
3530 /* is there a next argument? */
3531 if (args[index+1]) {
3532 /* are there two or more next arguments? */
3533 if (args[index+2]) {
3534 *ptr++ = '"';
3535 extra_quotes = TRUE;
3536 }
3537 else {
02ef22d5 3538 /* single argument, force quoting if it has spaces */
dd7038b3
JH
3539 quote_next = TRUE;
3540 }
3541 }
b309b8ae 3542 }
0aaad0ff
GS
3543 }
3544
b309b8ae
JH
3545 if (extra_quotes)
3546 *ptr++ = '"';
3547
3548 *ptr = '\0';
3549
0aaad0ff
GS
3550 return cmd;
3551}
3552
3553static char *
3554qualified_path(const char *cmd)
3555{
3556 char *pathstr;
3557 char *fullcmd, *curfullcmd;
3558 STRLEN cmdlen = 0;
3559 int has_slash = 0;
3560
3561 if (!cmd)
4e205ed6 3562 return NULL;
0aaad0ff
GS