This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add link for the Coverity perl5 project.
[perl5.git] / win32 / win32.c
CommitLineData
68dc0745 1/* WIN32.C
2 *
3fadfdf1 3 * (c) 1995 Microsoft Corporation. All rights reserved.
0d130a44 4 * Developed by hip communications inc.
68dc0745 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 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
41addb51
CB		 45
46#define PerlIO FILE
0a753a76 47
7a9ec5a3 48#include <sys/stat.h>
0a753a76 49#include "EXTERN.h"
50#include "perl.h"
c69f6586
GS		 51
52#define NO_XSLOCKS
c5be433b 53#define PERL_NO_GET_CONTEXT
ad2e33dc 54#include "XSUB.h"
c69f6586 55
0a753a76 56#include <fcntl.h>
5b0d9cbe
NIS		 57#ifndef __GNUC__
58/* assert.h conflicts with #define of assert in perl.h */
8cbe99e5 59# include <assert.h>
5b0d9cbe 60#endif
8cbe99e5 61
0a753a76 62#include <string.h>
63#include <stdarg.h>
ad2e33dc 64#include <float.h>
ad0751ec 65#include <time.h>
4eab039d 66#include <sys/utime.h>
8cbe99e5 67
5b0d9cbe 68#ifdef __GNUC__
3fadfdf1 69/* Mingw32 defaults to globing command line
5b0d9cbe
NIS		 70 * So we turn it off like this:
71 */
72int _CRT_glob = 0;
73#endif
74
7c5b6093
AB		 75#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
76/* Mingw32-1.1 is missing some prototypes */
d06fc7d4 77START_EXTERN_C
f8fb7c90
GS		 78FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
79FILE * _wfdopen(int nFd, LPCWSTR wszMode);
80FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
81int _flushall();
82int _fcloseall();
d06fc7d4 83END_EXTERN_C
2b260de0
GS		 84#endif
85
6890e559
GS		 86#define EXECF_EXEC 1
87#define EXECF_SPAWN 2
88#define EXECF_SPAWN_NOWAIT 3
89
32e30700 90#if defined(PERL_IMPLICIT_SYS)
32e30700
GS		 91# undef getlogin
92# define getlogin g_getlogin
93#endif
94
58d049f0
JD		 95/* VS2005 (MSC version 14) provides a mechanism to set an invalid
96 * parameter handler. This functionality is not available in the
97 * 64-bit compiler from the Platform SDK, which unfortunately also
98 * believes itself to be MSC version 14.
99 *
100 * There is no #define related to _set_invalid_parameter_handler(),
101 * but we can check for one of the constants defined for
102 * _set_abort_behavior(), which was introduced into stdlib.h at
103 * the same time.
104 */
105
106#if _MSC_VER >= 1400 && defined(_WRITE_ABORT_MSG)
107# define SET_INVALID_PARAMETER_HANDLER
108#endif
109
110#ifdef SET_INVALID_PARAMETER_HANDLER
d52ca586 111static BOOL set_silent_invalid_parameter_handler(BOOL newvalue);
e2cd629f
SH		 112static void my_invalid_parameter_handler(const wchar_t* expression,
113 const wchar_t* function, const wchar_t* file,
114 unsigned int line, uintptr_t pReserved);
115#endif
116
6937817d 117#ifndef WIN32_NO_REGISTRY
e2cd629f
SH		 118static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp);
119static char* get_regstr(const char *valuename, SV **svp);
6937817d
DD		 120#endif
121
e2cd629f
SH		 122static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
123 char *trailing, ...);
6937817d
DD		 124static char* win32_get_xlib(const char *pl,
125 WIN32_NO_REGISTRY_M_(const char *xlib)
e2cd629f 126 const char *libname, STRLEN *const len);
6937817d 127
e2cd629f
SH		 128static BOOL has_shell_metachars(const char *ptr);
129static long tokenize(const char *str, char **dest, char ***destv);
130static void get_shell(void);
131static char* find_next_space(const char *s);
132static int do_spawn2(pTHX_ const char *cmd, int exectype);
f06c8825
TC		 133static int do_spawn2_handles(pTHX_ const char *cmd, int exectype,
134 const int *handles);
135static int do_spawnvp_handles(int mode, const char *cmdname,
136 const char * const *argv, const int *handles);
aac983ac
TC		 137static PerlIO * do_popen(const char *mode, const char *command, IV narg,
138 SV **args);
04a2c3d9 139static long find_pid(pTHX_ int pid);
e2cd629f
SH		 140static void remove_dead_process(long child);
141static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
721b2674 142static int my_killpg(int pid, int sig);
e2cd629f
SH		 143static int my_kill(int pid, int sig);
144static void out_of_memory(void);
00a0ae28 145static char* wstr_to_str(const wchar_t* wstr);
e2cd629f
SH		 146static long filetime_to_clock(PFILETIME ft);
147static BOOL filetime_from_time(PFILETIME ft, time_t t);
148static char* create_command_line(char *cname, STRLEN clen,
aac983ac 149 const char * const *args);
f5fe1b19 150static char* qualified_path(const char *cmd, bool other_exts);
e2cd629f
SH		 151static void ansify_path(void);
152static LRESULT win32_process_message(HWND hwnd, UINT msg,
153 WPARAM wParam, LPARAM lParam);
154
155#ifdef USE_ITHREADS
04a2c3d9 156static long find_pseudo_pid(pTHX_ int pid);
e2cd629f
SH		 157static void remove_dead_pseudo_process(long child);
158static HWND get_hwnd_delay(pTHX, long child, DWORD tries);
159#endif
160
161#ifdef HAVE_INTERP_INTERN
162static void win32_csighandler(int sig);
163#endif
164
165START_EXTERN_C
166HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
167char w32_module_name[MAX_PATH+1];
b47a847f
DD		 168#ifdef WIN32_DYN_IOINFO_SIZE
169Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
170#endif
e2cd629f
SH		 171END_EXTERN_C
172
173static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
174
6937817d 175#ifndef WIN32_NO_REGISTRY
0517ed38
DD		 176/* initialized by Perl_win32_init/PERL_SYS_INIT */
177static HKEY HKCU_Perl_hnd;
178static HKEY HKLM_Perl_hnd;
6937817d 179#endif
0517ed38 180
e2cd629f 181#ifdef SET_INVALID_PARAMETER_HANDLER
d52ca586
SH		 182static BOOL silent_invalid_parameter_handler = FALSE;
183
184static BOOL
185set_silent_invalid_parameter_handler(BOOL newvalue)
186{
d52ca586 187 BOOL oldvalue = silent_invalid_parameter_handler;
adb86be5 188# ifdef _DEBUG
d52ca586 189 silent_invalid_parameter_handler = newvalue;
d52ca586 190# endif
adb86be5 191 return oldvalue;
d52ca586
SH		 192}
193
e2cd629f
SH		 194static void
195my_invalid_parameter_handler(const wchar_t* expression,
0448a0bd
SH		 196 const wchar_t* function,
197 const wchar_t* file,
198 unsigned int line,
199 uintptr_t pReserved)
200{
201# ifdef _DEBUG
00a0ae28
SH		 202 char* ansi_expression;
203 char* ansi_function;
204 char* ansi_file;
d52ca586
SH		 205 if (silent_invalid_parameter_handler)
206 return;
00a0ae28
SH		 207 ansi_expression = wstr_to_str(expression);
208 ansi_function = wstr_to_str(function);
209 ansi_file = wstr_to_str(file);
210 fprintf(stderr, "Invalid parameter detected in function %s. "
211 "File: %s, line: %d\n", ansi_function, ansi_file, line);
212 fprintf(stderr, "Expression: %s\n", ansi_expression);
213 free(ansi_expression);
214 free(ansi_function);
215 free(ansi_file);
0448a0bd
SH		 216# endif
217}
218#endif
219
2fa86c13
GS		 220EXTERN_C void
221set_w32_module_name(void)
222{
aa2b96ec 223 /* this function may be called at DLL_PROCESS_ATTACH time */
2fa86c13 224 char* ptr;
aa2b96ec
JD		 225 HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
226 ? GetModuleHandle(NULL)
227 : w32_perldll_handle);
2fa86c13 228
0e7b7035
SH		 229 WCHAR modulename[MAX_PATH];
230 WCHAR fullname[MAX_PATH];
231 char *ansi;
232
233 DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
234 (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
235 GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
236
237 GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
238
239 /* Make sure we get an absolute pathname in case the module was loaded
240 * explicitly by LoadLibrary() with a relative path. */
241 GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
242
243 /* Make sure we start with the long path name of the module because we
244 * later scan for pathname components to match "5.xx" to locate
245 * compatible sitelib directories, and the short pathname might mangle
246 * this path segment (e.g. by removing the dot on NTFS to something
247 * like "5xx~1.yy") */
248 if (pfnGetLongPathNameW)
249 pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
250
251 /* remove \\?\ prefix */
252 if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
253 memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
254
255 ansi = win32_ansipath(fullname);
256 my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
257 win32_free(ansi);
2fa86c13
GS		 258
259 /* normalize to forward slashes */
260 ptr = w32_module_name;
261 while (*ptr) {
262 if (*ptr == '\\')
263 *ptr = '/';
264 ++ptr;
265 }
266}
267
6937817d 268#ifndef WIN32_NO_REGISTRY
c5be433b 269/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 270static char*
0517ed38 271get_regstr_from(HKEY handle, const char *valuename, SV **svp)
349ad1fe
GS		 272{
273 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
00dc2f4f 274 DWORD type;
4e205ed6 275 char *str = NULL;
00dc2f4f 276 long retval;
0517ed38 277 DWORD datalen;
00dc2f4f 278
0517ed38
DD		 279 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
280 if (retval == ERROR_SUCCESS
281 && (type == REG_SZ || type == REG_EXPAND_SZ))
282 {
283 dTHX;
284 if (!*svp)
285 *svp = sv_2mortal(newSVpvs(""));
286 SvGROW(*svp, datalen);
287 retval = RegQueryValueEx(handle, valuename, 0, NULL,
288 (PBYTE)SvPVX(*svp), &datalen);
289 if (retval == ERROR_SUCCESS) {
290 str = SvPVX(*svp);
291 SvCUR_set(*svp,datalen-1);
00dc2f4f 292 }
00dc2f4f 293 }
349ad1fe 294 return str;
00dc2f4f
GS		 295}
296
c5be433b 297/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 298static char*
c5be433b 299get_regstr(const char *valuename, SV **svp)
00dc2f4f 300{
0517ed38
DD		 301 char *str;
302 if (HKCU_Perl_hnd) {
303 str = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
304 if (!str)
305 goto try_HKLM;
306 }
307 else {
308 try_HKLM:
309 if (HKLM_Perl_hnd)
310 str = get_regstr_from(HKLM_Perl_hnd, valuename, svp);
311 else
312 str = NULL;
313 }
349ad1fe 314 return str;
00dc2f4f 315}
6937817d 316#endif /* ifndef WIN32_NO_REGISTRY */
00dc2f4f 317
c5be433b 318/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
e5a95ffb 319static char *
e6a0bbf8 320get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
00dc2f4f 321{
dc9e4912 322 char base[10];
e5a95ffb 323 va_list ap;
e24c7c18 324 char mod_name[MAX_PATH+1];
00dc2f4f 325 char *ptr;
e5a95ffb
GS		 326 char *optr;
327 char *strip;
273cf8d1 328 STRLEN baselen;
e5a95ffb
GS		 329
330 va_start(ap, trailing_path);
331 strip = va_arg(ap, char *);
332
273cf8d1
GS		 333 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
334 baselen = strlen(base);
dc9e4912 335
8ac9c18d 336 if (!*w32_module_name) {
2fa86c13 337 set_w32_module_name();
95140b98 338 }
8ac9c18d 339 strcpy(mod_name, w32_module_name);
95140b98 340 ptr = strrchr(mod_name, '/');
e5a95ffb
GS		 341 while (ptr && strip) {
342 /* look for directories to skip back */
343 optr = ptr;
00dc2f4f 344 *ptr = '\0';
95140b98 345 ptr = strrchr(mod_name, '/');
1c39adb2
GS		 346 /* avoid stripping component if there is no slash,
347 * or it doesn't match ... */
e5a95ffb 348 if (!ptr || stricmp(ptr+1, strip) != 0) {
273cf8d1 349 /* ... but not if component matches m|5\.$patchlevel.*| */
1c39adb2 350 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
273cf8d1
GS		 351 && strncmp(strip, base, baselen) == 0
352 && strncmp(ptr+1, base, baselen) == 0))
95140b98
GS		 353 {
354 *optr = '/';
80252599
GS		 355 ptr = optr;
356 }
00dc2f4f 357 }
e5a95ffb 358 strip = va_arg(ap, char *);
00dc2f4f 359 }
e5a95ffb
GS		 360 if (!ptr) {
361 ptr = mod_name;
362 *ptr++ = '.';
95140b98 363 *ptr = '/';
00dc2f4f 364 }
e5a95ffb
GS		 365 va_end(ap);
366 strcpy(++ptr, trailing_path);
367
dc9e4912 368 /* only add directory if it exists */
349ad1fe 369 if (GetFileAttributes(mod_name) != (DWORD) -1) {
dc9e4912 370 /* directory exists */
acfe0abc 371 dTHX;
c5be433b 372 if (!*prev_pathp)
c2b90b61 373 *prev_pathp = sv_2mortal(newSVpvs(""));
f0c8bec2 374 else if (SvPVX(*prev_pathp))
46e2868e 375 sv_catpvs(*prev_pathp, ";");
c5be433b 376 sv_catpv(*prev_pathp, mod_name);
e6a0bbf8
NC		 377 if(len)
378 *len = SvCUR(*prev_pathp);
c5be433b 379 return SvPVX(*prev_pathp);
00dc2f4f 380 }
00dc2f4f 381
4e205ed6 382 return NULL;
00dc2f4f
GS		 383}
384
73f2c082 385EXTERN_C char *
6937817d 386win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
00dc2f4f 387{
e5a95ffb 388 char *stdlib = "lib";
4e205ed6 389 SV *sv = NULL;
6937817d
DD		 390#ifndef WIN32_NO_REGISTRY
391 char buffer[MAX_PATH+1];
00dc2f4f 392
e5a95ffb
GS		 393 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
394 sprintf(buffer, "%s-%s", stdlib, pl);
c5be433b
GS		 395 if (!get_regstr(buffer, &sv))
396 (void)get_regstr(stdlib, &sv);
6937817d 397#endif
00dc2f4f 398
e5a95ffb 399 /* $stdlib .= ";$EMD/../../lib" */
e6a0bbf8 400 return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
00dc2f4f
GS		 401}
402
4ea817c6 403static char *
6937817d
DD		 404win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
405 const char *libname, STRLEN *const len)
00dc2f4f 406{
6937817d 407#ifndef WIN32_NO_REGISTRY
e5a95ffb 408 char regstr[40];
6937817d 409#endif
e24c7c18 410 char pathstr[MAX_PATH+1];
4e205ed6
SP		 411 SV *sv1 = NULL;
412 SV *sv2 = NULL;
00dc2f4f 413
6937817d 414#ifndef WIN32_NO_REGISTRY
4ea817c6
GS		 415 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
416 sprintf(regstr, "%s-%s", xlib, pl);
c5be433b 417 (void)get_regstr(regstr, &sv1);
6937817d 418#endif
e5a95ffb 419
4ea817c6
GS		 420 /* $xlib .=
421 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
422 sprintf(pathstr, "%s/%s/lib", libname, pl);
e6a0bbf8 423 (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
00dc2f4f 424
6937817d 425#ifndef WIN32_NO_REGISTRY
4ea817c6
GS		 426 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
427 (void)get_regstr(xlib, &sv2);
6937817d 428#endif
00dc2f4f 429
4ea817c6
GS		 430 /* $xlib .=
431 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
432 sprintf(pathstr, "%s/lib", libname);
e6a0bbf8 433 (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
e5a95ffb 434
51371543 435 if (!sv1 && !sv2)
4e205ed6 436 return NULL;
e6a0bbf8
NC		 437 if (!sv1) {
438 sv1 = sv2;
439 } else if (sv2) {
04a2c3d9 440 dTHX;
46e2868e 441 sv_catpv(sv1, ";");
e6a0bbf8
NC		 442 sv_catsv(sv1, sv2);
443 }
e5a95ffb 444
e6a0bbf8
NC		 445 if (len)
446 *len = SvCUR(sv1);
349ad1fe 447 return SvPVX(sv1);
68dc0745 448}
0a753a76 449
73f2c082 450EXTERN_C char *
e6a0bbf8 451win32_get_sitelib(const char *pl, STRLEN *const len)
4ea817c6 452{
6937817d 453 return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("sitelib") "site", len);
4ea817c6
GS		 454}
455
456#ifndef PERL_VENDORLIB_NAME
457# define PERL_VENDORLIB_NAME "vendor"
458#endif
459
73f2c082 460EXTERN_C char *
e6a0bbf8 461win32_get_vendorlib(const char *pl, STRLEN *const len)
4ea817c6 462{
6937817d 463 return win32_get_xlib(pl, WIN32_NO_REGISTRY_M_("vendorlib") PERL_VENDORLIB_NAME, len);
4ea817c6 464}
b4793f7f 465
2d7a9237 466static BOOL
08039b81 467has_shell_metachars(const char *ptr)
68dc0745 468{
469 int inquote = 0;
470 char quote = '\0';
471
472 /*
473 * Scan string looking for redirection (< or >) or pipe
e200fe59
JD		 474 * characters (|) that are not in a quoted string.
475 * Shell variable interpolation (%VAR%) can also happen inside strings.
68dc0745 476 */
9404a519 477 while (*ptr) {
68dc0745 478 switch(*ptr) {
e200fe59
JD		 479 case '%':
480 return TRUE;
68dc0745 481 case '\'':
482 case '\"':
9404a519
GS		 483 if (inquote) {
484 if (quote == *ptr) {
68dc0745 485 inquote = 0;
486 quote = '\0';
0a753a76 487 }
68dc0745 488 }
489 else {
490 quote = *ptr;
491 inquote++;
492 }
493 break;
494 case '>':
495 case '<':
496 case '|':
9404a519 497 if (!inquote)
68dc0745 498 return TRUE;
499 default:
500 break;
0a753a76 501 }
68dc0745 502 ++ptr;
503 }
504 return FALSE;
0a753a76 505}
506
32e30700 507#if !defined(PERL_IMPLICIT_SYS)
68dc0745 508/* since the current process environment is being updated in util.c
509 * the library functions will get the correct environment
510 */
511PerlIO *
79d39d80 512Perl_my_popen(pTHX_ const char *cmd, const char *mode)
0a753a76 513{
45bc9206 514 PERL_FLUSHALL_FOR_CHILD;
0a753a76 515 return win32_popen(cmd, mode);
0a753a76 516}
517
68dc0745 518long
4f63d024 519Perl_my_pclose(pTHX_ PerlIO *fp)
0a753a76 520{
521 return win32_pclose(fp);
522}
c69f6586 523#endif
0a753a76 524
0cb96387
GS		 525DllExport unsigned long
526win32_os_id(void)
0a753a76 527{
aeecf691 528 return (unsigned long)g_osver.dwPlatformId;
0a753a76 529}
530
7766f137
GS		 531DllExport int
532win32_getpid(void)
533{
534#ifdef USE_ITHREADS
acfe0abc 535 dTHX;
7766f137
GS		 536 if (w32_pseudo_id)
537 return -((int)w32_pseudo_id);
538#endif
8cbe99e5 539 return _getpid();
7766f137
GS		 540}
541
ce1da67e
GS		 542/* Tokenize a string. Words are null-separated, and the list
543 * ends with a doubled null. Any character (except null and
544 * including backslash) may be escaped by preceding it with a
545 * backslash (the backslash will be stripped).
546 * Returns number of words in result buffer.
547 */
548static long
dff6d3cd 549tokenize(const char *str, char **dest, char ***destv)
ce1da67e 550{
4e205ed6 551 char *retstart = NULL;
ce1da67e
GS		 552 char **retvstart = 0;
553 int items = -1;
554 if (str) {
555 int slen = strlen(str);
eb578fdb
KW		 556 char *ret;
557 char **retv;
a02a5408
JC		 558 Newx(ret, slen+2, char);
559 Newx(retv, (slen+3)/2, char*);
ce1da67e
GS		 560
561 retstart = ret;
562 retvstart = retv;
563 *retv = ret;
564 items = 0;
565 while (*str) {
566 *ret = *str++;
567 if (*ret == '\\' && *str)
568 *ret = *str++;
569 else if (*ret == ' ') {
570 while (*str == ' ')
571 str++;
572 if (ret == retstart)
573 ret--;
574 else {
575 *ret = '\0';
576 ++items;
577 if (*str)
578 *++retv = ret+1;
579 }
580 }
581 else if (!*str)
582 ++items;
583 ret++;
584 }
4e205ed6 585 retvstart[items] = NULL;
ce1da67e
GS		 586 *ret++ = '\0';
587 *ret = '\0';
588 }
589 *dest = retstart;
590 *destv = retvstart;
591 return items;
592}
593
594static void
2d7a9237 595get_shell(void)
0a753a76 596{
acfe0abc 597 dTHX;
ce1da67e 598 if (!w32_perlshell_tokens) {
174c211a
GS		 599 /* we don't use COMSPEC here for two reasons:
600 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
601 * uncontrolled unportability of the ensuing scripts.
602 * 2. PERL5SHELL could be set to a shell that may not be fit for
603 * interactive use (which is what most programs look in COMSPEC
604 * for).
605 */
8cbe99e5 606 const char* defaultshell = "cmd.exe /x/d/c";
2fb9ab56 607 const char *usershell = PerlEnv_getenv("PERL5SHELL");
ce1da67e
GS		 608 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
609 &w32_perlshell_tokens,
610 &w32_perlshell_vec);
68dc0745 611 }
0a753a76 612}
613
68dc0745 614int
54725af6 615Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
0a753a76 616{
68dc0745 617 char **argv;
2d7a9237 618 char *str;
68dc0745 619 int status;
2d7a9237 620 int flag = P_WAIT;
68dc0745 621 int index = 0;
68dc0745 622
7918f24d
NC		 623 PERL_ARGS_ASSERT_DO_ASPAWN;
624
2d7a9237
GS		 625 if (sp <= mark)
626 return -1;
68dc0745 627
ce1da67e 628 get_shell();
a02a5408 629 Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS		 630
631 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
632 ++mark;
633 flag = SvIVx(*mark);
68dc0745 634 }
635
9404a519 636 while (++mark <= sp) {
bb897dfc 637 if (*mark && (str = SvPV_nolen(*mark)))
2d7a9237
GS		 638 argv[index++] = str;
639 else
640 argv[index++] = "";
68dc0745 641 }
642 argv[index++] = 0;
3fadfdf1 643
2d7a9237 644 status = win32_spawnvp(flag,
bb897dfc 645 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS		 646 (const char* const*)argv);
647
80252599 648 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
2d7a9237 649 /* possible shell-builtin, invoke with shell */
ce1da67e
GS		 650 int sh_items;
651 sh_items = w32_perlshell_items;
2d7a9237
GS		 652 while (--index >= 0)
653 argv[index+sh_items] = argv[index];
ce1da67e
GS		 654 while (--sh_items >= 0)
655 argv[sh_items] = w32_perlshell_vec[sh_items];
3fadfdf1 656
2d7a9237 657 status = win32_spawnvp(flag,
bb897dfc 658 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS		 659 (const char* const*)argv);
660 }
68dc0745 661
922b1888 662 if (flag == P_NOWAIT) {
40c7cc6d 663 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS		 664 }
665 else {
50892819 666 if (status < 0) {
0453d815 667 if (ckWARN(WARN_EXEC))
f98bc0c6 668 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
50892819
GS		 669 status = 255 * 256;
670 }
671 else
672 status *= 256;
b28d0864 673 PL_statusvalue = status;
5aabfad6 674 }
ce1da67e 675 Safefree(argv);
50892819 676 return (status);
68dc0745 677}
678
dd7038b3
JH		 679/* returns pointer to the next unquoted space or the end of the string */
680static char*
681find_next_space(const char *s)
682{
683 bool in_quotes = FALSE;
684 while (*s) {
685 /* ignore doubled backslashes, or backslash+quote */
686 if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
687 s += 2;
688 }
689 /* keep track of when we're within quotes */
690 else if (*s == '"') {
691 s++;
692 in_quotes = !in_quotes;
693 }
694 /* break it up only at spaces that aren't in quotes */
695 else if (!in_quotes && isSPACE(*s))
696 return (char*)s;
697 else
698 s++;
699 }
700 return (char*)s;
701}
702
54725af6 703static int
f06c8825
TC		 704do_spawn2(pTHX_ const char *cmd, int exectype) {
705 return do_spawn2_handles(aTHX_ cmd, exectype, NULL);
706}
707
708static int
709do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles)
68dc0745 710{
711 char **a;
712 char *s;
713 char **argv;
714 int status = -1;
715 BOOL needToTry = TRUE;
2d7a9237 716 char *cmd2;
68dc0745 717
2d7a9237
GS		 718 /* Save an extra exec if possible. See if there are shell
719 * metacharacters in it */
e200fe59 720 if (!has_shell_metachars(cmd)) {
a02a5408
JC		 721 Newx(argv, strlen(cmd) / 2 + 2, char*);
722 Newx(cmd2, strlen(cmd) + 1, char);
68dc0745 723 strcpy(cmd2, cmd);
724 a = argv;
725 for (s = cmd2; *s;) {
de030af3 726 while (*s && isSPACE(*s))
68dc0745 727 s++;
728 if (*s)
729 *(a++) = s;
dd7038b3 730 s = find_next_space(s);
9404a519 731 if (*s)
68dc0745 732 *s++ = '\0';
0a753a76 733 }
4e205ed6 734 *a = NULL;
ce1da67e 735 if (argv[0]) {
6890e559
GS		 736 switch (exectype) {
737 case EXECF_SPAWN:
738 status = win32_spawnvp(P_WAIT, argv[0],
739 (const char* const*)argv);
740 break;
741 case EXECF_SPAWN_NOWAIT:
f06c8825
TC		 742 status = do_spawnvp_handles(P_NOWAIT, argv[0],
743 (const char* const*)argv, handles);
6890e559
GS		 744 break;
745 case EXECF_EXEC:
746 status = win32_execvp(argv[0], (const char* const*)argv);
747 break;
748 }
2d7a9237 749 if (status != -1 || errno == 0)
68dc0745 750 needToTry = FALSE;
0a753a76 751 }
0a753a76 752 Safefree(argv);
68dc0745 753 Safefree(cmd2);
754 }
2d7a9237 755 if (needToTry) {
ce1da67e
GS		 756 char **argv;
757 int i = -1;
758 get_shell();
a02a5408 759 Newx(argv, w32_perlshell_items + 2, char*);
ce1da67e
GS		 760 while (++i < w32_perlshell_items)
761 argv[i] = w32_perlshell_vec[i];
08039b81 762 argv[i++] = (char *)cmd;
4e205ed6 763 argv[i] = NULL;
6890e559
GS		 764 switch (exectype) {
765 case EXECF_SPAWN:
766 status = win32_spawnvp(P_WAIT, argv[0],
767 (const char* const*)argv);
768 break;
769 case EXECF_SPAWN_NOWAIT:
f06c8825
TC		 770 status = do_spawnvp_handles(P_NOWAIT, argv[0],
771 (const char* const*)argv, handles);
6890e559
GS		 772 break;
773 case EXECF_EXEC:
774 status = win32_execvp(argv[0], (const char* const*)argv);
775 break;
776 }
ce1da67e
GS		 777 cmd = argv[0];
778 Safefree(argv);
68dc0745 779 }
922b1888 780 if (exectype == EXECF_SPAWN_NOWAIT) {
40c7cc6d 781 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS		 782 }
783 else {
50892819 784 if (status < 0) {
0453d815 785 if (ckWARN(WARN_EXEC))
f98bc0c6 786 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
50892819
GS		 787 (exectype == EXECF_EXEC ? "exec" : "spawn"),
788 cmd, strerror(errno));
789 status = 255 * 256;
790 }
791 else
792 status *= 256;
b28d0864 793 PL_statusvalue = status;
5aabfad6 794 }
50892819 795 return (status);
0a753a76 796}
797
6890e559 798int
54725af6 799Perl_do_spawn(pTHX_ char *cmd)
6890e559 800{
7918f24d
NC		 801 PERL_ARGS_ASSERT_DO_SPAWN;
802
54725af6 803 return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
6890e559
GS		 804}
805
2d7a9237 806int
54725af6 807Perl_do_spawn_nowait(pTHX_ char *cmd)
2d7a9237 808{
7918f24d
NC		 809 PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
810
54725af6 811 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
2d7a9237
GS		 812}
813
6890e559 814bool
79d39d80 815Perl_do_exec(pTHX_ const char *cmd)
6890e559 816{
7918f24d
NC		 817 PERL_ARGS_ASSERT_DO_EXEC;
818
08039b81 819 do_spawn2(aTHX_ cmd, EXECF_EXEC);
6890e559
GS		 820 return FALSE;
821}
822
68dc0745 823/* The idea here is to read all the directory names into a string table
824 * (separated by nulls) and when one of the other dir functions is called
825 * return the pointer to the current file name.
826 */
c5be433b 827DllExport DIR *
0e06f75d 828win32_opendir(const char *filename)
0a753a76 829{
04a2c3d9 830 dTHXa(NULL);
95136add 831 DIR *dirp;
9404a519
GS		 832 long len;
833 long idx;
834 char scanname[MAX_PATH+3];
8cbe99e5 835 WCHAR wscanname[sizeof(scanname)];
35cf1ab6 836 WIN32_FIND_DATAW wFindData;
35cf1ab6 837 char buffer[MAX_PATH*2];
8cbe99e5 838 BOOL use_default;
9404a519
GS		 839
840 len = strlen(filename);
525f9ba8
AD		 841 if (len == 0) {
842 errno = ENOENT;
9404a519 843 return NULL;
525f9ba8
AD		 844 }
845 if (len > MAX_PATH) {
846 errno = ENAMETOOLONG;
24caa93f 847 return NULL;
525f9ba8
AD		 848 }
849
68dc0745 850 /* Get us a DIR structure */
a02a5408 851 Newxz(dirp, 1, DIR);
68dc0745 852
853 /* Create the search pattern */
854 strcpy(scanname, filename);
23db2e2d
GS		 855
856 /* bare drive name means look in cwd for drive */
857 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
858 scanname[len++] = '.';
859 scanname[len++] = '/';
860 }
861 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
9404a519 862 scanname[len++] = '/';
23db2e2d 863 }
9404a519
GS		 864 scanname[len++] = '*';
865 scanname[len] = '\0';
68dc0745 866
867 /* do the FindFirstFile call */
8cbe99e5 868 MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
04a2c3d9 869 aTHXa(PERL_GET_THX);
8cbe99e5
JD		 870 dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
871
8c56068e 872 if (dirp->handle == INVALID_HANDLE_VALUE) {
95136add 873 DWORD err = GetLastError();
21e72512 874 /* FindFirstFile() fails on empty drives! */
95136add
GS		 875 switch (err) {
876 case ERROR_FILE_NOT_FOUND:
877 return dirp;
878 case ERROR_NO_MORE_FILES:
879 case ERROR_PATH_NOT_FOUND:
880 errno = ENOENT;
881 break;
882 case ERROR_NOT_ENOUGH_MEMORY:
883 errno = ENOMEM;
884 break;
885 default:
886 errno = EINVAL;
887 break;
888 }
889 Safefree(dirp);
68dc0745 890 return NULL;
891 }
892
8cbe99e5
JD		 893 use_default = FALSE;
894 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
895 wFindData.cFileName, -1,
896 buffer, sizeof(buffer), NULL, &use_default);
897 if (use_default && *wFindData.cAlternateFileName) {
35cf1ab6 898 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
8cbe99e5
JD		 899 wFindData.cAlternateFileName, -1,
900 buffer, sizeof(buffer), NULL, NULL);
35cf1ab6 901 }
8cbe99e5 902
68dc0745 903 /* now allocate the first part of the string table for
904 * the filenames that we find.
905 */
8cbe99e5 906 idx = strlen(buffer)+1;
95136add 907 if (idx < 256)
35cf1ab6 908 dirp->size = 256;
95136add
GS		 909 else
910 dirp->size = idx;
a02a5408 911 Newx(dirp->start, dirp->size, char);
8cbe99e5 912 strcpy(dirp->start, buffer);
95136add
GS		 913 dirp->nfiles++;
914 dirp->end = dirp->curr = dirp->start;
915 dirp->end += idx;
916 return dirp;
0a753a76 917}
918
919
68dc0745 920/* Readdir just returns the current string pointer and bumps the
921 * string pointer to the nDllExport entry.
922 */
c5be433b 923DllExport struct direct *
ce2e26e5 924win32_readdir(DIR *dirp)
0a753a76 925{
95136add 926 long len;
0a753a76 927
68dc0745 928 if (dirp->curr) {
929 /* first set up the structure to return */
930 len = strlen(dirp->curr);
0f38926b 931 strcpy(dirp->dirstr.d_name, dirp->curr);
68dc0745 932 dirp->dirstr.d_namlen = len;
0a753a76 933
68dc0745 934 /* Fake an inode */
0f38926b 935 dirp->dirstr.d_ino = dirp->curr - dirp->start;
0a753a76 936
95136add 937 /* Now set up for the next call to readdir */
68dc0745 938 dirp->curr += len + 1;
95136add 939 if (dirp->curr >= dirp->end) {
35cf1ab6 940 BOOL res;
35cf1ab6 941 char buffer[MAX_PATH*2];
95136add 942
60b22aca
JD		 943 if (dirp->handle == INVALID_HANDLE_VALUE) {
944 res = 0;
945 }
95136add
GS		 946 /* finding the next file that matches the wildcard
947 * (which should be all of them in this directory!).
95136add 948 */
8cbe99e5 949 else {
35cf1ab6
JD		 950 WIN32_FIND_DATAW wFindData;
951 res = FindNextFileW(dirp->handle, &wFindData);
952 if (res) {
953 BOOL use_default = FALSE;
954 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
955 wFindData.cFileName, -1,
956 buffer, sizeof(buffer), NULL, &use_default);
957 if (use_default && *wFindData.cAlternateFileName) {
958 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
959 wFindData.cAlternateFileName, -1,
960 buffer, sizeof(buffer), NULL, NULL);
961 }
35cf1ab6
JD		 962 }
963 }
95136add 964 if (res) {
0f38926b 965 long endpos = dirp->end - dirp->start;
8cbe99e5 966 long newsize = endpos + strlen(buffer) + 1;
95136add 967 /* bump the string table size by enough for the
022735b4 968 * new name and its null terminator */
0f38926b
GS		 969 while (newsize > dirp->size) {
970 long curpos = dirp->curr - dirp->start;
95136add
GS		 971 dirp->size *= 2;
972 Renew(dirp->start, dirp->size, char);
0f38926b 973 dirp->curr = dirp->start + curpos;
95136add 974 }
8cbe99e5 975 strcpy(dirp->start + endpos, buffer);
0f38926b 976 dirp->end = dirp->start + newsize;
95136add
GS		 977 dirp->nfiles++;
978 }
60b22aca 979 else {
95136add 980 dirp->curr = NULL;
60b22aca
JD		 981 if (dirp->handle != INVALID_HANDLE_VALUE) {
982 FindClose(dirp->handle);
983 dirp->handle = INVALID_HANDLE_VALUE;
984 }
985 }
68dc0745 986 }
68dc0745 987 return &(dirp->dirstr);
3fadfdf1 988 }
68dc0745 989 else
990 return NULL;
0a753a76 991}
992
68dc0745 993/* Telldir returns the current string pointer position */
c5be433b 994DllExport long
ce2e26e5 995win32_telldir(DIR *dirp)
0a753a76 996{
60b22aca 997 return dirp->curr ? (dirp->curr - dirp->start) : -1;
0a753a76 998}
999
1000
68dc0745 1001/* Seekdir moves the string pointer to a previously saved position
95136add 1002 * (returned by telldir).
68dc0745 1003 */
c5be433b 1004DllExport void
ce2e26e5 1005win32_seekdir(DIR *dirp, long loc)
0a753a76 1006{
60b22aca 1007 dirp->curr = loc == -1 ? NULL : dirp->start + loc;
0a753a76 1008}
1009
68dc0745 1010/* Rewinddir resets the string pointer to the start */
c5be433b 1011DllExport void
ce2e26e5 1012win32_rewinddir(DIR *dirp)
0a753a76 1013{
1014 dirp->curr = dirp->start;
1015}
1016
68dc0745 1017/* free the memory allocated by opendir */
c5be433b 1018DllExport int
ce2e26e5 1019win32_closedir(DIR *dirp)
0a753a76 1020{
95136add 1021 if (dirp->handle != INVALID_HANDLE_VALUE)
0f38926b 1022 FindClose(dirp->handle);
0a753a76 1023 Safefree(dirp->start);
1024 Safefree(dirp);
68dc0745 1025 return 1;
0a753a76 1026}
1027
60b22aca
JD		 1028/* duplicate a open DIR* for interpreter cloning */
1029DllExport DIR *
1030win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
1031{
1032 dVAR;
1033 PerlInterpreter *const from = param->proto_perl;
f76b679e 1034 PerlInterpreter *const to = (PerlInterpreter *)PERL_GET_THX;
60b22aca
JD		 1035
1036 long pos;
1037 DIR *dup;
1038
1039 /* switch back to original interpreter because win32_readdir()
1040 * might Renew(dirp->start).
1041 */
1042 if (from != to) {
1043 PERL_SET_THX(from);
1044 }
1045
1046 /* mark current position; read all remaining entries into the
1047 * cache, and then restore to current position.
1048 */
1049 pos = win32_telldir(dirp);
1050 while (win32_readdir(dirp)) {
1051 /* read all entries into cache */
1052 }
1053 win32_seekdir(dirp, pos);
1054
1055 /* switch back to new interpreter to allocate new DIR structure */
1056 if (from != to) {
1057 PERL_SET_THX(to);
1058 }
1059
1060 Newx(dup, 1, DIR);
1061 memcpy(dup, dirp, sizeof(DIR));
1062
1063 Newx(dup->start, dirp->size, char);
1064 memcpy(dup->start, dirp->start, dirp->size);
1065
1066 dup->end = dup->start + (dirp->end - dirp->start);
1067 if (dirp->curr)
1068 dup->curr = dup->start + (dirp->curr - dirp->start);
1069
1070 return dup;
1071}
0a753a76 1072
68dc0745 1073/*
1074 * various stubs
1075 */
0a753a76 1076
1077
68dc0745 1078/* Ownership
1079 *
1080 * Just pretend that everyone is a superuser. NT will let us know if
1081 * we don\'t really have permission to do something.
1082 */
0a753a76 1083
1084#define ROOT_UID ((uid_t)0)
1085#define ROOT_GID ((gid_t)0)
1086
68dc0745 1087uid_t
1088getuid(void)
0a753a76 1089{
68dc0745 1090 return ROOT_UID;
0a753a76 1091}
1092
68dc0745 1093uid_t
1094geteuid(void)
0a753a76 1095{
68dc0745 1096 return ROOT_UID;
0a753a76 1097}
1098
68dc0745 1099gid_t
1100getgid(void)
0a753a76 1101{
68dc0745 1102 return ROOT_GID;
0a753a76 1103}
1104
68dc0745 1105gid_t
1106getegid(void)
0a753a76 1107{
68dc0745 1108 return ROOT_GID;
0a753a76 1109}
1110
68dc0745 1111int
22239a37 1112setuid(uid_t auid)
3fadfdf1 1113{
22239a37 1114 return (auid == ROOT_UID ? 0 : -1);
0a753a76 1115}
1116
68dc0745 1117int
22239a37 1118setgid(gid_t agid)
0a753a76 1119{
22239a37 1120 return (agid == ROOT_GID ? 0 : -1);
0a753a76 1121}
1122
73f2c082 1123EXTERN_C char *
e34ffe5a
GS		 1124getlogin(void)
1125{
acfe0abc 1126 dTHX;
3352bfcb
GS		 1127 char *buf = w32_getlogin_buffer;
1128 DWORD size = sizeof(w32_getlogin_buffer);
e34ffe5a
GS		 1129 if (GetUserName(buf,&size))
1130 return buf;
1131 return (char*)NULL;
1132}
1133
b990f8c8
GS		 1134int
1135chown(const char *path, uid_t owner, gid_t group)
1136{
1137 /* XXX noop */
1c1c7f20 1138 return 0;
b990f8c8
GS		 1139}
1140
00b02797
JH		 1141/*
1142 * XXX this needs strengthening (for PerlIO)
1143 * -- BKS, 11-11-200
1144*/
f33b2f58 1145#if !defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4
00b02797
JH		 1146int mkstemp(const char *path)
1147{
1148 dTHX;
1149 char buf[MAX_PATH+1];
1150 int i = 0, fd = -1;
1151
1152retry:
1153 if (i++ > 10) { /* give up */
1154 errno = ENOENT;
1155 return -1;
1156 }
1157 if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1158 errno = ENOENT;
1159 return -1;
1160 }
1161 fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1162 if (fd == -1)
1163 goto retry;
1164 return fd;
1165}
f33b2f58 1166#endif
00b02797 1167
0aaad0ff 1168static long
04a2c3d9 1169find_pid(pTHX_ int pid)
0a753a76 1170{
7766f137
GS		 1171 long child = w32_num_children;
1172 while (--child >= 0) {
eb160463 1173 if ((int)w32_child_pids[child] == pid)
0aaad0ff
GS		 1174 return child;
1175 }
1176 return -1;
1177}
1178
1179static void
1180remove_dead_process(long child)
1181{
1182 if (child >= 0) {
acfe0abc 1183 dTHX;
0aaad0ff 1184 CloseHandle(w32_child_handles[child]);
c00206c8 1185 Move(&w32_child_handles[child+1], &w32_child_handles[child],
0aaad0ff 1186 (w32_num_children-child-1), HANDLE);
c00206c8 1187 Move(&w32_child_pids[child+1], &w32_child_pids[child],
0aaad0ff
GS		 1188 (w32_num_children-child-1), DWORD);
1189 w32_num_children--;
f55ee38a 1190 }
f55ee38a
GS		 1191}
1192
7766f137
GS		 1193#ifdef USE_ITHREADS
1194static long
04a2c3d9 1195find_pseudo_pid(pTHX_ int pid)
7766f137 1196{
7766f137
GS		 1197 long child = w32_num_pseudo_children;
1198 while (--child >= 0) {
eb160463 1199 if ((int)w32_pseudo_child_pids[child] == pid)
7766f137
GS		 1200 return child;
1201 }
1202 return -1;
1203}
1204
1205static void
1206remove_dead_pseudo_process(long child)
1207{
1208 if (child >= 0) {
acfe0abc 1209 dTHX;
7766f137 1210 CloseHandle(w32_pseudo_child_handles[child]);
c00206c8 1211 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
7766f137 1212 (w32_num_pseudo_children-child-1), HANDLE);
c00206c8 1213 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
7766f137 1214 (w32_num_pseudo_children-child-1), DWORD);
aeecf691
JD		 1215 Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1216 (w32_num_pseudo_children-child-1), HWND);
8a3cb9c6
JD		 1217 Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child],
1218 (w32_num_pseudo_children-child-1), char);
7766f137
GS		 1219 w32_num_pseudo_children--;
1220 }
1221}
8a3cb9c6
JD		 1222
1223void
1224win32_wait_for_children(pTHX)
1225{
1226 if (w32_pseudo_children && w32_num_pseudo_children) {
1227 long child = 0;
1228 long count = 0;
1229 HANDLE handles[MAXIMUM_WAIT_OBJECTS];
1230
1231 for (child = 0; child < w32_num_pseudo_children; ++child) {
1232 if (!w32_pseudo_child_sigterm[child])
1233 handles[count++] = w32_pseudo_child_handles[child];
1234 }
1235 /* XXX should use MsgWaitForMultipleObjects() to continue
1236 * XXX processing messages while we wait.
1237 */
1238 WaitForMultipleObjects(count, handles, TRUE, INFINITE);
1239
1240 while (w32_num_pseudo_children)
1241 CloseHandle(w32_pseudo_child_handles[--w32_num_pseudo_children]);
1242 }
1243}
7766f137
GS		 1244#endif
1245
542cb85f
JD		 1246static int
1247terminate_process(DWORD pid, HANDLE process_handle, int sig)
1248{
1249 switch(sig) {
1250 case 0:
1251 /* "Does process exist?" use of kill */
1252 return 1;
1253 case 2:
1254 if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1255 return 1;
1256 break;
1257 case SIGBREAK:
1258 case SIGTERM:
1259 if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1260 return 1;
1261 break;
1262 default: /* For now be backwards compatible with perl 5.6 */
1263 case 9:
1264 /* Note that we will only be able to kill processes owned by the
1265 * current process owner, even when we are running as an administrator.
1266 * To kill processes of other owners we would need to set the
1267 * 'SeDebugPrivilege' privilege before obtaining the process handle.
1268 */
1269 if (TerminateProcess(process_handle, sig))
1270 return 1;
1271 break;
1272 }
1273 return 0;
1274}
1275
721b2674
DD		 1276/* returns number of processes killed */
1277static int
1278my_killpg(int pid, int sig)
542cb85f
JD		 1279{
1280 HANDLE process_handle;
1281 HANDLE snapshot_handle;
1282 int killed = 0;
1283
1284 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1285 if (process_handle == NULL)
542cb85f
JD		 1286 return 0;
1287
1288 killed += terminate_process(pid, process_handle, sig);
1289
8cbe99e5 1290 snapshot_handle = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
542cb85f
JD		 1291 if (snapshot_handle != INVALID_HANDLE_VALUE) {
1292 PROCESSENTRY32 entry;
1293
1294 entry.dwSize = sizeof(entry);
8cbe99e5 1295 if (Process32First(snapshot_handle, &entry)) {
542cb85f 1296 do {
8cbe99e5 1297 if (entry.th32ParentProcessID == (DWORD)pid)
721b2674 1298 killed += my_killpg(entry.th32ProcessID, sig);
542cb85f
JD		 1299 entry.dwSize = sizeof(entry);
1300 }
8cbe99e5 1301 while (Process32Next(snapshot_handle, &entry));
542cb85f
JD		 1302 }
1303 CloseHandle(snapshot_handle);
1304 }
1305 CloseHandle(process_handle);
1306 return killed;
1307}
1308
721b2674 1309/* returns number of processes killed */
542cb85f
JD		 1310static int
1311my_kill(int pid, int sig)
1312{
1313 int retval = 0;
1314 HANDLE process_handle;
1315
1316 if (sig < 0)
721b2674 1317 return my_killpg(pid, -sig);
542cb85f
JD		 1318
1319 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af
JD		 1320 /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
1321 if (process_handle != NULL) {
542cb85f
JD		 1322 retval = terminate_process(pid, process_handle, sig);
1323 CloseHandle(process_handle);
1324 }
1325 return retval;
1326}
1327
d903973c 1328#ifdef USE_ITHREADS
17ce47a8
SH		 1329/* Get a child pseudo-process HWND, with retrying and delaying/yielding.
1330 * The "tries" parameter is the number of retries to make, with a Sleep(1)
1331 * (waiting and yielding the time slot) between each try. Specifying 0 causes
1332 * only Sleep(0) (no waiting and potentially no yielding) to be used, so is not
1333 * recommended
1334 * Returns an hwnd != INVALID_HANDLE_VALUE (so be aware that NULL can be
1335 * returned) or croaks if the child pseudo-process doesn't schedule and deliver
1336 * a HWND in the time period allowed.
1337 */
d903973c 1338static HWND
17ce47a8
SH		 1339get_hwnd_delay(pTHX, long child, DWORD tries)
1340{
d903973c 1341 HWND hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1342 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8
SH		 1343
1344 /* Pseudo-process has not yet properly initialized since hwnd isn't set.
1345 * Fast sleep: On some NT kernels/systems, a Sleep(0) won't deschedule a
1346 * thread 100% of the time since threads are attached to a CPU for NUMA and
1347 * caching reasons, and the child thread was attached to a different CPU
1348 * therefore there is no workload on that CPU and Sleep(0) returns control
1349 * without yielding the time slot.
1350 * https://rt.perl.org/rt3/Ticket/Display.html?id=88840
1351 */
d903973c
DD		 1352 Sleep(0);
1353 win32_async_check(aTHX);
17ce47a8 1354 hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1355 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8 1356
d903973c 1357 {
adb86be5 1358 unsigned int count = 0;
17ce47a8
SH		 1359 /* No Sleep(1) if tries==0, just fail instead if we get this far. */
1360 while (count++ < tries) {
1361 Sleep(1);
1362 win32_async_check(aTHX);
1363 hwnd = w32_pseudo_child_message_hwnds[child];
1364 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
1365 }
d903973c 1366 }
17ce47a8
SH		 1367
1368 Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled");
d903973c
DD		 1369}
1370#endif
1371
f55ee38a
GS		 1372DllExport int
1373win32_kill(int pid, int sig)
1374{
acfe0abc 1375 dTHX;
c66b022d 1376 long child;
7766f137
GS		 1377#ifdef USE_ITHREADS
1378 if (pid < 0) {
1379 /* it is a pseudo-forked child */
04a2c3d9 1380 child = find_pseudo_pid(aTHX_ -pid);
7766f137 1381 if (child >= 0) {
85c508c3 1382 HANDLE hProcess = w32_pseudo_child_handles[child];
7e5f34c0 1383 switch (sig) {
17ce47a8
SH		 1384 case 0:
1385 /* "Does process exist?" use of kill */
7e5f34c0 1386 return 0;
aeecf691 1387
17ce47a8
SH		 1388 case 9: {
1389 /* kill -9 style un-graceful exit */
1390 /* Do a wait to make sure child starts and isn't in DLL
1391 * Loader Lock */
1392 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1393 if (TerminateThread(hProcess, sig)) {
1394 /* Allow the scheduler to finish cleaning up the other
1395 * thread.
1396 * Otherwise, if we ExitProcess() before another context
1397 * switch happens we will end up with a process exit
1398 * code of "sig" instead of our own exit status.
1399 * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
1400 */
1401 Sleep(0);
1402 remove_dead_pseudo_process(child);
1403 return 0;
1404 }
1405 break;
1406 }
1407
1408 default: {
1409 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1410 /* We fake signals to pseudo-processes using Win32
1411 * message queue. */
1412 if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1413 PostThreadMessage(-pid, WM_USER_KILL, sig, 0))
1414 {
1415 /* Don't wait for child process to terminate after we send a
1416 * SIGTERM because the child may be blocked in a system call
1417 * and never receive the signal.
1418 */
1419 if (sig == SIGTERM) {
1420 Sleep(0);
1421 w32_pseudo_child_sigterm[child] = 1;
1422 }
1423 /* It might be us ... */
1424 PERL_ASYNC_CHECK();
1425 return 0;
1426 }
1427 break;
1428 }
1429 } /* switch */
7766f137 1430 }
68dc0745 1431 }
7766f137
GS		 1432 else
1433#endif
1434 {
04a2c3d9 1435 child = find_pid(aTHX_ pid);
7766f137 1436 if (child >= 0) {
542cb85f
JD		 1437 if (my_kill(pid, sig)) {
1438 DWORD exitcode = 0;
1439 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1440 exitcode != STILL_ACTIVE)
1441 {
1442 remove_dead_process(child);
1443 }
1444 return 0;
7e5f34c0 1445 }
7766f137
GS		 1446 }
1447 else {
8cbe99e5 1448 if (my_kill(pid, sig))
48db714f 1449 return 0;
7766f137
GS		 1450 }
1451 }
1452 errno = EINVAL;
1453 return -1;
0a753a76 1454}
fbbbcc48 1455
68dc0745 1456DllExport int
c623ac67 1457win32_stat(const char *path, Stat_t *sbuf)
0a753a76 1458{
3fadfdf1 1459 char buffer[MAX_PATH+1];
68dc0745 1460 int l = strlen(path);
04a2c3d9 1461 dTHX;
67fbe06e 1462 int res;
6b980173 1463 int nlink = 1;
44221b20 1464 BOOL expect_dir = FALSE;
0a753a76 1465
68dc0745 1466 if (l > 1) {
1467 switch(path[l - 1]) {
e1dbac94 1468 /* FindFirstFile() and stat() are buggy with a trailing
44221b20 1469 * slashes, except for the root directory of a drive */
68dc0745 1470 case '\\':
44221b20
JD		 1471 case '/':
1472 if (l > sizeof(buffer)) {
0b96339f
JD		 1473 errno = ENAMETOOLONG;
1474 return -1;
1475 }
44221b20
JD		 1476 --l;
1477 strncpy(buffer, path, l);
1478 /* remove additional trailing slashes */
1479 while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
1480 --l;
1481 /* add back slash if we otherwise end up with just a drive letter */
1482 if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
1483 buffer[l++] = '\\';
1484 buffer[l] = '\0';
1485 path = buffer;
1486 expect_dir = TRUE;
e1dbac94 1487 break;
44221b20 1488
23db2e2d 1489 /* FindFirstFile() is buggy with "x:", so add a dot :-( */
e1dbac94
GS		 1490 case ':':
1491 if (l == 2 && isALPHA(path[0])) {
426c1a18
GS		 1492 buffer[0] = path[0];
1493 buffer[1] = ':';
1494 buffer[2] = '.';
1495 buffer[3] = '\0';
e1dbac94 1496 l = 3;
426c1a18 1497 path = buffer;
e1dbac94
GS		 1498 }
1499 break;
68dc0745 1500 }
1501 }
6b980173 1502
8c56068e
JD		 1503 path = PerlDir_mapA(path);
1504 l = strlen(path);
cba61fe1 1505
8ca2a5d6 1506 if (!w32_sloppystat) {
cba61fe1
JD		 1507 /* We must open & close the file once; otherwise file attribute changes */
1508 /* might not yet have propagated to "other" hard links of the same file. */
1509 /* This also gives us an opportunity to determine the number of links. */
1510 HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
1511 if (handle != INVALID_HANDLE_VALUE) {
1512 BY_HANDLE_FILE_INFORMATION bhi;
1513 if (GetFileInformationByHandle(handle, &bhi))
1514 nlink = bhi.nNumberOfLinks;
1515 CloseHandle(handle);
1516 }
7fac1903 1517 }
6b980173 1518
8c56068e 1519 /* path will be mapped correctly above */
c623ac67 1520#if defined(WIN64) || defined(USE_LARGE_FILES)
8c56068e 1521 res = _stati64(path, sbuf);
c623ac67 1522#else
8c56068e 1523 res = stat(path, sbuf);
c623ac67 1524#endif
426c1a18 1525 sbuf->st_nlink = nlink;
6b980173 1526
24caa93f
GS		 1527 if (res < 0) {
1528 /* CRT is buggy on sharenames, so make sure it really isn't.
1529 * XXX using GetFileAttributesEx() will enable us to set
426c1a18 1530 * sbuf->st_*time (but note that's not available on the
24caa93f 1531 * Windows of 1995) */
8c56068e 1532 DWORD r = GetFileAttributesA(path);
24caa93f 1533 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
426c1a18 1534 /* sbuf may still contain old garbage since stat() failed */
c623ac67 1535 Zero(sbuf, 1, Stat_t);
426c1a18 1536 sbuf->st_mode = S_IFDIR | S_IREAD;
24caa93f
GS		 1537 errno = 0;
1538 if (!(r & FILE_ATTRIBUTE_READONLY))
426c1a18 1539 sbuf->st_mode |= S_IWRITE | S_IEXEC;
24caa93f
GS		 1540 return 0;
1541 }
1542 }
24caa93f 1543 else {
e1dbac94
GS		 1544 if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1545 && (path[2] == '\\' || path[2] == '/'))
2293b0e9
AB		 1546 {
1547 /* The drive can be inaccessible, some _stat()s are buggy */
8c56068e 1548 if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
2293b0e9
AB		 1549 errno = ENOENT;
1550 return -1;
1551 }
1552 }
44221b20
JD		 1553 if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
1554 errno = ENOTDIR;
1555 return -1;
1556 }
038ae9a4
SH		 1557 if (S_ISDIR(sbuf->st_mode)) {
1558 /* Ensure the "write" bit is switched off in the mode for
378eeda7
SH		 1559 * directories with the read-only attribute set. Some compilers
1560 * switch it on for directories, which is technically correct
038ae9a4
SH		 1561 * (directories are indeed always writable unless denied by DACLs),
1562 * but we want stat() and -w to reflect the state of the read-only
1563 * attribute for symmetry with chmod(). */
1564 DWORD r = GetFileAttributesA(path);
1565 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_READONLY)) {
1566 sbuf->st_mode &= ~S_IWRITE;
1567 }
1568 }
2293b0e9 1569 }
67fbe06e 1570 return res;
0a753a76 1571}
1572
bb27e7b6
JH		 1573#define isSLASH(c) ((c) == '/' || (c) == '\\')
1574#define SKIP_SLASHES(s) \
1575 STMT_START { \
1576 while (*(s) && isSLASH(*(s))) \
1577 ++(s); \
1578 } STMT_END
1579#define COPY_NONSLASHES(d,s) \
1580 STMT_START { \
1581 while (*(s) && !isSLASH(*(s))) \
1582 *(d)++ = *(s)++; \
1583 } STMT_END
1584
8ac9c18d
GS		 1585/* Find the longname of a given path. path is destructively modified.
1586 * It should have space for at least MAX_PATH characters. */
1587DllExport char *
1588win32_longpath(char *path)
1589{
1590 WIN32_FIND_DATA fdata;
1591 HANDLE fhand;
1592 char tmpbuf[MAX_PATH+1];
1593 char *tmpstart = tmpbuf;
1594 char *start = path;
1595 char sep;
1596 if (!path)
4e205ed6 1597 return NULL;
8ac9c18d
GS		 1598
1599 /* drive prefix */
bb27e7b6 1600 if (isALPHA(path[0]) && path[1] == ':') {
8ac9c18d
GS		 1601 start = path + 2;
1602 *tmpstart++ = path[0];
1603 *tmpstart++ = ':';
1604 }
1605 /* UNC prefix */
bb27e7b6 1606 else if (isSLASH(path[0]) && isSLASH(path[1])) {
8ac9c18d 1607 start = path + 2;
52fcf7ee
GS		 1608 *tmpstart++ = path[0];
1609 *tmpstart++ = path[1];
bb27e7b6
JH		 1610 SKIP_SLASHES(start);
1611 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
8ac9c18d 1612 if (*start) {
bb27e7b6
JH		 1613 *tmpstart++ = *start++;
1614 SKIP_SLASHES(start);
1615 COPY_NONSLASHES(tmpstart,start); /* copy share name */
8ac9c18d
GS		 1616 }
1617 }
8ac9c18d 1618 *tmpstart = '\0';
bb27e7b6
JH		 1619 while (*start) {
1620 /* copy initial slash, if any */
1621 if (isSLASH(*start)) {
1622 *tmpstart++ = *start++;
1623 *tmpstart = '\0';
1624 SKIP_SLASHES(start);
1625 }
1626
1627 /* FindFirstFile() expands "." and "..", so we need to pass
1628 * those through unmolested */
1629 if (*start == '.'
1630 && (!start[1] || isSLASH(start[1])
1631 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1632 {
1633 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1634 *tmpstart = '\0';
1635 continue;
1636 }
1637
1638 /* if this is the end, bust outta here */
1639 if (!*start)
1640 break;
8ac9c18d 1641
bb27e7b6
JH		 1642 /* now we're at a non-slash; walk up to next slash */
1643 while (*start && !isSLASH(*start))
8ac9c18d 1644 ++start;
8ac9c18d
GS		 1645
1646 /* stop and find full name of component */
bb27e7b6 1647 sep = *start;
8ac9c18d
GS		 1648 *start = '\0';
1649 fhand = FindFirstFile(path,&fdata);
bb27e7b6 1650 *start = sep;
8ac9c18d 1651 if (fhand != INVALID_HANDLE_VALUE) {
bb27e7b6
JH		 1652 STRLEN len = strlen(fdata.cFileName);
1653 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1654 strcpy(tmpstart, fdata.cFileName);
1655 tmpstart += len;
1656 FindClose(fhand);
1657 }
1658 else {
1659 FindClose(fhand);
1660 errno = ERANGE;
4e205ed6 1661 return NULL;
bb27e7b6 1662 }
8ac9c18d
GS		 1663 }
1664 else {
1665 /* failed a step, just return without side effects */
bf49b057 1666 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
bb27e7b6 1667 errno = EINVAL;
4e205ed6 1668 return NULL;
8ac9c18d
GS		 1669 }
1670 }
1671 strcpy(path,tmpbuf);
1672 return path;
1673}
1674
aa2b96ec 1675static void
0934c9d9 1676out_of_memory(void)
aa2b96ec 1677{
4cbe3a7d
DD		 1678 if (PL_curinterp)
1679 croak_no_mem();
ae6198af 1680 exit(1);
aa2b96ec
JD		 1681}
1682
073dd035
DD		 1683void
1684win32_croak_not_implemented(const char * fname)
1685{
1686 PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
1687
1688 Perl_croak_nocontext("%s not implemented!\n", fname);
1689}
1690
00a0ae28
SH		 1691/* Converts a wide character (UTF-16) string to the Windows ANSI code page,
1692 * potentially using the system's default replacement character for any
1693 * unrepresentable characters. The caller must free() the returned string. */
1694static char*
1695wstr_to_str(const wchar_t* wstr)
1696{
1697 BOOL used_default = FALSE;
1698 size_t wlen = wcslen(wstr) + 1;
1699 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1700 NULL, 0, NULL, NULL);
f76b679e 1701 char* str = (char*)malloc(len);
00a0ae28
SH		 1702 if (!str)
1703 out_of_memory();
1704 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1705 str, len, NULL, &used_default);
1706 return str;
1707}
1708
aa2b96ec
JD		 1709/* The win32_ansipath() function takes a Unicode filename and converts it
1710 * into the current Windows codepage. If some characters cannot be mapped,
1711 * then it will convert the short name instead.
1712 *
1713 * The buffer to the ansi pathname must be freed with win32_free() when it
1714 * it no longer needed.
1715 *
1716 * The argument to win32_ansipath() must exist before this function is
1717 * called; otherwise there is no way to determine the short path name.
1718 *
1719 * Ideas for future refinement:
1720 * - Only convert those segments of the path that are not in the current
1721 * codepage, but leave the other segments in their long form.
1722 * - If the resulting name is longer than MAX_PATH, start converting
1723 * additional path segments into short names until the full name
1724 * is shorter than MAX_PATH. Shorten the filename part last!
1725 */
1726DllExport char *
1727win32_ansipath(const WCHAR *widename)
1728{
1729 char *name;
1730 BOOL use_default = FALSE;
1731 size_t widelen = wcslen(widename)+1;
1732 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1733 NULL, 0, NULL, NULL);
f76b679e 1734 name = (char*)win32_malloc(len);
aa2b96ec
JD		 1735 if (!name)
1736 out_of_memory();
1737
1738 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1739 name, len, NULL, &use_default);
1740 if (use_default) {
aa2b96ec 1741 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af 1742 if (shortlen) {
f76b679e 1743 WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
ae6198af
JD		 1744 if (!shortname)
1745 out_of_memory();
1746 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1747
1748 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1749 NULL, 0, NULL, NULL);
f76b679e 1750 name = (char*)win32_realloc(name, len);
ae6198af
JD		 1751 if (!name)
1752 out_of_memory();
1753 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1754 name, len, NULL, NULL);
1755 win32_free(shortname);
1756 }
aa2b96ec
JD		 1757 }
1758 return name;
1759}
1760
2c8ca683
DD		 1761/* the returned string must be freed with win32_freeenvironmentstrings which is
1762 * implemented as a macro
1763 * void win32_freeenvironmentstrings(void* block)
1764 */
0551aaa8 1765DllExport char *
4f46e52b
KR		 1766win32_getenvironmentstrings(void)
1767{
1768 LPWSTR lpWStr, lpWTmp;
1769 LPSTR lpStr, lpTmp;
1770 DWORD env_len, wenvstrings_len = 0, aenvstrings_len = 0;
1771
1772 /* Get the process environment strings */
1773 lpWTmp = lpWStr = (LPWSTR) GetEnvironmentStringsW();
fa467b9b 1774 for (wenvstrings_len = 1; *lpWTmp != '\0'; lpWTmp += env_len + 1) {
4f46e52b
KR		 1775 env_len = wcslen(lpWTmp);
1776 /* calculate the size of the environment strings */
1777 wenvstrings_len += env_len + 1;
1778 }
1779
fa467b9b 1780 /* Get the number of bytes required to store the ACP encoded string */
4f46e52b 1781 aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
fa467b9b 1782 lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
4f46e52b
KR		 1783 lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
1784 if(!lpTmp)
1785 out_of_memory();
1786
1787 /* Convert the string from UTF-16 encoding to ACP encoding */
1788 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
fa467b9b 1789 aenvstrings_len, NULL, NULL);
4f46e52b 1790
a6abe943 1791 FreeEnvironmentStringsW(lpWStr);
90674eaa 1792
4f46e52b
KR		 1793 return(lpStr);
1794}
1795
4f46e52b 1796DllExport char *
0551aaa8
GS		 1797win32_getenv(const char *name)
1798{
acfe0abc 1799 dTHX;
0551aaa8 1800 DWORD needlen;
4e205ed6 1801 SV *curitem = NULL;
1fcb0052 1802 DWORD last_err;
58a50f62 1803
8c56068e 1804 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 1805 if (needlen != 0) {
c2b90b61 1806 curitem = sv_2mortal(newSVpvs(""));
8c56068e
JD		 1807 do {
1808 SvGROW(curitem, needlen+1);
1809 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
1810 needlen);
1811 } while (needlen >= SvLEN(curitem));
1812 SvCUR_set(curitem, needlen);
0551aaa8 1813 }
c934e9d4 1814 else {
1fcb0052
PM		 1815 last_err = GetLastError();
1816 if (last_err == ERROR_NOT_ENOUGH_MEMORY) {
1817 /* It appears the variable is in the env, but the Win32 API
1818 doesn't have a canned way of getting it. So we fall back to
1819 grabbing the whole env and pulling this value out if possible */
1820 char *envv = GetEnvironmentStrings();
1821 char *cur = envv;
1822 STRLEN len;
1823 while (*cur) {
1824 char *end = strchr(cur,'=');
1825 if (end && end != cur) {
1826 *end = '\0';
1827 if (!strcmp(cur,name)) {
1828 curitem = sv_2mortal(newSVpv(end+1,0));
1829 *end = '=';
1830 break;
1831 }
1832 *end = '=';
1833 cur = end + strlen(end+1)+2;
1834 }
1835 else if ((len = strlen(cur)))
1836 cur += len+1;
1837 }
1838 FreeEnvironmentStrings(envv);
1839 }
6937817d 1840#ifndef WIN32_NO_REGISTRY
1fcb0052
PM		 1841 else {
1842 /* last ditch: allow any environment variables that begin with 'PERL'
1843 to be obtained from the registry, if found there */
1844 if (strncmp(name, "PERL", 4) == 0)
1845 (void)get_regstr(name, &curitem);
1846 }
6937817d 1847#endif
c69f6586 1848 }
51371543
GS		 1849 if (curitem && SvCUR(curitem))
1850 return SvPVX(curitem);
58a50f62 1851
4e205ed6 1852 return NULL;
0551aaa8
GS		 1853}
1854
ac5c734f
GS		 1855DllExport int
1856win32_putenv(const char *name)
1857{
1858 char* curitem;
1859 char* val;
b813a9c7 1860 int relval = -1;
51371543 1861
73c4f7a1 1862 if (name) {
9399a70c 1863 curitem = (char *) win32_malloc(strlen(name)+1);
8c56068e
JD		 1864 strcpy(curitem, name);
1865 val = strchr(curitem, '=');
1866 if (val) {
1867 /* The sane way to deal with the environment.
1868 * Has these advantages over putenv() & co.:
1869 * * enables us to store a truly empty value in the
1870 * environment (like in UNIX).
8d0cd07e
SH		 1871 * * we don't have to deal with RTL globals, bugs and leaks
1872 * (specifically, see http://support.microsoft.com/kb/235601).
8c56068e 1873 * * Much faster.
d0fc6d8d
SH		 1874 * Why you may want to use the RTL environment handling
1875 * (previously enabled by USE_WIN32_RTL_ENV):
8c56068e
JD		 1876 * * environ[] and RTL functions will not reflect changes,
1877 * which might be an issue if extensions want to access
1878 * the env. via RTL. This cuts both ways, since RTL will
1879 * not see changes made by extensions that call the Win32
1880 * functions directly, either.
1881 * GSAR 97-06-07
1882 */
1883 *val++ = '\0';
1884 if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
1885 relval = 0;
1886 }
9399a70c 1887 win32_free(curitem);
ac5c734f
GS		 1888 }
1889 return relval;
1890}
1891
d55594ae 1892static long
2d7a9237 1893filetime_to_clock(PFILETIME ft)
d55594ae 1894{
7766f137
GS		 1895 __int64 qw = ft->dwHighDateTime;
1896 qw <<= 32;
1897 qw |= ft->dwLowDateTime;
1898 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
1899 return (long) qw;
d55594ae
GS		 1900}
1901
f3986ebb
GS		 1902DllExport int
1903win32_times(struct tms *timebuf)
0a753a76 1904{
d55594ae
GS		 1905 FILETIME user;
1906 FILETIME kernel;
1907 FILETIME dummy;
50ee8e5e 1908 clock_t process_time_so_far = clock();
3fadfdf1 1909 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
d55594ae 1910 &kernel,&user)) {
2d7a9237
GS		 1911 timebuf->tms_utime = filetime_to_clock(&user);
1912 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS		 1913 timebuf->tms_cutime = 0;
1914 timebuf->tms_cstime = 0;
3fadfdf1 1915 } else {
d55594ae 1916 /* That failed - e.g. Win95 fallback to clock() */
50ee8e5e 1917 timebuf->tms_utime = process_time_so_far;
d55594ae
GS		 1918 timebuf->tms_stime = 0;
1919 timebuf->tms_cutime = 0;
1920 timebuf->tms_cstime = 0;
1921 }
50ee8e5e 1922 return process_time_so_far;
0a753a76 1923}
1924
9c51cf4c 1925/* fix utime() so it works on directories in NT */
ad0751ec
GS		 1926static BOOL
1927filetime_from_time(PFILETIME pFileTime, time_t Time)
1928{
9c51cf4c 1929 struct tm *pTM = localtime(&Time);
ad0751ec 1930 SYSTEMTIME SystemTime;
9c51cf4c 1931 FILETIME LocalTime;
ad0751ec
GS		 1932
1933 if (pTM == NULL)
1934 return FALSE;
1935
1936 SystemTime.wYear = pTM->tm_year + 1900;
1937 SystemTime.wMonth = pTM->tm_mon + 1;
1938 SystemTime.wDay = pTM->tm_mday;
1939 SystemTime.wHour = pTM->tm_hour;
1940 SystemTime.wMinute = pTM->tm_min;
1941 SystemTime.wSecond = pTM->tm_sec;
1942 SystemTime.wMilliseconds = 0;
1943
9c51cf4c
GS		 1944 return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
1945 LocalFileTimeToFileTime(&LocalTime, pFileTime);
ad0751ec
GS		 1946}
1947
1948DllExport int
7766f137
GS		 1949win32_unlink(const char *filename)
1950{
acfe0abc 1951 dTHX;
7766f137
GS		 1952 int ret;
1953 DWORD attrs;
1954
8c56068e
JD		 1955 filename = PerlDir_mapA(filename);
1956 attrs = GetFileAttributesA(filename);
1957 if (attrs == 0xFFFFFFFF) {
1958 errno = ENOENT;
1959 return -1;
7766f137 1960 }
8c56068e
JD		 1961 if (attrs & FILE_ATTRIBUTE_READONLY) {
1962 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
1963 ret = unlink(filename);
1964 if (ret == -1)
1965 (void)SetFileAttributesA(filename, attrs);
7766f137 1966 }
8c56068e
JD		 1967 else
1968 ret = unlink(filename);
7766f137
GS		 1969 return ret;
1970}
1971
1972DllExport int
3b405fc5 1973win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 1974{
acfe0abc 1975 dTHX;
ad0751ec
GS		 1976 HANDLE handle;
1977 FILETIME ftCreate;
1978 FILETIME ftAccess;
1979 FILETIME ftWrite;
1980 struct utimbuf TimeBuffer;
7fac1903 1981 int rc;
8c56068e
JD		 1982
1983 filename = PerlDir_mapA(filename);
1984 rc = utime(filename, times);
1985
ad0751ec 1986 /* EACCES: path specifies directory or readonly file */
8cbe99e5 1987 if (rc == 0 || errno != EACCES)
ad0751ec
GS		 1988 return rc;
1989
1990 if (times == NULL) {
1991 times = &TimeBuffer;
1992 time(&times->actime);
1993 times->modtime = times->actime;
1994 }
1995
1996 /* This will (and should) still fail on readonly files */
8c56068e
JD		 1997 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
1998 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1999 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
ad0751ec
GS		 2000 if (handle == INVALID_HANDLE_VALUE)
2001 return rc;
2002
2003 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
2004 filetime_from_time(&ftAccess, times->actime) &&
2005 filetime_from_time(&ftWrite, times->modtime) &&
2006 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
2007 {
2008 rc = 0;
2009 }
2010
2011 CloseHandle(handle);
2012 return rc;
2013}
2014
6e3b076d
JH		 2015typedef union {
2016 unsigned __int64 ft_i64;
2017 FILETIME ft_val;
2018} FT_t;
2019
2020#ifdef __GNUC__
2021#define Const64(x) x##LL
2022#else
2023#define Const64(x) x##i64
2024#endif
2025/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
2026#define EPOCH_BIAS Const64(116444736000000000)
2027
57ab3dfe
GS		 2028/* NOTE: This does not compute the timezone info (doing so can be expensive,
2029 * and appears to be unsupported even by glibc) */
2030DllExport int
2031win32_gettimeofday(struct timeval *tp, void *not_used)
2032{
6e3b076d
JH		 2033 FT_t ft;
2034
2035 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
2036 GetSystemTimeAsFileTime(&ft.ft_val);
2037
2038 /* seconds since epoch */
2039 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
2040
2041 /* microseconds remaining */
2042 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
2043
2044 return 0;
57ab3dfe
GS		 2045}
2046
2d7a9237 2047DllExport int
b2af26b1
GS		 2048win32_uname(struct utsname *name)
2049{
2050 struct hostent *hep;
2051 STRLEN nodemax = sizeof(name->nodename)-1;
b2af26b1 2052
aeecf691
JD		 2053 /* sysname */
2054 switch (g_osver.dwPlatformId) {
2055 case VER_PLATFORM_WIN32_WINDOWS:
2056 strcpy(name->sysname, "Windows");
2057 break;
2058 case VER_PLATFORM_WIN32_NT:
2059 strcpy(name->sysname, "Windows NT");
2060 break;
2061 case VER_PLATFORM_WIN32s:
2062 strcpy(name->sysname, "Win32s");
2063 break;
2064 default:
2065 strcpy(name->sysname, "Win32 Unknown");
2066 break;
b2af26b1 2067 }
aeecf691
JD		 2068
2069 /* release */
2070 sprintf(name->release, "%d.%d",
2071 g_osver.dwMajorVersion, g_osver.dwMinorVersion);
2072
2073 /* version */
2074 sprintf(name->version, "Build %d",
2075 g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
2076 ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
2077 if (g_osver.szCSDVersion[0]) {
2078 char *buf = name->version + strlen(name->version);
2079 sprintf(buf, " (%s)", g_osver.szCSDVersion);
b2af26b1
GS		 2080 }
2081
2082 /* nodename */
2083 hep = win32_gethostbyname("localhost");
2084 if (hep) {
2085 STRLEN len = strlen(hep->h_name);
2086 if (len <= nodemax) {
2087 strcpy(name->nodename, hep->h_name);
2088 }
2089 else {
2090 strncpy(name->nodename, hep->h_name, nodemax);
2091 name->nodename[nodemax] = '\0';
2092 }
2093 }
2094 else {
2095 DWORD sz = nodemax;
2096 if (!GetComputerName(name->nodename, &sz))
2097 *name->nodename = '\0';
2098 }
2099
2100 /* machine (architecture) */
2101 {
2102 SYSTEM_INFO info;
fe537c65 2103 DWORD procarch;
b2af26b1
GS		 2104 char *arch;
2105 GetSystemInfo(&info);
a6c40364 2106
378eeda7 2107#if (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION) && !defined(__MINGW_EXTENSION))
fe537c65 2108 procarch = info.u.s.wProcessorArchitecture;
a6c40364 2109#else
fe537c65 2110 procarch = info.wProcessorArchitecture;
a6c40364 2111#endif
fe537c65 2112 switch (procarch) {
b2af26b1
GS		 2113 case PROCESSOR_ARCHITECTURE_INTEL:
2114 arch = "x86"; break;
fe537c65
GS		 2115 case PROCESSOR_ARCHITECTURE_IA64:
2116 arch = "ia64"; break;
fe537c65
GS		 2117 case PROCESSOR_ARCHITECTURE_AMD64:
2118 arch = "amd64"; break;
fe537c65 2119 case PROCESSOR_ARCHITECTURE_UNKNOWN:
b2af26b1 2120 arch = "unknown"; break;
fe537c65
GS		 2121 default:
2122 sprintf(name->machine, "unknown(0x%x)", procarch);
2123 arch = name->machine;
2124 break;
b2af26b1 2125 }
fe537c65
GS		 2126 if (name->machine != arch)
2127 strcpy(name->machine, arch);
b2af26b1
GS		 2128 }
2129 return 0;
2130}
2131
8fb3fcfb
NIS		 2132/* Timing related stuff */
2133
3fadfdf1
NIS		 2134int
2135do_raise(pTHX_ int sig)
2136{
2137 if (sig < SIG_SIZE) {
2138 Sighandler_t handler = w32_sighandler[sig];
2139 if (handler == SIG_IGN) {
2140 return 0;
2141 }
2142 else if (handler != SIG_DFL) {
2143 (*handler)(sig);
2144 return 0;
2145 }
2146 else {
2147 /* Choose correct default behaviour */
2148 switch (sig) {
2149#ifdef SIGCLD
2150 case SIGCLD:
2151#endif
2152#ifdef SIGCHLD
2153 case SIGCHLD:
2154#endif
2155 case 0:
2156 return 0;
2157 case SIGTERM:
2158 default:
2159 break;
2160 }
2161 }
2162 }
bb0f0a6a 2163 /* Tell caller to exit thread/process as appropriate */
3fadfdf1
NIS		 2164 return 1;
2165}
2166
2167void
2168sig_terminate(pTHX_ int sig)
2169{
2170 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2171 /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2172 thread
2173 */
2174 exit(sig);
2175}
2176
8fb3fcfb
NIS		 2177DllExport int
2178win32_async_check(pTHX)
2179{
2180 MSG msg;
aeecf691
JD		 2181 HWND hwnd = w32_message_hwnd;
2182
099b16d3
RM		 2183 /* Reset w32_poll_count before doing anything else, incase we dispatch
2184 * messages that end up calling back into perl */
aeecf691
JD		 2185 w32_poll_count = 0;
2186
099b16d3
RM		 2187 if (hwnd != INVALID_HANDLE_VALUE) {
2188 /* Passing PeekMessage -1 as HWND (2nd arg) only gets PostThreadMessage() messages
2189 * and ignores window messages - should co-exist better with windows apps e.g. Tk
2190 */
2191 if (hwnd == NULL)
2192 hwnd = (HWND)-1;
2193
2194 while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) ||
2195 PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2196 {
2197 /* re-post a WM_QUIT message (we'll mark it as read later) */
2198 if(msg.message == WM_QUIT) {
2199 PostQuitMessage((int)msg.wParam);
2200 break;
2201 }
8fb3fcfb 2202
099b16d3
RM		 2203 if(!CallMsgFilter(&msg, MSGF_USER))
2204 {
2205 TranslateMessage(&msg);
2206 DispatchMessage(&msg);
aeecf691 2207 }
099b16d3 2208 }
8fb3fcfb
NIS		 2209 }
2210
099b16d3
RM		 2211 /* Call PeekMessage() to mark all pending messages in the queue as "old".
2212 * This is necessary when we are being called by win32_msgwait() to
2213 * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2214 * message over and over. An example how this can happen is when
2215 * Perl is calling win32_waitpid() inside a GUI application and the GUI
2216 * is generating messages before the process terminated.
2217 */
4386d69d 2218 PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
099b16d3 2219
7e5f34c0 2220 /* Above or other stuff may have set a signal flag */
099b16d3
RM		 2221 if (PL_sig_pending)
2222 despatch_signals();
2223
aeecf691 2224 return 1;
8fb3fcfb
NIS		 2225}
2226
089197fa
GS		 2227/* This function will not return until the timeout has elapsed, or until
2228 * one of the handles is ready. */
8fb3fcfb
NIS		 2229DllExport DWORD
2230win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2231{
2232 /* We may need several goes at this - so compute when we stop */
001e9f89
DD		 2233 FT_t ticks = {0};
2234 unsigned __int64 endtime = timeout;
8fb3fcfb 2235 if (timeout != INFINITE) {
001e9f89
DD		 2236 GetSystemTimeAsFileTime(&ticks.ft_val);
2237 ticks.ft_i64 /= 10000;
2238 endtime += ticks.ft_i64;
2239 }
2240 /* This was a race condition. Do not let a non INFINITE timeout to
2241 * MsgWaitForMultipleObjects roll under 0 creating a near
2242 * infinity/~(UINT32)0 timeout which will appear as a deadlock to the
2243 * user who did a CORE perl function with a non infinity timeout,
2244 * sleep for example. This is 64 to 32 truncation minefield.
2245 *
2246 * This scenario can only be created if the timespan from the return of
2247 * MsgWaitForMultipleObjects to GetSystemTimeAsFileTime exceeds 1 ms. To
2248 * generate the scenario, manual breakpoints in a C debugger are required,
bb0f0a6a 2249 * or a context switch occurred in win32_async_check in PeekMessage, or random
001e9f89
DD		 2250 * messages are delivered to the *thread* message queue of the Perl thread
2251 * from another process (msctf.dll doing IPC among its instances, VS debugger
2252 * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096].
2253 */
2254 while (ticks.ft_i64 <= endtime) {
9afd6203
SH		 2255 /* if timeout's type is lengthened, remember to split 64b timeout
2256 * into multiple non-infinity runs of MWFMO */
2257 DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE,
2258 (DWORD)(endtime - ticks.ft_i64),
2259 QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
8fb3fcfb
NIS		 2260 if (resultp)
2261 *resultp = result;
2262 if (result == WAIT_TIMEOUT) {
3fadfdf1
NIS		 2263 /* Ran out of time - explicit return of zero to avoid -ve if we
2264 have scheduling issues
2265 */
8fb3fcfb
NIS		 2266 return 0;
2267 }
2268 if (timeout != INFINITE) {
001e9f89
DD		 2269 GetSystemTimeAsFileTime(&ticks.ft_val);
2270 ticks.ft_i64 /= 10000;
2271 }
8fb3fcfb
NIS		 2272 if (result == WAIT_OBJECT_0 + count) {
2273 /* Message has arrived - check it */
089197fa 2274 (void)win32_async_check(aTHX);
8fb3fcfb
NIS		 2275 }
2276 else {
2277 /* Not timeout or message - one of handles is ready */
2278 break;
2279 }
2280 }
8fb3fcfb 2281 /* If we are past the end say zero */
9afd6203 2282 if (!ticks.ft_i64 || ticks.ft_i64 > endtime)
001e9f89
DD		 2283 return 0;
2284 /* compute time left to wait */
2285 ticks.ft_i64 = endtime - ticks.ft_i64;
9afd6203
SH		 2286 /* if more ms than DWORD, then return max DWORD */
2287 return ticks.ft_i64 <= UINT_MAX ? (DWORD)ticks.ft_i64 : UINT_MAX;
8fb3fcfb
NIS		 2288}
2289
932b7487 2290int
04a2c3d9 2291win32_internal_wait(pTHX_ int *status, DWORD timeout)
932b7487
RC		 2292{
2293 /* XXX this wait emulation only knows about processes
2294 * spawned via win32_spawnvp(P_NOWAIT, ...).
2295 */
932b7487
RC		 2296 int i, retval;
2297 DWORD exitcode, waitcode;
2298
2299#ifdef USE_ITHREADS
2300 if (w32_num_pseudo_children) {
8fb3fcfb
NIS		 2301 win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2302 timeout, &waitcode);
932b7487
RC		 2303 /* Time out here if there are no other children to wait for. */
2304 if (waitcode == WAIT_TIMEOUT) {
2305 if (!w32_num_children) {
2306 return 0;
2307 }
2308 }
2309 else if (waitcode != WAIT_FAILED) {
2310 if (waitcode >= WAIT_ABANDONED_0
2311 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2312 i = waitcode - WAIT_ABANDONED_0;
2313 else
2314 i = waitcode - WAIT_OBJECT_0;
2315 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2316 *status = (int)((exitcode & 0xff) << 8);
2317 retval = (int)w32_pseudo_child_pids[i];
2318 remove_dead_pseudo_process(i);
2319 return -retval;
2320 }
2321 }
2322 }
2323#endif
2324
2325 if (!w32_num_children) {
2326 errno = ECHILD;
2327 return -1;
2328 }
2329
2330 /* if a child exists, wait for it to die */
8fb3fcfb 2331 win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
932b7487
RC		 2332 if (waitcode == WAIT_TIMEOUT) {
2333 return 0;
2334 }
2335 if (waitcode != WAIT_FAILED) {
2336 if (waitcode >= WAIT_ABANDONED_0
2337 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2338 i = waitcode - WAIT_ABANDONED_0;
2339 else
2340 i = waitcode - WAIT_OBJECT_0;
2341 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2342 *status = (int)((exitcode & 0xff) << 8);
2343 retval = (int)w32_child_pids[i];
2344 remove_dead_process(i);
2345 return retval;
2346 }
2347 }
2348
932b7487
RC		 2349 errno = GetLastError();
2350 return -1;
2351}
2352
b2af26b1 2353DllExport int
f55ee38a
GS		 2354win32_waitpid(int pid, int *status, int flags)
2355{
acfe0abc 2356 dTHX;
922b1888 2357 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
0aaad0ff 2358 int retval = -1;
c66b022d 2359 long child;
7766f137 2360 if (pid == -1) /* XXX threadid == 1 ? */
04a2c3d9 2361 return win32_internal_wait(aTHX_ status, timeout);
7766f137
GS		 2362#ifdef USE_ITHREADS
2363 else if (pid < 0) {
04a2c3d9 2364 child = find_pseudo_pid(aTHX_ -pid);
7766f137
GS		 2365 if (child >= 0) {
2366 HANDLE hThread = w32_pseudo_child_handles[child];
8fb3fcfb
NIS		 2367 DWORD waitcode;
2368 win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2f67576d
BC		 2369 if (waitcode == WAIT_TIMEOUT) {
2370 return 0;
2371 }
8fb3fcfb 2372 else if (waitcode == WAIT_OBJECT_0) {
7766f137
GS		 2373 if (GetExitCodeThread(hThread, &waitcode)) {
2374 *status = (int)((waitcode & 0xff) << 8);
2375 retval = (int)w32_pseudo_child_pids[child];
2376 remove_dead_pseudo_process(child);
68a29c53 2377 return -retval;
7766f137
GS		 2378 }
2379 }
2380 else
2381 errno = ECHILD;
2382 }
2383 }
2384#endif
f55ee38a 2385 else {
922b1888
GS		 2386 HANDLE hProcess;
2387 DWORD waitcode;
04a2c3d9 2388 child = find_pid(aTHX_ pid);
0aaad0ff 2389 if (child >= 0) {
922b1888 2390 hProcess = w32_child_handles[child];
8fb3fcfb 2391 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
a7867d0a
GS		 2392 if (waitcode == WAIT_TIMEOUT) {
2393 return 0;
2394 }
8fb3fcfb 2395 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS		 2396 if (GetExitCodeProcess(hProcess, &waitcode)) {
2397 *status = (int)((waitcode & 0xff) << 8);
2398 retval = (int)w32_child_pids[child];
2399 remove_dead_process(child);
2400 return retval;
2401 }
a7867d0a 2402 }
0aaad0ff
GS		 2403 else
2404 errno = ECHILD;
2405 }
2406 else {
8cbe99e5 2407 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
922b1888 2408 if (hProcess) {
8fb3fcfb 2409 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
922b1888 2410 if (waitcode == WAIT_TIMEOUT) {
48db714f 2411 CloseHandle(hProcess);
922b1888
GS		 2412 return 0;
2413 }
8fb3fcfb 2414 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS		 2415 if (GetExitCodeProcess(hProcess, &waitcode)) {
2416 *status = (int)((waitcode & 0xff) << 8);
2417 CloseHandle(hProcess);
2418 return pid;
2419 }
2420 }
2421 CloseHandle(hProcess);
2422 }
2423 else
2424 errno = ECHILD;
0aaad0ff 2425 }
f55ee38a 2426 }
3fadfdf1 2427 return retval >= 0 ? pid : retval;
f55ee38a
GS		 2428}
2429
2430DllExport int
2d7a9237
GS		 2431win32_wait(int *status)
2432{
04a2c3d9
DD		 2433 dTHX;
2434 return win32_internal_wait(aTHX_ status, INFINITE);
2d7a9237 2435}
d55594ae 2436
8fb3fcfb
NIS		 2437DllExport unsigned int
2438win32_sleep(unsigned int t)
d55594ae 2439{
acfe0abc 2440 dTHX;
8fb3fcfb 2441 /* Win32 times are in ms so *1000 in and /1000 out */
3b9aea04
SH		 2442 if (t > UINT_MAX / 1000) {
2443 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
2444 "sleep(%lu) too large", t);
2445 }
2446 return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000;
d55594ae
GS		 2447}
2448
f3986ebb
GS		 2449DllExport unsigned int
2450win32_alarm(unsigned int sec)
0a753a76 2451{
3fadfdf1 2452 /*
d55594ae 2453 * the 'obvious' implentation is SetTimer() with a callback
3fadfdf1
NIS		 2454 * which does whatever receiving SIGALRM would do
2455 * we cannot use SIGALRM even via raise() as it is not
d55594ae 2456 * one of the supported codes in <signal.h>
3fadfdf1 2457 */
acfe0abc 2458 dTHX;
aeecf691
JD		 2459
2460 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2461 w32_message_hwnd = win32_create_message_window();
2462
8fb3fcfb 2463 if (sec) {
aeecf691
JD		 2464 if (w32_message_hwnd == NULL)
2465 w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2466 else {
2467 w32_timerid = 1;
2468 SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2469 }
8fb3fcfb
NIS		 2470 }
2471 else {
2472 if (w32_timerid) {
aeecf691
JD		 2473 KillTimer(w32_message_hwnd, w32_timerid);
2474 w32_timerid = 0;
8fb3fcfb 2475 }
3fadfdf1 2476 }
afe91769 2477 return 0;
0a753a76 2478}
2479
2d77217b 2480extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
26618a56
GS		 2481
2482DllExport char *
2483win32_crypt(const char *txt, const char *salt)
2484{
acfe0abc 2485 dTHX;
3352bfcb 2486 return des_fcrypt(txt, salt, w32_crypt_buffer);
26618a56 2487}
26618a56 2488
390b85e7
GS		 2489/* simulate flock by locking a range on the file */
2490
390b85e7
GS		 2491#define LK_LEN 0xffff0000
2492
f3986ebb
GS		 2493DllExport int
2494win32_flock(int fd, int oper)
390b85e7
GS		 2495{
2496 OVERLAPPED o;
2497 int i = -1;
2498 HANDLE fh;
2499
2500 fh = (HANDLE)_get_osfhandle(fd);
97b33cac
JD		 2501 if (fh == (HANDLE)-1) /* _get_osfhandle() already sets errno to EBADF */
2502 return -1;
2503
390b85e7
GS		 2504 memset(&o, 0, sizeof(o));
2505
2506 switch(oper) {
2507 case LOCK_SH: /* shared lock */
97b33cac
JD		 2508 if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o))
2509 i = 0;
390b85e7
GS		 2510 break;
2511 case LOCK_EX: /* exclusive lock */
97b33cac
JD		 2512 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o))
2513 i = 0;
390b85e7
GS		 2514 break;
2515 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
97b33cac
JD		 2516 if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o))
2517 i = 0;
390b85e7
GS		 2518 break;
2519 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
97b33cac
JD		 2520 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2521 0, LK_LEN, 0, &o))
2522 i = 0;
390b85e7
GS		 2523 break;
2524 case LOCK_UN: /* unlock lock */
97b33cac
JD		 2525 if (UnlockFileEx(fh, 0, LK_LEN, 0, &o))
2526 i = 0;
390b85e7
GS		 2527 break;
2528 default: /* unknown */
2529 errno = EINVAL;
97b33cac
JD		 2530 return -1;
2531 }
2532 if (i == -1) {
2533 if (GetLastError() == ERROR_LOCK_VIOLATION)
b0ba2190 2534 errno = EWOULDBLOCK;
97b33cac
JD		 2535 else
2536 errno = EINVAL;
390b85e7
GS		 2537 }
2538 return i;
2539}
2540
390b85e7
GS		 2541#undef LK_LEN
2542
cd6a3131
SH		 2543extern int convert_wsa_error_to_errno(int wsaerr); /* in win32sck.c */
2544
c9beaf97
SH		 2545/* Get the errno value corresponding to the given err. This function is not
2546 * intended to handle conversion of general GetLastError() codes. It only exists
2547 * to translate Windows sockets error codes from WSAGetLastError(). Such codes
2548 * used to be assigned to errno/$! in earlier versions of perl; this function is
2549 * used to catch any old Perl code which is still trying to assign such values
2550 * to $! and convert them to errno values instead.
2551 */
2552int
2553win32_get_errno(int err)
2554{
2555 return convert_wsa_error_to_errno(err);
2556}
2557
68dc0745 2558/*
2559 * redirected io subsystem for all XS modules
2560 *
2561 */
0a753a76 2562
68dc0745 2563DllExport int *
2564win32_errno(void)
0a753a76 2565{
390b85e7 2566 return (&errno);
0a753a76 2567}
2568
dcb2879a
GS		 2569DllExport char ***
2570win32_environ(void)
2571{
390b85e7 2572 return (&(_environ));
dcb2879a
GS		 2573}
2574
68dc0745 2575/* the rest are the remapped stdio routines */
2576DllExport FILE *
2577win32_stderr(void)
0a753a76 2578{
390b85e7 2579 return (stderr);
0a753a76 2580}
2581
68dc0745 2582DllExport FILE *
2583win32_stdin(void)
0a753a76 2584{
390b85e7 2585 return (stdin);
0a753a76 2586}
2587
68dc0745 2588DllExport FILE *
0934c9d9 2589win32_stdout(void)
0a753a76 2590{
390b85e7 2591 return (stdout);
0a753a76 2592}
2593
68dc0745 2594DllExport int
2595win32_ferror(FILE *fp)
0a753a76 2596{
390b85e7 2597 return (ferror(fp));
0a753a76 2598}
2599
2600
68dc0745 2601DllExport int
2602win32_feof(FILE *fp)
0a753a76 2603{
390b85e7 2604 return (feof(fp));
0a753a76 2605}
2606
e85fa3eb 2607#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
cd6a3131 2608extern int convert_errno_to_wsa_error(int err); /* in win32sck.c */
e85fa3eb 2609#endif
cd6a3131 2610
68dc0745 2611/*
3fadfdf1 2612 * Since the errors returned by the socket error function
68dc0745 2613 * WSAGetLastError() are not known by the library routine strerror
cd6a3131
SH		 2614 * we have to roll our own to cover the case of socket errors
2615 * that could not be converted to regular errno values by
2616 * get_last_socket_error() in win32/win32sck.c.
68dc0745 2617 */
0a753a76 2618
68dc0745 2619DllExport char *
3fadfdf1 2620win32_strerror(int e)
0a753a76 2621{
378eeda7 2622#if !defined __MINGW32__ /* compiler intolerance */
68dc0745 2623 extern int sys_nerr;
3e3baf6d 2624#endif
0a753a76 2625
9404a519 2626 if (e < 0 || e > sys_nerr) {
9399a70c 2627 dTHXa(NULL);
9404a519 2628 if (e < 0)
68dc0745 2629 e = GetLastError();
e85fa3eb 2630#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
4f79e9b1
SH		 2631 /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno
2632 * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but
2633 * sys_nerr is still 43 and strerror() returns "Unknown error" for them.
2634 * We must therefore still roll our own messages for these codes, and
2635 * additionally map them to corresponding Windows (sockets) error codes
2636 * first to avoid getting the wrong system message.
cd6a3131
SH		 2637 */
2638 else if (e >= EADDRINUSE && e <= EWOULDBLOCK) {
2639 e = convert_errno_to_wsa_error(e);
2640 }
2641#endif
0a753a76 2642
9399a70c 2643 aTHXa(PERL_GET_THX);
364d54ba
JD		 2644 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
2645 |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
2646 w32_strerror_buffer, sizeof(w32_strerror_buffer),
2647 NULL) == 0)
2648 {
3352bfcb 2649 strcpy(w32_strerror_buffer, "Unknown Error");
364d54ba 2650 }
3352bfcb 2651 return w32_strerror_buffer;
68dc0745 2652 }
364d54ba 2653#undef strerror
390b85e7 2654 return strerror(e);
364d54ba 2655#define strerror win32_strerror
0a753a76 2656}
2657
22fae026 2658DllExport void
c5be433b 2659win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM		 2660{
2661 DWORD dwLen;
2662 char *sMsg;
2663 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
2664 |FORMAT_MESSAGE_IGNORE_INSERTS
2665 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2666 dwErr, 0, (char *)&sMsg, 1, NULL);
2ce77adf 2667 /* strip trailing whitespace and period */
22fae026 2668 if (0 < dwLen) {
2ce77adf
GS		 2669 do {
2670 --dwLen; /* dwLen doesn't include trailing null */
2671 } while (0 < dwLen && isSPACE(sMsg[dwLen]));
22fae026
TM		 2672 if ('.' != sMsg[dwLen])
2673 dwLen++;
2ce77adf 2674 sMsg[dwLen] = '\0';
22fae026
TM		 2675 }
2676 if (0 == dwLen) {
c69f6586 2677 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
db7c17d7
GS		 2678 if (sMsg)
2679 dwLen = sprintf(sMsg,
2680 "Unknown error #0x%lX (lookup 0x%lX)",
2681 dwErr, GetLastError());
2682 }
2683 if (sMsg) {
acfe0abc 2684 dTHX;
db7c17d7
GS		 2685 sv_setpvn((SV*)sv, sMsg, dwLen);
2686 LocalFree(sMsg);
22fae026 2687 }
22fae026
TM		 2688}
2689
68dc0745 2690DllExport int
2691win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 2692{
68dc0745 2693 va_list marker;
2694 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2695
390b85e7 2696 return (vfprintf(fp, format, marker));
0a753a76 2697}
2698
68dc0745 2699DllExport int
2700win32_printf(const char *format, ...)
0a753a76 2701{
68dc0745 2702 va_list marker;
2703 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2704
390b85e7 2705 return (vprintf(format, marker));
0a753a76 2706}
2707
68dc0745 2708DllExport int
2709win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 2710{
390b85e7 2711 return (vfprintf(fp, format, args));
0a753a76 2712}
2713
96e4d5b1 2714DllExport int
2715win32_vprintf(const char *format, va_list args)
2716{
390b85e7 2717 return (vprintf(format, args));
96e4d5b1 2718}
2719
68dc0745 2720DllExport size_t
2721win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2722{
390b85e7 2723 return fread(buf, size, count, fp);
0a753a76 2724}
2725
68dc0745 2726DllExport size_t
2727win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2728{
390b85e7 2729 return fwrite(buf, size, count, fp);
0a753a76 2730}
2731
7fac1903
GS		 2732#define MODE_SIZE 10
2733
68dc0745 2734DllExport FILE *
2735win32_fopen(const char *filename, const char *mode)
0a753a76 2736{
04a2c3d9 2737 dTHXa(NULL);
1c5905c2 2738 FILE *f;
3fadfdf1 2739
c5be433b
GS		 2740 if (!*filename)
2741 return NULL;
2742
68dc0745 2743 if (stricmp(filename, "/dev/null")==0)
7fac1903
GS		 2744 filename = "NUL";
2745
04a2c3d9 2746 aTHXa(PERL_GET_THX);
8c56068e 2747 f = fopen(PerlDir_mapA(filename), mode);
1c5905c2
GS		 2748 /* avoid buffering headaches for child processes */
2749 if (f && *mode == 'a')
2750 win32_fseek(f, 0, SEEK_END);
2751 return f;
0a753a76 2752}
2753
68dc0745 2754DllExport FILE *
7fac1903 2755win32_fdopen(int handle, const char *mode)
0a753a76 2756{
1c5905c2 2757 FILE *f;
8c56068e 2758 f = fdopen(handle, (char *) mode);
1c5905c2
GS		 2759 /* avoid buffering headaches for child processes */
2760 if (f && *mode == 'a')
2761 win32_fseek(f, 0, SEEK_END);
2762 return f;
0a753a76 2763}
2764
68dc0745 2765DllExport FILE *
7fac1903 2766win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 2767{
04a2c3d9 2768 dTHXa(NULL);
68dc0745 2769 if (stricmp(path, "/dev/null")==0)
7fac1903
GS		 2770 path = "NUL";
2771
04a2c3d9 2772 aTHXa(PERL_GET_THX);
7766f137 2773 return freopen(PerlDir_mapA(path), mode, stream);
0a753a76 2774}
2775
68dc0745 2776DllExport int
2777win32_fclose(FILE *pf)
0a753a76 2778{
19253ae6
DD		 2779#ifdef WIN32_NO_SOCKETS
2780 return fclose(pf);
2781#else
f3986ebb 2782 return my_fclose(pf); /* defined in win32sck.c */
19253ae6 2783#endif
0a753a76 2784}
2785
68dc0745 2786DllExport int
2787win32_fputs(const char *s,FILE *pf)
0a753a76 2788{
390b85e7 2789 return fputs(s, pf);
0a753a76 2790}
2791
68dc0745 2792DllExport int
2793win32_fputc(int c,FILE *pf)
0a753a76 2794{
390b85e7 2795 return fputc(c,pf);
0a753a76 2796}
2797
68dc0745 2798DllExport int
2799win32_ungetc(int c,FILE *pf)
0a753a76 2800{
390b85e7 2801 return ungetc(c,pf);
0a753a76 2802}
2803
68dc0745 2804DllExport int
2805win32_getc(FILE *pf)
0a753a76 2806{
390b85e7 2807 return getc(pf);
0a753a76 2808}
2809
68dc0745 2810DllExport int
2811win32_fileno(FILE *pf)
0a753a76 2812{
390b85e7 2813 return fileno(pf);
0a753a76 2814}
2815
68dc0745 2816DllExport void
2817win32_clearerr(FILE *pf)
0a753a76 2818{
390b85e7 2819 clearerr(pf);
68dc0745 2820 return;
0a753a76 2821}
2822
68dc0745 2823DllExport int
2824win32_fflush(FILE *pf)
0a753a76 2825{
390b85e7 2826 return fflush(pf);
0a753a76 2827}
2828
c623ac67 2829DllExport Off_t
68dc0745 2830win32_ftell(FILE *pf)
0a753a76 2831{
c623ac67
GS		 2832#if defined(WIN64) || defined(USE_LARGE_FILES)
2833 fpos_t pos;
2834 if (fgetpos(pf, &pos))
2835 return -1;
2836 return (Off_t)pos;
2837#else
390b85e7 2838 return ftell(pf);
c623ac67 2839#endif
0a753a76 2840}
2841
68dc0745 2842DllExport int
c623ac67 2843win32_fseek(FILE *pf, Off_t offset,int origin)
0a753a76 2844{
c623ac67
GS		 2845#if defined(WIN64) || defined(USE_LARGE_FILES)
2846 fpos_t pos;
2847 switch (origin) {
2848 case SEEK_CUR:
2849 if (fgetpos(pf, &pos))
2850 return -1;
2851 offset += pos;
2852 break;
2853 case SEEK_END:
2854 fseek(pf, 0, SEEK_END);
2855 pos = _telli64(fileno(pf));
2856 offset += pos;
2857 break;
2858 case SEEK_SET:
2859 break;
2860 default:
2861 errno = EINVAL;
2862 return -1;
2863 }
2864 return fsetpos(pf, &offset);
2865#else
8859a7a0 2866 return fseek(pf, (long)offset, origin);
c623ac67 2867#endif
0a753a76 2868}
2869
68dc0745 2870DllExport int
2871win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 2872{
390b85e7 2873 return fgetpos(pf, p);
0a753a76 2874}
2875
68dc0745 2876DllExport int
2877win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 2878{
390b85e7 2879 return fsetpos(pf, p);
0a753a76 2880}
2881
68dc0745 2882DllExport void
2883win32_rewind(FILE *pf)
0a753a76 2884{
390b85e7 2885 rewind(pf);
68dc0745 2886 return;
0a753a76 2887}
2888
2941a2e1
JH		 2889DllExport int
2890win32_tmpfd(void)
0a753a76 2891{
b3122bc4
JH		 2892 char prefix[MAX_PATH+1];
2893 char filename[MAX_PATH+1];
2894 DWORD len = GetTempPath(MAX_PATH, prefix);
2895 if (len && len < MAX_PATH) {
2896 if (GetTempFileName(prefix, "plx", 0, filename)) {
2897 HANDLE fh = CreateFile(filename,
2898 DELETE | GENERIC_READ | GENERIC_WRITE,
2899 0,
2900 NULL,
2901 CREATE_ALWAYS,
2902 FILE_ATTRIBUTE_NORMAL
2903 | FILE_FLAG_DELETE_ON_CLOSE,
2904 NULL);
2905 if (fh != INVALID_HANDLE_VALUE) {
c623ac67 2906 int fd = win32_open_osfhandle((intptr_t)fh, 0);
b3122bc4 2907 if (fd >= 0) {
2b01189b 2908 PERL_DEB(dTHX;)
b3122bc4
JH		 2909 DEBUG_p(PerlIO_printf(Perl_debug_log,
2910 "Created tmpfile=%s\n",filename));
2941a2e1 2911 return fd;
b3122bc4
JH		 2912 }
2913 }
2914 }
2915 }
2941a2e1
JH		 2916 return -1;
2917}
2918
2919DllExport FILE*
2920win32_tmpfile(void)
2921{
2922 int fd = win32_tmpfd();
2923 if (fd >= 0)
2924 return win32_fdopen(fd, "w+b");
b3122bc4 2925 return NULL;
0a753a76 2926}
2927
68dc0745 2928DllExport void
2929win32_abort(void)
0a753a76 2930{
390b85e7 2931 abort();
68dc0745 2932 return;
0a753a76 2933}
2934
68dc0745 2935DllExport int
c623ac67 2936win32_fstat(int fd, Stat_t *sbufptr)
0a753a76 2937{
378eeda7 2938#if defined(WIN64) || defined(USE_LARGE_FILES)
8cbe99e5 2939 return _fstati64(fd, sbufptr);
378eeda7 2940#else
8cbe99e5 2941 return fstat(fd, sbufptr);
2a07f407 2942#endif
0a753a76 2943}
2944
68dc0745 2945DllExport int
2946win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 2947{
390b85e7 2948 return _pipe(pfd, size, mode);
0a753a76 2949}
2950
8c0134a8
NIS		 2951DllExport PerlIO*
2952win32_popenlist(const char *mode, IV narg, SV **args)
2953{
aac983ac 2954 get_shell();
8c0134a8 2955
aac983ac
TC		 2956 return do_popen(mode, NULL, narg, args);
2957}
50892819 2958
aac983ac
TC		 2959STATIC PerlIO*
2960do_popen(const char *mode, const char *command, IV narg, SV **args) {
50892819 2961 int p[2];
f06c8825 2962 int handles[3];
50892819 2963 int parent, child;
c161da64 2964 int stdfd;
50892819
GS		 2965 int ourmode;
2966 int childpid;
1095be37 2967 DWORD nhandle;
1095be37 2968 int lock_held = 0;
aac983ac 2969 const char **args_pvs = NULL;
50892819
GS		 2970
2971 /* establish which ends read and write */
2972 if (strchr(mode,'w')) {
2973 stdfd = 0; /* stdin */
2974 parent = 1;
2975 child = 0;
1095be37 2976 nhandle = STD_INPUT_HANDLE;
50892819
GS		 2977 }
2978 else if (strchr(mode,'r')) {
2979 stdfd = 1; /* stdout */
2980 parent = 0;
2981 child = 1;
1095be37 2982 nhandle = STD_OUTPUT_HANDLE;
50892819
GS		 2983 }
2984 else
2985 return NULL;
2986
2987 /* set the correct mode */
2988 if (strchr(mode,'b'))
2989 ourmode = O_BINARY;
2990 else if (strchr(mode,'t'))
2991 ourmode = O_TEXT;
2992 else
2993 ourmode = _fmode & (O_TEXT | O_BINARY);
2994
2995 /* the child doesn't inherit handles */
2996 ourmode |= O_NOINHERIT;
2997
1095be37 2998 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS		 2999 return NULL;
3000
f06c8825
TC		 3001 /* Previously this code redirected stdin/out temporarily so the
3002 child process inherited those handles, this caused race
3003 conditions when another thread was writing/reading those
3004 handles.
498d7dc4 3005
f06c8825
TC		 3006 To avoid that we just feed the handles to CreateProcess() so
3007 the handles are redirected only in the child.
3008 */
3009 handles[child] = p[child];
3010 handles[parent] = -1;
3011 handles[2] = -1;
564914cd 3012
f06c8825 3013 /* CreateProcess() requires inheritable handles */
c161da64 3014 if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT,
f06c8825 3015 HANDLE_FLAG_INHERIT)) {
50892819 3016 goto cleanup;
f06c8825 3017 }
1095be37 3018
50892819 3019 /* start the child */
4f63d024 3020 {
acfe0abc 3021 dTHX;
50892819 3022
aac983ac
TC		 3023 if (command) {
3024 if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
3025 goto cleanup;
3026
3027 }
3028 else {
3029 int i;
f5fe1b19 3030 const char *exe_name;
aac983ac
TC		 3031
3032 Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
3033 SAVEFREEPV(args_pvs);
3034 for (i = 0; i < narg; ++i)
3035 args_pvs[i] = SvPV_nolen(args[i]);
3036 args_pvs[i] = NULL;
f5fe1b19
TC		 3037 exe_name = qualified_path(args_pvs[0], TRUE);
3038 if (!exe_name)
3039 /* let CreateProcess() try to find it instead */
3040 exe_name = args_pvs[0];
aac983ac 3041
f5fe1b19
TC		 3042 if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) {
3043 goto cleanup;
aac983ac
TC		 3044 }
3045 }
498d7dc4 3046
f06c8825 3047 win32_close(p[child]);
1095be37 3048
4f63d024 3049 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1
RS		 3050
3051 /* set process id so that it can be returned by perl's open() */
3052 PL_forkprocess = childpid;
4f63d024 3053 }
50892819
GS		 3054
3055 /* we have an fd, return a file stream */
00b02797 3056 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS		 3057
3058cleanup:
3059 /* we don't need to check for errors here */
3060 win32_close(p[0]);
3061 win32_close(p[1]);
f06c8825 3062
50892819 3063 return (NULL);
aac983ac
TC		 3064}
3065
3066/*
3067 * a popen() clone that respects PERL5SHELL
3068 *
3069 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
3070 */
50892819 3071
aac983ac
TC		 3072DllExport PerlIO*
3073win32_popen(const char *command, const char *mode)
3074{
3075#ifdef USE_RTL_POPEN
3076 return _popen(command, mode);
3077#else
3078 return do_popen(mode, command, 0, NULL);
4b556e6c 3079#endif /* USE_RTL_POPEN */
0a753a76 3080}
3081
50892819
GS		 3082/*
3083 * pclose() clone
3084 */
3085
68dc0745 3086DllExport int
00b02797 3087win32_pclose(PerlIO *pf)
0a753a76 3088{
4b556e6c 3089#ifdef USE_RTL_POPEN
390b85e7 3090 return _pclose(pf);
50892819 3091#else
acfe0abc 3092 dTHX;
e17cb2a9
JD		 3093 int childpid, status;
3094 SV *sv;
3095
00b02797 3096 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3097
e17cb2a9
JD		 3098 if (SvIOK(sv))
3099 childpid = SvIVX(sv);
3100 else
3101 childpid = 0;
50892819
GS		 3102
3103 if (!childpid) {
3104 errno = EBADF;
3105 return -1;
3106 }
3107
00b02797
JH		 3108#ifdef USE_PERLIO
3109 PerlIO_close(pf);
3110#else
3111 fclose(pf);
3112#endif
e17cb2a9
JD		 3113 SvIVX(sv) = 0;
3114
0aaad0ff
GS		 3115 if (win32_waitpid(childpid, &status, 0) == -1)
3116 return -1;
50892819 3117
0aaad0ff 3118 return status;
50892819 3119
4b556e6c 3120#endif /* USE_RTL_POPEN */
0a753a76 3121}
6b980173 3122
6b980173
JD		 3123DllExport int
3124win32_link(const char *oldname, const char *newname)
3125{
04a2c3d9 3126 dTHXa(NULL);
82867ecf
GS		 3127 WCHAR wOldName[MAX_PATH+1];
3128 WCHAR wNewName[MAX_PATH+1];
6b980173 3129
8c56068e
JD		 3130 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3131 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
04a2c3d9 3132 ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
8cbe99e5 3133 CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173
JD		 3134 {
3135 return 0;
3136 }
2b42d7ed
TC		 3137 /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for
3138 both permissions errors and if the source is a directory, while
3139 POSIX wants EACCES and EPERM respectively.
3140
3141 Determined by experimentation on Windows 7 x64 SP1, since MS
3142 don't document what error codes are returned.
3143 */
3144 switch (GetLastError()) {
3145 case ERROR_BAD_NET_NAME:
3146 case ERROR_BAD_NETPATH:
3147 case ERROR_BAD_PATHNAME:
3148 case ERROR_FILE_NOT_FOUND:
3149 case ERROR_FILENAME_EXCED_RANGE:
3150 case ERROR_INVALID_DRIVE:
3151 case ERROR_PATH_NOT_FOUND:
3152 errno = ENOENT;
3153 break;
3154 case ERROR_ALREADY_EXISTS:
3155 errno = EEXIST;
3156 break;
3157 case ERROR_ACCESS_DENIED:
3158 errno = EACCES;
3159 break;
3160 case ERROR_NOT_SAME_DEVICE:
3161 errno = EXDEV;
3162 break;
e41416c3
CM		 3163 case ERROR_DISK_FULL:
3164 errno = ENOSPC;
3165 break;
3166 case ERROR_NOT_ENOUGH_QUOTA:
3167 errno = EDQUOT;
3168 break;
2b42d7ed
TC		 3169 default:
3170 /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */
3171 errno = EINVAL;
3172 break;
3173 }
6b980173
JD		 3174 return -1;
3175}
0a753a76 3176
68dc0745 3177DllExport int
8d9b2e3c 3178win32_rename(const char *oname, const char *newname)
e24c7c18 3179{
65cb15a1 3180 char szOldName[MAX_PATH+1];
7fac1903 3181 BOOL bResult;
8cbe99e5 3182 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
acfe0abc 3183 dTHX;
65cb15a1 3184
8cbe99e5
JD		 3185 if (stricmp(newname, oname))
3186 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3187 strcpy(szOldName, PerlDir_mapA(oname));
3188
3189 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3190 if (!bResult) {
3191 DWORD err = GetLastError();
3192 switch (err) {
3193 case ERROR_BAD_NET_NAME:
3194 case ERROR_BAD_NETPATH:
3195 case ERROR_BAD_PATHNAME:
3196 case ERROR_FILE_NOT_FOUND:
3197 case ERROR_FILENAME_EXCED_RANGE:
3198 case ERROR_INVALID_DRIVE:
3199 case ERROR_NO_MORE_FILES:
3200 case ERROR_PATH_NOT_FOUND:
3201 errno = ENOENT;
3202 break;
e41416c3
CM		 3203 case ERROR_DISK_FULL:
3204 errno = ENOSPC;
3205 break;
3206 case ERROR_NOT_ENOUGH_QUOTA:
3207 errno = EDQUOT;
3208 break;
8cbe99e5
JD		 3209 default:
3210 errno = EACCES;
3211 break;
3212 }
3213 return -1;
e24c7c18 3214 }
8cbe99e5 3215 return 0;
e24c7c18
GS		 3216}
3217
3218DllExport int
68dc0745 3219win32_setmode(int fd, int mode)
0a753a76 3220{
390b85e7 3221 return setmode(fd, mode);
0a753a76 3222}
3223
4a9d6100
GS		 3224DllExport int
3225win32_chsize(int fd, Off_t size)
3226{
3227#if defined(WIN64) || defined(USE_LARGE_FILES)
3228 int retval = 0;
3229 Off_t cur, end, extend;
3230
3231 cur = win32_tell(fd);
3232 if (cur < 0)
3233 return -1;
3234 end = win32_lseek(fd, 0, SEEK_END);
3235 if (end < 0)
3236 return -1;
3237 extend = size - end;
3238 if (extend == 0) {
3239 /* do nothing */
3240 }
3241 else if (extend > 0) {
3242 /* must grow the file, padding with nulls */
3243 char b[4096];
3244 int oldmode = win32_setmode(fd, O_BINARY);
3245 size_t count;
3246 memset(b, '\0', sizeof(b));
3247 do {
3248 count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3249 count = win32_write(fd, b, count);
21424390 3250 if ((int)count < 0) {
4a9d6100
GS		 3251 retval = -1;
3252 break;
3253 }
3254 } while ((extend -= count) > 0);
3255 win32_setmode(fd, oldmode);
3256 }
3257 else {
3258 /* shrink the file */
3259 win32_lseek(fd, size, SEEK_SET);
3260 if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3261 errno = EACCES;
3262 retval = -1;
3263 }
3264 }
4a9d6100
GS		 3265 win32_lseek(fd, cur, SEEK_SET);
3266 return retval;
3267#else
8859a7a0 3268 return chsize(fd, (long)size);
4a9d6100
GS		 3269#endif
3270}
3271
c623ac67
GS		 3272DllExport Off_t
3273win32_lseek(int fd, Off_t offset, int origin)
96e4d5b1 3274{
c623ac67
GS		 3275#if defined(WIN64) || defined(USE_LARGE_FILES)
3276 return _lseeki64(fd, offset, origin);
3277#else
8859a7a0 3278 return lseek(fd, (long)offset, origin);
c623ac67 3279#endif
96e4d5b1 3280}
3281
c623ac67 3282DllExport Off_t
96e4d5b1 3283win32_tell(int fd)
3284{
c623ac67
GS		 3285#if defined(WIN64) || defined(USE_LARGE_FILES)
3286 return _telli64(fd);
3287#else
390b85e7 3288 return tell(fd);
c623ac67 3289#endif
96e4d5b1 3290}
3291
68dc0745 3292DllExport int
3293win32_open(const char *path, int flag, ...)
0a753a76 3294{
04a2c3d9 3295 dTHXa(NULL);
68dc0745 3296 va_list ap;
3297 int pmode;
0a753a76 3298
3299 va_start(ap, flag);
3300 pmode = va_arg(ap, int);
3301 va_end(ap);
3302
68dc0745 3303 if (stricmp(path, "/dev/null")==0)
7fac1903
GS		 3304 path = "NUL";
3305
04a2c3d9 3306 aTHXa(PERL_GET_THX);
7766f137 3307 return open(PerlDir_mapA(path), flag, pmode);
0a753a76 3308}
3309
00b02797
JH		 3310/* close() that understands socket */
3311extern int my_close(int); /* in win32sck.c */
3312
68dc0745 3313DllExport int
3314win32_close(int fd)
0a753a76 3315{
19253ae6
DD		 3316#ifdef WIN32_NO_SOCKETS
3317 return close(fd);
3318#else
00b02797 3319 return my_close(fd);
19253ae6 3320#endif
0a753a76 3321}
3322
68dc0745 3323DllExport int
96e4d5b1 3324win32_eof(int fd)
3325{
390b85e7 3326 return eof(fd);
96e4d5b1 3327}
3328
3329DllExport int
4342f4d6
JD		 3330win32_isatty(int fd)
3331{
3332 /* The Microsoft isatty() function returns true for *all*
3333 * character mode devices, including "nul". Our implementation
3334 * should only return true if the handle has a console buffer.
3335 */
3336 DWORD mode;
3337 HANDLE fh = (HANDLE)_get_osfhandle(fd);
3338 if (fh == (HANDLE)-1) {
3339 /* errno is already set to EBADF */
3340 return 0;
3341 }
3342
3343 if (GetConsoleMode(fh, &mode))
3344 return 1;
3345
3346 errno = ENOTTY;
3347 return 0;
3348}
3349
3350DllExport int
68dc0745 3351win32_dup(int fd)
0a753a76 3352{
390b85e7 3353 return dup(fd);
0a753a76 3354}
3355
68dc0745 3356DllExport int
3357win32_dup2(int fd1,int fd2)
0a753a76 3358{
390b85e7 3359 return dup2(fd1,fd2);
0a753a76 3360}
3361
68dc0745 3362DllExport int
3e3baf6d 3363win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 3364{
390b85e7 3365 return read(fd, buf, cnt);
0a753a76 3366}
3367
68dc0745 3368DllExport int
3e3baf6d 3369win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 3370{
390b85e7 3371 return write(fd, buf, cnt);
0a753a76 3372}
3373
68dc0745 3374DllExport int
5aabfad6 3375win32_mkdir(const char *dir, int mode)
3376{
acfe0abc 3377 dTHX;
7766f137 3378 return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
5aabfad6 3379}
96e4d5b1 3380
5aabfad6 3381DllExport int
3382win32_rmdir(const char *dir)
3383{
acfe0abc 3384 dTHX;
7766f137 3385 return rmdir(PerlDir_mapA(dir));
5aabfad6 3386}
96e4d5b1 3387
5aabfad6 3388DllExport int
3389win32_chdir(const char *dir)
3390{
1cdd9224 3391 if (!dir || !*dir) {
9ec3348a
JH		 3392 errno = ENOENT;
3393 return -1;
3394 }
390b85e7 3395 return chdir(dir);
5aabfad6 3396}
96e4d5b1 3397
7766f137
GS		 3398DllExport int
3399win32_access(const char *path, int mode)
3400{
acfe0abc 3401 dTHX;
7766f137
GS		 3402 return access(PerlDir_mapA(path), mode);
3403}
3404
3405DllExport int
3406win32_chmod(const char *path, int mode)
3407{
acfe0abc 3408 dTHX;
7766f137
GS		 3409 return chmod(PerlDir_mapA(path), mode);
3410}
3411
3412
0aaad0ff 3413static char *
dd7038b3 3414create_command_line(char *cname, STRLEN clen, const char * const *args)
0aaad0ff 3415{
2b01189b 3416 PERL_DEB(dTHX;)
b309b8ae
JH		 3417 int index, argc;
3418 char *cmd, *ptr;
3419 const char *arg;
3420 STRLEN len = 0;
81bc1258 3421 bool bat_file = FALSE;
b309b8ae 3422 bool cmd_shell = FALSE;
7b11e424 3423 bool dumb_shell = FALSE;
b309b8ae 3424 bool extra_quotes = FALSE;
dd7038b3 3425 bool quote_next = FALSE;
81bc1258
JH		 3426
3427 if (!cname)
3428 cname = (char*)args[0];
b309b8ae
JH		 3429
3430 /* The NT cmd.exe shell has the following peculiarity that needs to be
3431 * worked around. It strips a leading and trailing dquote when any
3432 * of the following is true:
3433 * 1. the /S switch was used
3434 * 2. there are more than two dquotes
3435 * 3. there is a special character from this set: &<>()@^|
3436 * 4. no whitespace characters within the two dquotes
3437 * 5. string between two dquotes isn't an executable file
3438 * To work around this, we always add a leading and trailing dquote
3439 * to the string, if the first argument is either "cmd.exe" or "cmd",
3440 * and there were at least two or more arguments passed to cmd.exe
3441 * (not including switches).
dd7038b3
JH		 3442 * XXX the above rules (from "cmd /?") don't seem to be applied
3443 * always, making for the convolutions below :-(
b309b8ae 3444 */
81bc1258 3445 if (cname) {
dd7038b3
JH		 3446 if (!clen)
3447 clen = strlen(cname);
3448
81bc1258
JH		 3449 if (clen > 4
3450 && (stricmp(&cname[clen-4], ".bat") == 0
8cbe99e5 3451 || (stricmp(&cname[clen-4], ".cmd") == 0)))
81bc1258
JH		 3452 {
3453 bat_file = TRUE;
8cbe99e5 3454 len += 3;
81bc1258 3455 }
dd7038b3
JH		 3456 else {
3457 char *exe = strrchr(cname, '/');
3458 char *exe2 = strrchr(cname, '\\');
3459 if (exe2 > exe)
3460 exe = exe2;
3461 if (exe)
3462 ++exe;
3463 else
3464 exe = cname;
3465 if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
3466 cmd_shell = TRUE;
3467 len += 3;
3468 }
7b11e424
JH		 3469 else if (stricmp(exe, "command.com") == 0
3470 || stricmp(exe, "command") == 0)
3471 {
3472 dumb_shell = TRUE;
3473 }
81bc1258 3474 }
b309b8ae 3475 }
0aaad0ff 3476
b309b8ae
JH		 3477 DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
3478 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3479 STRLEN curlen = strlen(arg);
3480 if (!(arg[0] == '"' && arg[curlen-1] == '"'))
3481 len += 2; /* assume quoting needed (worst case) */
3482 len += curlen + 1;
3483 DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
3484 }
3485 DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
0aaad0ff 3486
b309b8ae 3487 argc = index;
a02a5408 3488 Newx(cmd, len, char);
0aaad0ff 3489 ptr = cmd;
0aaad0ff 3490
8cbe99e5 3491 if (bat_file) {
81bc1258
JH		 3492 *ptr++ = '"';
3493 extra_quotes = TRUE;
3494 }
3495
0aaad0ff 3496 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
b309b8ae
JH		 3497 bool do_quote = 0;
3498 STRLEN curlen = strlen(arg);
3499
81bc1258
JH		 3500 /* we want to protect empty arguments and ones with spaces with
3501 * dquotes, but only if they aren't already there */
7b11e424
JH		 3502 if (!dumb_shell) {
3503 if (!curlen) {
3504 do_quote = 1;
3505 }
02ef22d5
JH		 3506 else if (quote_next) {
3507 /* see if it really is multiple arguments pretending to
3508 * be one and force a set of quotes around it */
3509 if (*find_next_space(arg))
3510 do_quote = 1;
3511 }
7b11e424
JH		 3512 else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
3513 STRLEN i = 0;
3514 while (i < curlen) {
3515 if (isSPACE(arg[i])) {
3516 do_quote = 1;
02ef22d5
JH		 3517 }
3518 else if (arg[i] == '"') {
3519 do_quote = 0;
7b11e424
JH		 3520 break;
3521 }
3522 i++;
b309b8ae 3523 }
b309b8ae 3524 }
dd7038b3 3525 }
b309b8ae
JH		 3526
3527 if (do_quote)
3528 *ptr++ = '"';
3529
18a945d4 3530 strcpy(ptr, arg);
b309b8ae
JH		 3531 ptr += curlen;
3532
3533 if (do_quote)
3534 *ptr++ = '"';
3535
3536 if (args[index+1])
3537 *ptr++ = ' ';
3538
81bc1258
JH		 3539 if (!extra_quotes
3540 && cmd_shell
11998fdb
GS		 3541 && curlen >= 2
3542 && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
3543 && stricmp(arg+curlen-2, "/c") == 0)
b309b8ae 3544 {
dd7038b3
JH		 3545 /* is there a next argument? */
3546 if (args[index+1]) {
3547 /* are there two or more next arguments? */
3548 if (args[index+2]) {
3549 *ptr++ = '"';
3550 extra_quotes = TRUE;
3551 }
3552 else {
02ef22d5 3553 /* single argument, force quoting if it has spaces */
dd7038b3
JH		 3554 quote_next = TRUE;
3555 }
3556 }
b309b8ae 3557 }
0aaad0ff
GS		 3558 }
3559
b309b8ae
JH		 3560 if (extra_quotes)
3561 *ptr++ = '"';
3562
3563 *ptr = '\0';
3564
0aaad0ff
GS		 3565 return cmd;
3566}
3567
f5fe1b19
TC		 3568static const char *exe_extensions[] =
3569 {
3570 ".exe", /* this must be first */
3571 ".cmd",
3572 ".bat"
3573 };
3574
0aaad0ff 3575static char *
f5fe1b19 3576qualified_path(const char *cmd, bool other_exts)
0aaad0ff
GS		 3577{
3578 char *pathstr;
3579 char *fullcmd, *curfullcmd;
3580 STRLEN cmdlen = 0;
3581 int has_slash = 0;
3582
3583 if (!cmd)
4e205ed6 3584 return NULL;
0aaad0ff
GS		 3585 fullcmd = (char*)cmd;
3586 while (*fullcmd) {
3587 if (*fullcmd == '/' || *fullcmd == '\\')
3588 has_slash++;
3589 fullcmd++;
3590 cmdlen++;
3591 }
3592
3593 /* look in PATH */
04a2c3d9
DD		 3594 {
3595 dTHX;
3596 pathstr = PerlEnv_getenv("PATH");
3597 }
1928965c
JD		 3598 /* worst case: PATH is a single directory; we need additional space
3599 * to append "/", ".exe" and trailing "\0" */
a02a5408 3600 Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
0aaad0ff
GS		 3601 curfullcmd = fullcmd;
3602
3603 while (1) {
3604 DWORD res;
3605
3606 /* start by appending the name to the current prefix */
3607 strcpy(curfullcmd, cmd);
3608 curfullcmd += cmdlen;
3609
3610 /* if it doesn't end with '.', or has no extension, try adding
3611 * a trailing .exe first */
3612 if (cmd[cmdlen-1] != '.'
3613 && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
3614 {
f5fe1b19
TC		 3615 int i;
3616 /* first extension is .exe */
3617 int ext_limit = other_exts ? C_ARRAY_LENGTH(exe_extensions) : 1;
3618 for (i = 0; i < ext_limit; ++i) {
3619 strcpy(curfullcmd, exe_extensions[i]);
3620 res = GetFileAttributes(fullcmd);
3621 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3622 return fullcmd;
3623 }
3624
0aaad0ff
GS		 3625 *curfullcmd = '\0';
3626 }
3627
3628 /* that failed, try the bare name */
3629 res = GetFileAttributes(fullcmd);
3630 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3631 return fullcmd;
3632
3633 /* quit if no other path exists, or if cmd already has path */
3634 if (!pathstr || !*pathstr || has_slash)
3635 break;
3636
3637 /* skip leading semis */
3638 while (*pathstr == ';')
3639 pathstr++;
3640
3641 /* build a new prefix from scratch */
3642 curfullcmd = fullcmd;
3643 while (*pathstr && *pathstr != ';') {
3644 if (*pathstr == '"') { /* foo;"baz;etc";bar */
3645 pathstr++; /* skip initial '"' */
3646 while (*pathstr && *pathstr != '"') {
1928965c 3647 *curfullcmd++ = *pathstr++;
0aaad0ff
GS		 3648 }
3649 if (*pathstr)
3650 pathstr++; /* skip trailing '"' */
3651 }
3652 else {
1928965c 3653 *curfullcmd++ = *pathstr++;
0aaad0ff
GS		 3654 }
3655 }
3656 if (*pathstr)
3657 pathstr++; /* skip trailing semi */
3658 if (curfullcmd > fullcmd /* append a dir separator */
3659 && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
3660 {
3661 *curfullcmd++ = '\\';
3662 }
3663 }
eb160463 3664
0aaad0ff 3665 Safefree(fullcmd);
4e205ed6 3666 return NULL;
0aaad0ff
GS		 3667}
3668
3075ddba
GS		 3669/* The following are just place holders.
3670 * Some hosts may provide and environment that the OS is
3671 * not tracking, therefore, these host must provide that
3672 * environment and the current directory to CreateProcess
3673 */
3674
df3728a2
JH		 3675DllExport void*
3676win32_get_childenv(void)
3075ddba
GS		 3677{
3678 return NULL;
3679}
3680
df3728a2
JH		 3681DllExport void
3682win32_free_childenv(void* d)
3075ddba
GS		 3683{
3684}
3685
df3728a2
JH		 3686DllExport void
3687win32_clearenv(void)
3688{
3689 char *envv = GetEnvironmentStrings();
3690 char *cur = envv;
3691 STRLEN len;
3692 while (*cur) {
3693 char *end = strchr(cur,'=');
3694 if (end && end != cur) {
3695 *end = '\0';
3696 SetEnvironmentVariable(cur, NULL);
3697 *end = '=';
3698 cur = end + strlen(end+1)+2;
3699 }
3700 else if ((len = strlen(cur)))
3701 cur += len+1;
3702 }
3703 FreeEnvironmentStrings(envv);
3704}
3705
3706DllExport char*
3707win32_get_childdir(void)
3075ddba 3708{
7766f137 3709 char* ptr;
8c56068e 3710 char szfilename[MAX_PATH+1];
7766f137 3711
8c56068e 3712 GetCurrentDirectoryA(MAX_PATH+1, szfilename);
a02a5408 3713 Newx(ptr, strlen(szfilename)+1, char);
7766f137
GS		 3714 strcpy(ptr, szfilename);
3715 return ptr;
3075ddba
GS		 3716}
3717
df3728a2
JH		 3718DllExport void
3719win32_free_childdir(char* d)
3075ddba 3720{
7766f137 3721 Safefree(d);
3075ddba
GS		 3722}
3723
3724
0aaad0ff
GS		 3725/* XXX this needs to be made more compatible with the spawnvp()
3726 * provided by the various RTLs. In particular, searching for
3727 * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
3728 * This doesn't significantly affect perl itself, because we
3729 * always invoke things using PERL5SHELL if a direct attempt to
3730 * spawn the executable fails.
3fadfdf1 3731 *
0aaad0ff
GS		 3732 * XXX splitting and rejoining the commandline between do_aspawn()
3733 * and win32_spawnvp() could also be avoided.
3734 */
3735
5aabfad6 3736DllExport int
3e3baf6d 3737win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
0a753a76 3738{
0aaad0ff 3739#ifdef USE_RTL_SPAWNVP
8fdfe84a 3740 return _spawnvp(mode, cmdname, (char * const *)argv);
0aaad0ff 3741#else
f06c8825
TC		 3742 return do_spawnvp_handles(mode, cmdname, argv, NULL);
3743#endif
3744}
3745
3746static int
3747do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv,
3748 const int *handles) {
9399a70c 3749 dTHXa(NULL);
2b260de0 3750 int ret;
3075ddba
GS		 3751 void* env;
3752 char* dir;
635bbe87 3753 child_IO_table tbl;
0aaad0ff
GS		 3754 STARTUPINFO StartupInfo;
3755 PROCESS_INFORMATION ProcessInformation;
3756 DWORD create = 0;
dd7038b3 3757 char *cmd;
4e205ed6 3758 char *fullcmd = NULL;
dd7038b3
JH		 3759 char *cname = (char *)cmdname;
3760 STRLEN clen = 0;
3761
3762 if (cname) {
3763 clen = strlen(cname);
3764 /* if command name contains dquotes, must remove them */
3765 if (strchr(cname, '"')) {
3766 cmd = cname;
a02a5408 3767 Newx(cname,clen+1,char);
dd7038b3
JH		 3768 clen = 0;
3769 while (*cmd) {
3770 if (*cmd != '"') {
3771 cname[clen] = *cmd;
3772 ++clen;
3773 }
3774 ++cmd;
3775 }
3776 cname[clen] = '\0';
3777 }
3778 }
3779
3780 cmd = create_command_line(cname, clen, argv);
0aaad0ff 3781
9399a70c 3782 aTHXa(PERL_GET_THX);
3075ddba
GS		 3783 env = PerlEnv_get_childenv();
3784 dir = PerlEnv_get_childdir();
3785
0aaad0ff
GS		 3786 switch(mode) {
3787 case P_NOWAIT: /* asynch + remember result */
3788 if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
3789 errno = EAGAIN;
3790 ret = -1;
3791 goto RETVAL;
3792 }
3fadfdf1 3793 /* Create a new process group so we can use GenerateConsoleCtrlEvent()
7e5f34c0
NIS		 3794 * in win32_kill()
3795 */
3fadfdf1 3796 create |= CREATE_NEW_PROCESS_GROUP;
0aaad0ff 3797 /* FALL THROUGH */
7e5f34c0 3798
0aaad0ff
GS		 3799 case P_WAIT: /* synchronous execution */
3800 break;
3801 default: /* invalid mode */
3802 errno = EINVAL;
3803 ret = -1;
3804 goto RETVAL;
3805 }
f06c8825 3806
0aaad0ff
GS		 3807 memset(&StartupInfo,0,sizeof(StartupInfo));
3808 StartupInfo.cb = sizeof(StartupInfo);
f83751a7 3809 memset(&tbl,0,sizeof(tbl));
635bbe87 3810 PerlEnv_get_child_IO(&tbl);
f83751a7 3811 StartupInfo.dwFlags = tbl.dwFlags;
3fadfdf1
NIS		 3812 StartupInfo.dwX = tbl.dwX;
3813 StartupInfo.dwY = tbl.dwY;
3814 StartupInfo.dwXSize = tbl.dwXSize;
3815 StartupInfo.dwYSize = tbl.dwYSize;
3816 StartupInfo.dwXCountChars = tbl.dwXCountChars;
3817 StartupInfo.dwYCountChars = tbl.dwYCountChars;
3818 StartupInfo.dwFillAttribute = tbl.dwFillAttribute;
3819 StartupInfo.wShowWindow = tbl.wShowWindow;
f06c8825
TC		 3820 StartupInfo.hStdInput = handles && handles[0] != -1 ?
3821 (HANDLE)_get_osfhandle(handles[0]) : tbl.childStdIn;
3822 StartupInfo.hStdOutput = handles && handles[1] != -1 ?
3823 (HANDLE)_get_osfhandle(handles[1]) : tbl.childStdOut;
3824 StartupInfo.hStdError = handles && handles[2] != -1 ?
3825 (HANDLE)_get_osfhandle(handles[2]) : tbl.childStdErr;
139cf11b
GS		 3826 if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE &&
3827 StartupInfo.hStdOutput == INVALID_HANDLE_VALUE &&
3828 StartupInfo.hStdError == INVALID_HANDLE_VALUE)
3ffaa937 3829 {
139cf11b 3830 create |= CREATE_NEW_CONSOLE;
3ffaa937
GS		 3831 }
3832 else {
139cf11b 3833 StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
3ffaa937 3834 }
02637f4c
JD		 3835 if (w32_use_showwindow) {
3836 StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
3837 StartupInfo.wShowWindow = w32_showwindow;
3838 }
3ffaa937 3839
b309b8ae 3840 DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
dd7038b3 3841 cname,cmd));
0aaad0ff 3842RETRY:
dd7038b3 3843 if (!CreateProcess(cname, /* search PATH to find executable */
0aaad0ff
GS		 3844 cmd, /* executable, and its arguments */
3845 NULL, /* process attributes */
3846 NULL, /* thread attributes */
3847 TRUE, /* inherit handles */
3848 create, /* creation flags */
3075ddba
GS		 3849 (LPVOID)env, /* inherit environment */
3850 dir, /* inherit cwd */
0aaad0ff
GS		 3851 &StartupInfo,
3852 &ProcessInformation))
3853 {
3854 /* initial NULL argument to CreateProcess() does a PATH
3855 * search, but it always first looks in the directory
3856 * where the current process was started, which behavior
3857 * is undesirable for backward compatibility. So we
3858 * jump through our own hoops by picking out the path
3859 * we really want it to use. */
3860 if (!fullcmd) {
f5fe1b19 3861 fullcmd = qualified_path(cname, FALSE);
0aaad0ff 3862 if (fullcmd) {
dd7038b3
JH		 3863 if (cname != cmdname)
3864 Safefree(cname);
3865 cname = fullcmd;
b309b8ae
JH		 3866 DEBUG_p(PerlIO_printf(Perl_debug_log,
3867 "Retrying [%s] with same args\n",
dd7038b3 3868 cname));
0aaad0ff
GS		 3869 goto RETRY;
3870 }
3871 }
3872 errno = ENOENT;
3873 ret = -1;
3874 goto RETVAL;
3875 }
2d7a9237 3876
0aaad0ff
GS		 3877 if (mode == P_NOWAIT) {
3878 /* asynchronous spawn -- store handle, return PID */
2b260de0 3879 ret = (int)ProcessInformation.dwProcessId;
922b1888
GS		 3880
3881 w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
3882 w32_child_pids[w32_num_children] = (DWORD)ret;
0aaad0ff
GS		 3883 ++w32_num_children;
3884 }
3885 else {
2b260de0 3886 DWORD status;
8fb3fcfb 3887 win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
7e5f34c0
NIS		 3888 /* FIXME: if msgwait returned due to message perhaps forward the
3889 "signal" to the process
3890 */
2b260de0
GS		 3891 GetExitCodeProcess(ProcessInformation.hProcess, &status);
3892 ret = (int)status;
0aaad0ff
GS		 3893 CloseHandle(ProcessInformation.hProcess);
3894 }
e17cb2a9 3895
0aaad0ff 3896 CloseHandle(ProcessInformation.hThread);
3075ddba 3897
0aaad0ff 3898RETVAL:
3075ddba
GS		 3899 PerlEnv_free_childenv(env);
3900 PerlEnv_free_childdir(dir);
0aaad0ff 3901 Safefree(cmd);
dd7038b3
JH		 3902 if (cname != cmdname)
3903 Safefree(cname);
2b260de0 3904 return ret;
0a753a76 3905}
3906
6890e559 3907DllExport int
eb62e965
JD		 3908win32_execv(const char *cmdname, const char *const *argv)
3909{
7766f137 3910#ifdef USE_ITHREADS
acfe0abc 3911 dTHX;
7766f137
GS		 3912 /* if this is a pseudo-forked child, we just want to spawn
3913 * the new program, and return */
3914 if (w32_pseudo_id)
8fdfe84a 3915 return _spawnv(P_WAIT, cmdname, argv);
7766f137 3916#endif
8fdfe84a 3917 return _execv(cmdname, argv);
eb62e965
JD		 3918}
3919
3920DllExport int
6890e559
GS		 3921win32_execvp(const char *cmdname, const char *const *argv)
3922{
7766f137 3923#ifdef USE_ITHREADS
acfe0abc 3924 dTHX;
7766f137
GS		 3925 /* if this is a pseudo-forked child, we just want to spawn
3926 * the new program, and return */
190e4ad0 3927 if (w32_pseudo_id) {
f026e7c6 3928 int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv);
ba6ce41c
GS		 3929 if (status != -1) {
3930 my_exit(status);
3931 return 0;
3932 }
3933 else
3934 return status;
190e4ad0 3935 }
7766f137 3936#endif
8fdfe84a 3937 return _execvp(cmdname, argv);
6890e559
GS		 3938}
3939
84902520
TB		 3940DllExport void
3941win32_perror(const char *str)
3942{
390b85e7 3943 perror(str);
84902520
TB		 3944}
3945
3946DllExport void
3947win32_setbuf(FILE *pf, char *buf)
3948{
390b85e7 3949 setbuf(pf, buf);
84902520
TB		 3950}
3951
3952DllExport int
3953win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
3954{
390b85e7 3955 return setvbuf(pf, buf, type, size);
84902520
TB		 3956}
3957
3958DllExport int
3959win32_flushall(void)
3960{
390b85e7 3961 return flushall();
84902520
TB		 3962}
3963
3964DllExport int
3965win32_fcloseall(void)
3966{
390b85e7 3967 return fcloseall();
84902520
TB		 3968}
3969
3970DllExport char*
3971win32_fgets(char *s, int n, FILE *pf)
3972{
390b85e7 3973 return fgets(s, n, pf);
84902520
TB		 3974}
3975
3976DllExport char*
3977win32_gets(char *s)
3978{
390b85e7 3979 return gets(s);
84902520
TB		 3980}
3981
3982DllExport int
3983win32_fgetc(FILE *pf)
3984{
390b85e7 3985 return fgetc(pf);
84902520
TB		 3986}
3987
3988DllExport int
3989win32_putc(int c, FILE *pf)
3990{
390b85e7 3991 return putc(c,pf);
84902520
TB		 3992}
3993
3994DllExport int
3995win32_puts(const char *s)
3996{
390b85e7 3997 return puts(s);
84902520
TB		 3998}
3999
4000DllExport int
4001win32_getchar(void)
4002{
390b85e7 4003 return getchar();
84902520
TB		 4004}
4005
4006DllExport int
4007win32_putchar(int c)
4008{
390b85e7 4009 return putchar(c);
84902520
TB		 4010}
4011
bbc8f9de
NIS		 4012#ifdef MYMALLOC
4013
4014#ifndef USE_PERL_SBRK
4015
df3728a2
JH		 4016static char *committed = NULL; /* XXX threadead */
4017static char *base = NULL; /* XXX threadead */
4018static char *reserved = NULL; /* XXX threadead */
4019static char *brk = NULL; /* XXX threadead */
4020static DWORD pagesize = 0; /* XXX threadead */
bbc8f9de
NIS		 4021
4022void *
c623ac67 4023sbrk(ptrdiff_t need)
bbc8f9de
NIS		 4024{
4025 void *result;
4026 if (!pagesize)
4027 {SYSTEM_INFO info;
4028 GetSystemInfo(&info);
4029 /* Pretend page size is larger so we don't perpetually
4030 * call the OS to commit just one page ...
4031 */
4032 pagesize = info.dwPageSize << 3;
bbc8f9de 4033 }
bbc8f9de
NIS		 4034 if (brk+need >= reserved)
4035 {
b2d41e21 4036 DWORD size = brk+need-reserved;
bbc8f9de 4037 char *addr;
b2d41e21 4038 char *prev_committed = NULL;
bbc8f9de
NIS		 4039 if (committed && reserved && committed < reserved)
4040 {
4041 /* Commit last of previous chunk cannot span allocations */
161b471a 4042 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de 4043 if (addr)
b2d41e21
SH		 4044 {
4045 /* Remember where we committed from in case we want to decommit later */
4046 prev_committed = committed;
bbc8f9de 4047 committed = reserved;
b2d41e21 4048 }
bbc8f9de 4049 }
3fadfdf1 4050 /* Reserve some (more) space
b2d41e21
SH		 4051 * Contiguous blocks give us greater efficiency, so reserve big blocks -
4052 * this is only address space not memory...
bbc8f9de
NIS		 4053 * Note this is a little sneaky, 1st call passes NULL as reserved
4054 * so lets system choose where we start, subsequent calls pass
4055 * the old end address so ask for a contiguous block
4056 */
b2d41e21
SH		 4057sbrk_reserve:
4058 if (size < 64*1024*1024)
4059 size = 64*1024*1024;
4060 size = ((size + pagesize - 1) / pagesize) * pagesize;
161b471a 4061 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
bbc8f9de
NIS		 4062 if (addr)
4063 {
4064 reserved = addr+size;
4065 if (!base)
4066 base = addr;
4067 if (!committed)
4068 committed = base;
4069 if (!brk)
4070 brk = committed;
4071 }
b2d41e21
SH		 4072 else if (reserved)
4073 {
4074 /* The existing block could not be extended far enough, so decommit
4075 * anything that was just committed above and start anew */
4076 if (prev_committed)
4077 {
4078 if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT))
4079 return (void *) -1;
4080 }
4081 reserved = base = committed = brk = NULL;
4082 size = need;
4083 goto sbrk_reserve;
4084 }
bbc8f9de
NIS		 4085 else
4086 {
4087 return (void *) -1;
4088 }
4089 }
4090 result = brk;
4091 brk += need;
4092 if (brk > committed)
4093 {
4094 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
b2d41e21
SH		 4095 char *addr;
4096 if (committed+size > reserved)
4097 size = reserved-committed;
4098 addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de 4099 if (addr)
b2d41e21 4100 committed += size;
bbc8f9de
NIS		 4101 else
4102 return (void *) -1;
4103 }
4104 return result;
4105}
4106
4107#endif
4108#endif
4109
84902520
TB		 4110DllExport void*
4111win32_malloc(size_t size)
4112{
390b85e7 4113 return malloc(size);
84902520
TB		 4114}
4115
4116DllExport void*
4117win32_calloc(size_t numitems, size_t size)
4118{
390b85e7 4119 return calloc(numitems,size);
84902520
TB		 4120}
4121
4122DllExport void*
4123win32_realloc(void *block, size_t size)
4124{
390b85e7 4125 return realloc(block,size);
84902520
TB		 4126}
4127
4128DllExport void
4129win32_free(void *block)
4130{
390b85e7 4131 free(block);
84902520
TB		 4132}
4133
bbc8f9de 4134
6e21dc91 4135DllExport int
c623ac67 4136win32_open_osfhandle(intptr_t handle, int flags)
0a753a76 4137{
390b85e7 4138 return _open_osfhandle(handle, flags);
0a753a76 4139}
4140
6e21dc91 4141DllExport intptr_t
65e48ea9 4142win32_get_osfhandle(int fd)
0a753a76 4143{
c623ac67 4144 return (intptr_t)_get_osfhandle(fd);
0a753a76 4145}
7bac28a0 4146
6e21dc91 4147DllExport FILE *
30753f56
NIS		 4148win32_fdupopen(FILE *pf)
4149{
4150 FILE* pfdup;
4151 fpos_t pos;
4152 char mode[3];
4153 int fileno = win32_dup(win32_fileno(pf));
4154
4155 /* open the file in the same mode */
30753f56
NIS		 4156 if((pf)->_flag & _IOREAD) {
4157 mode[0] = 'r';
4158 mode[1] = 0;
4159 }
4160 else if((pf)->_flag & _IOWRT) {
4161 mode[0] = 'a';
4162 mode[1] = 0;
4163 }
4164 else if((pf)->_flag & _IORW) {
4165 mode[0] = 'r';
4166 mode[1] = '+';
4167 mode[2] = 0;
4168 }
30753f56
NIS		 4169
4170 /* it appears that the binmode is attached to the
4171 * file descriptor so binmode files will be handled
4172 * correctly
4173 */
4174 pfdup = win32_fdopen(fileno, mode);
4175
4176 /* move the file pointer to the same position */
4177 if (!fgetpos(pf, &pos)) {
4178 fsetpos(pfdup, &pos);
4179 }
4180 return pfdup;
4181}
4182
0cb96387 4183DllExport void*
c5be433b 4184win32_dynaload(const char* filename)
0cb96387 4185{
04a2c3d9 4186 dTHXa(NULL);
32f99636 4187 char buf[MAX_PATH+1];
f76b679e 4188 const char *first;
32f99636
GS		 4189
4190 /* LoadLibrary() doesn't recognize forward slashes correctly,
4191 * so turn 'em back. */
4192 first = strchr(filename, '/');
4193 if (first) {
4194 STRLEN len = strlen(filename);
4195 if (len <= MAX_PATH) {
4196 strcpy(buf, filename);
4197 filename = &buf[first - filename];
4198 while (*filename) {
4199 if (*filename == '/')
4200 *(char*)filename = '\\';
4201 ++filename;
4202 }
4203 filename = buf;
4204 }
4205 }
04a2c3d9 4206 aTHXa(PERL_GET_THX);
8c56068e 4207 return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
0cb96387
GS		 4208}
4209
5bd7e777
JD		 4210XS(w32_SetChildShowWindow)
4211{
4212 dXSARGS;
4213 BOOL use_showwindow = w32_use_showwindow;
4214 /* use "unsigned short" because Perl has redefined "WORD" */
4215 unsigned short showwindow = w32_showwindow;
4216
4217 if (items > 1)
470eba0e 4218 croak_xs_usage(cv, "[showwindow]");
5bd7e777
JD		 4219
4220 if (items == 0 || !SvOK(ST(0)))
4221 w32_use_showwindow = FALSE;
4222 else {
4223 w32_use_showwindow = TRUE;
4224 w32_showwindow = (unsigned short)SvIV(ST(0));
4225 }
4226
4227 EXTEND(SP, 1);
4228 if (use_showwindow)
4229 ST(0) = sv_2mortal(newSViv(showwindow));
4230 else
4231 ST(0) = &PL_sv_undef;
4232 XSRETURN(1);
4233}
4234
ad2e33dc 4235void
c5be433b 4236Perl_init_os_extras(void)
ad2e33dc 4237{
04a2c3d9 4238 dTHXa(NULL);
ad2e33dc 4239 char *file = __FILE__;
ad2e33dc 4240
9fb265f7 4241 /* Initialize Win32CORE if it has been statically linked. */
a19baa61 4242#ifndef PERL_IS_MINIPERL
9fb265f7 4243 void (*pfn_init)(pTHX);
903f2d70
SH		 4244 HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
4245 ? GetModuleHandle(NULL)
4246 : w32_perldll_handle);
4247 pfn_init = (void (*)(pTHX))GetProcAddress(module, "init_Win32CORE");
04a2c3d9 4248 aTHXa(PERL_GET_THX);
9fb265f7
JD		 4249 if (pfn_init)
4250 pfn_init(aTHX);
04a2c3d9
DD		 4251#else
4252 aTHXa(PERL_GET_THX);
a19baa61 4253#endif
78ff2d7b 4254
02637f4c 4255 newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
ad2e33dc
GS		 4256}
4257
f4958739 4258void *
1018e26f 4259win32_signal_context(void)
c843839f
NIS		 4260{
4261 dTHX;
f4958739 4262#ifdef MULTIPLICITY
c843839f 4263 if (!my_perl) {
1018e26f 4264 my_perl = PL_curinterp;
c843839f 4265 PERL_SET_THX(my_perl);
3fadfdf1 4266 }
1018e26f 4267 return my_perl;
f4958739 4268#else
d9a047f6
GS		 4269 return PL_curinterp;
4270#endif
1018e26f
NIS		 4271}
4272
96116d93 4273
3fadfdf1 4274BOOL WINAPI
1018e26f
NIS		 4275win32_ctrlhandler(DWORD dwCtrlType)
4276{
96116d93 4277#ifdef MULTIPLICITY
1018e26f
NIS		 4278 dTHXa(PERL_GET_SIG_CONTEXT);
4279
4280 if (!my_perl)
4281 return FALSE;
96116d93 4282#endif
c843839f
NIS		 4283
4284 switch(dwCtrlType) {
4285 case CTRL_CLOSE_EVENT:
3fadfdf1
NIS		 4286 /* A signal that the system sends to all processes attached to a console when
4287 the user closes the console (either by choosing the Close command from the
4288 console window's System menu, or by choosing the End Task command from the
c843839f
NIS		 4289 Task List
4290 */
3fadfdf1
NIS		 4291 if (do_raise(aTHX_ 1)) /* SIGHUP */
4292 sig_terminate(aTHX_ 1);
4293 return TRUE;
c843839f
NIS		 4294
4295 case CTRL_C_EVENT:
4296 /* A CTRL+c signal was received */
3fadfdf1
NIS		 4297 if (do_raise(aTHX_ SIGINT))
4298 sig_terminate(aTHX_ SIGINT);
4299 return TRUE;
c843839f
NIS		 4300
4301 case CTRL_BREAK_EVENT:
4302 /* A CTRL+BREAK signal was received */
3fadfdf1
NIS		 4303 if (do_raise(aTHX_ SIGBREAK))
4304 sig_terminate(aTHX_ SIGBREAK);
4305 return TRUE;
c843839f
NIS		 4306
4307 case CTRL_LOGOFF_EVENT:
3fadfdf1
NIS		 4308 /* A signal that the system sends to all console processes when a user is logging
4309 off. This signal does not indicate which user is logging off, so no
4310 assumptions can be made.
c843839f 4311 */
3fadfdf1 4312 break;
c843839f 4313 case CTRL_SHUTDOWN_EVENT:
3fadfdf1
NIS		 4314 /* A signal that the system sends to all console processes when the system is
4315 shutting down.
c843839f 4316 */
3fadfdf1
NIS		 4317 if (do_raise(aTHX_ SIGTERM))
4318 sig_terminate(aTHX_ SIGTERM);
4319 return TRUE;
c843839f 4320 default:
3fadfdf1 4321 break;
c843839f
NIS		 4322 }
4323 return FALSE;
4324}
c843839f
NIS		 4325
4326
58d049f0 4327#ifdef SET_INVALID_PARAMETER_HANDLER
0448a0bd
SH		 4328# include <crtdbg.h>
4329#endif
4330
dc0472e9
JD		 4331static void
4332ansify_path(void)
4333{
dc0472e9
JD		 4334 size_t len;
4335 char *ansi_path;
4336 WCHAR *wide_path;
4337 WCHAR *wide_dir;
4338
dc0472e9
JD		 4339 /* fetch Unicode version of PATH */
4340 len = 2000;
f76b679e 4341 wide_path = (WCHAR*)win32_malloc(len*sizeof(WCHAR));
dc0472e9
JD		 4342 while (wide_path) {
4343 size_t newlen = GetEnvironmentVariableW(L"PATH", wide_path, len);
cfd4abf2
SH		 4344 if (newlen == 0) {
4345 win32_free(wide_path);
3fcdbd32 4346 return;
cfd4abf2 4347 }
dc0472e9
JD		 4348 if (newlen < len)
4349 break;
4350 len = newlen;
f76b679e 4351 wide_path = (WCHAR*)win32_realloc(wide_path, len*sizeof(WCHAR));
dc0472e9
JD		 4352 }
4353 if (!wide_path)
4354 return;
4355
4356 /* convert to ANSI pathnames */
4357 wide_dir = wide_path;
4358 ansi_path = NULL;
4359 while (wide_dir) {
4360 WCHAR *sep = wcschr(wide_dir, ';');
4361 char *ansi_dir;
4362 size_t ansi_len;
4363 size_t wide_len;
4364
4365 if (sep)
4366 *sep++ = '\0';
4367
4368 /* remove quotes around pathname */
4369 if (*wide_dir == '"')
4370 ++wide_dir;
4371 wide_len = wcslen(wide_dir);
4372 if (wide_len && wide_dir[wide_len-1] == '"')
4373 wide_dir[wide_len-1] = '\0';
4374
4375 /* append ansi_dir to ansi_path */
4376 ansi_dir = win32_ansipath(wide_dir);
4377 ansi_len = strlen(ansi_dir);
4378 if (ansi_path) {
4379 size_t newlen = len + 1 + ansi_len;
f76b679e 4380 ansi_path = (char*)win32_realloc(ansi_path, newlen+1);
dc0472e9
JD		 4381 if (!ansi_path)
4382 break;
4383 ansi_path[len] = ';';
4384 memcpy(ansi_path+len+1, ansi_dir, ansi_len+1);
4385 len = newlen;
4386 }
4387 else {
4388 len = ansi_len;
f76b679e 4389 ansi_path = (char*)win32_malloc(5+len+1);
dc0472e9
JD		 4390 if (!ansi_path)
4391 break;
4392 memcpy(ansi_path, "PATH=", 5);
4393 memcpy(ansi_path+5, ansi_dir, len+1);
4394 len += 5;
4395 }
4396 win32_free(ansi_dir);
4397 wide_dir = sep;
4398 }
4399
4400 if (ansi_path) {
4401 /* Update C RTL environ array. This will only have full effect if
4402 * perl_parse() is later called with `environ` as the `env` argument.
4403 * Otherwise S_init_postdump_symbols() will overwrite PATH again.
4404 *
4405 * We do have to ansify() the PATH before Perl has been fully
4406 * initialized because S_find_script() uses the PATH when perl
4407 * is being invoked with the -S option. This happens before %ENV
4408 * is initialized in S_init_postdump_symbols().
4409 *
4410 * XXX Is this a bug? Should S_find_script() use the environment
4411 * XXX passed in the `env` arg to parse_perl()?
4412 */
4413 putenv(ansi_path);
4414 /* Keep system environment in sync because S_init_postdump_symbols()
4415 * will not call mg_set() if it initializes %ENV from `environ`.
4416 */
4417 SetEnvironmentVariableA("PATH", ansi_path+5);
0c2c57a8 4418 win32_free(ansi_path);
dc0472e9
JD		 4419 }
4420 win32_free(wide_path);
4421}
c843839f 4422
3e5d884e
JD		 4423void
4424Perl_win32_init(int *argcp, char ***argvp)
4425{
58d049f0 4426#ifdef SET_INVALID_PARAMETER_HANDLER
3e5d884e
JD		 4427 _invalid_parameter_handler oldHandler, newHandler;
4428 newHandler = my_invalid_parameter_handler;
4429 oldHandler = _set_invalid_parameter_handler(newHandler);
4430 _CrtSetReportMode(_CRT_ASSERT, 0);
4431#endif
4432 /* Disable floating point errors, Perl will trap the ones we
4433 * care about. VC++ RTL defaults to switching these off
378eeda7 4434 * already, but some RTLs don't. Since we don't
3e5d884e
JD		 4435 * want to be at the vendor's whim on the default, we set
4436 * it explicitly here.
4437 */
7ffd6586 4438#if !defined(__GNUC__)
3e5d884e
JD		 4439 _control87(MCW_EM, MCW_EM);
4440#endif
4441 MALLOC_INIT;
4442
dbb3120a
SH		 4443 /* When the manifest resource requests Common-Controls v6 then
4444 * user32.dll no longer registers all the Windows classes used for
4445 * standard controls but leaves some of them to be registered by
4446 * comctl32.dll. InitCommonControls() doesn't do anything but calling
4447 * it makes sure comctl32.dll gets loaded into the process and registers
4448 * the standard control classes. Without this even normal Windows APIs
4449 * like MessageBox() can fail under some versions of Windows XP.
4450 */
4451 InitCommonControls();
4452
3e5d884e
JD		 4453 g_osver.dwOSVersionInfoSize = sizeof(g_osver);
4454 GetVersionEx(&g_osver);
4455
b47a847f
DD		 4456#ifdef WIN32_DYN_IOINFO_SIZE
4457 {
4458 Size_t ioinfo_size = _msize((void*)__pioinfo[0]);;
4459 if((SSize_t)ioinfo_size <= 0) { /* -1 is err */
4460 fprintf(stderr, "panic: invalid size for ioinfo\n"); /* no interp */
4461 exit(1);
4462 }
4463 ioinfo_size /= IOINFO_ARRAY_ELTS;
4464 w32_ioinfo_size = ioinfo_size;
4465 }
4466#endif
4467
3e5d884e 4468 ansify_path();
6937817d
DD		 4469
4470#ifndef WIN32_NO_REGISTRY
0517ed38
DD		 4471 {
4472 LONG retval;
4473 retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd);
4474 if (retval != ERROR_SUCCESS) {
4475 HKCU_Perl_hnd = NULL;
4476 }
4477 retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd);
4478 if (retval != ERROR_SUCCESS) {
4479 HKLM_Perl_hnd = NULL;
4480 }
4481 }
6937817d 4482#endif
3e5d884e
JD		 4483}
4484
4485void
4486Perl_win32_term(void)
4487{
3e5d884e
JD		 4488 HINTS_REFCNT_TERM;
4489 OP_REFCNT_TERM;
4490 PERLIO_TERM;
4491 MALLOC_TERM;
6937817d 4492#ifndef WIN32_NO_REGISTRY
0517ed38
DD		 4493 /* handles might be NULL, RegCloseKey then returns ERROR_INVALID_HANDLE
4494 but no point of checking and we can't die() at this point */
4495 RegCloseKey(HKLM_Perl_hnd);
4496 RegCloseKey(HKCU_Perl_hnd);
4497 /* the handles are in an undefined state until the next PERL_SYS_INIT3 */
6937817d 4498#endif
3e5d884e
JD		 4499}
4500
4501void
4502win32_get_child_IO(child_IO_table* ptbl)
4503{
4504 ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
4505 ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
4506 ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE);
4507}
4508
4509Sighandler_t
4510win32_signal(int sig, Sighandler_t subcode)
4511{
04a2c3d9 4512 dTHXa(NULL);
3e5d884e
JD		 4513 if (sig < SIG_SIZE) {
4514 int save_errno = errno;
d52ca586
SH		 4515 Sighandler_t result;
4516#ifdef SET_INVALID_PARAMETER_HANDLER
4517 /* Silence our invalid parameter handler since we expect to make some
4518 * calls with invalid signal numbers giving a SIG_ERR result. */
4519 BOOL oldvalue = set_silent_invalid_parameter_handler(TRUE);
4520#endif
4521 result = signal(sig, subcode);
4522#ifdef SET_INVALID_PARAMETER_HANDLER
4523 set_silent_invalid_parameter_handler(oldvalue);
4524#endif
04a2c3d9 4525 aTHXa(PERL_GET_THX);
3e5d884e
JD		 4526 if (result == SIG_ERR) {
4527 result = w32_sighandler[sig];
4528 errno = save_errno;
4529 }
4530 w32_sighandler[sig] = subcode;
4531 return result;
4532 }
4533 else {
4534 errno = EINVAL;
4535 return SIG_ERR;
4536 }
4537}
4538
099b16d3
RM		 4539/* The PerlMessageWindowClass's WindowProc */
4540LRESULT CALLBACK
4541win32_message_window_proc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
4542{
4543 return win32_process_message(hwnd, msg, wParam, lParam) ?
4544 0 : DefWindowProc(hwnd, msg, wParam, lParam);
4545}
4546
099b16d3
RM		 4547/* The real message handler. Can be called with
4548 * hwnd == NULL to process our thread messages. Returns TRUE for any messages
4549 * that it processes */
4550static LRESULT
4551win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
4552{
4553 /* BEWARE. The context retrieved using dTHX; is the context of the
4554 * 'parent' thread during the CreateWindow() phase - i.e. for all messages
4555 * up to and including WM_CREATE. If it ever happens that you need the
4556 * 'child' context before this, then it needs to be passed into
4557 * win32_create_message_window(), and passed to the WM_NCCREATE handler
4558 * from the lparam of CreateWindow(). It could then be stored/retrieved
4559 * using [GS]etWindowLongPtr(... GWLP_USERDATA ...), possibly eliminating
4560 * the dTHX calls here. */
4561 /* XXX For now it is assumed that the overhead of the dTHX; for what
4562 * are relativley infrequent code-paths, is better than the added
4563 * complexity of getting the correct context passed into
4564 * win32_create_message_window() */
04a2c3d9 4565 dTHX;
099b16d3
RM		 4566
4567 switch(msg) {
4568
4569#ifdef USE_ITHREADS
4570 case WM_USER_MESSAGE: {
04a2c3d9 4571 long child = find_pseudo_pid(aTHX_ (int)wParam);
099b16d3 4572 if (child >= 0) {
099b16d3
RM		 4573 w32_pseudo_child_message_hwnds[child] = (HWND)lParam;
4574 return 1;
4575 }
4576 break;
4577 }
4578#endif
4579
4580 case WM_USER_KILL: {
099b16d3
RM		 4581 /* We use WM_USER_KILL to fake kill() with other signals */
4582 int sig = (int)wParam;
4583 if (do_raise(aTHX_ sig))
4584 sig_terminate(aTHX_ sig);
4585
4586 return 1;
4587 }
4588
4589 case WM_TIMER: {
099b16d3
RM		 4590 /* alarm() is a one-shot but SetTimer() repeats so kill it */
4591 if (w32_timerid && w32_timerid==(UINT)wParam) {
4592 KillTimer(w32_message_hwnd, w32_timerid);
4593 w32_timerid=0;
4594
4595 /* Now fake a call to signal handler */
4596 if (do_raise(aTHX_ 14))
4597 sig_terminate(aTHX_ 14);
4598
4599 return 1;
4600 }
4601 break;
4602 }
4603
4604 default:
4605 break;
4606
4607 } /* switch */
4608
4609 /* Above or other stuff may have set a signal flag, and we may not have
4610 * been called from win32_async_check() (e.g. some other GUI's message
4611 * loop. BUT DON'T dispatch signals here: If someone has set a SIGALRM
4612 * handler that die's, and the message loop that calls here is wrapped
4613 * in an eval, then you may well end up with orphaned windows - signals
4614 * are dispatched by win32_async_check() */
4615
4616 return 0;
4617}
4618
4619void
0934c9d9 4620win32_create_message_window_class(void)
099b16d3
RM		 4621{
4622 /* create the window class for "message only" windows */
4623 WNDCLASS wc;
4624
4625 Zero(&wc, 1, wc);
4626 wc.lpfnWndProc = win32_message_window_proc;
4627 wc.hInstance = (HINSTANCE)GetModuleHandle(NULL);
4628 wc.lpszClassName = "PerlMessageWindowClass";
4629
4630 /* second and subsequent calls will fail, but class
4631 * will already be registered */
4632 RegisterClass(&wc);
4633}
4634
aeecf691 4635HWND
0934c9d9 4636win32_create_message_window(void)
aeecf691 4637{
8cbe99e5
JD		 4638 win32_create_message_window_class();
4639 return CreateWindow("PerlMessageWindowClass", "PerlMessageWindow",
4640 0, 0, 0, 0, 0, HWND_MESSAGE, NULL, NULL, NULL);
aeecf691
JD		 4641}
4642
a33ef3f0
SH		 4643#ifdef HAVE_INTERP_INTERN
4644
4645static void
4646win32_csighandler(int sig)
4647{
4648#if 0
4649 dTHXa(PERL_GET_SIG_CONTEXT);
4650 Perl_warn(aTHX_ "Got signal %d",sig);
4651#endif
4652 /* Does nothing */
4653}
4654
edb113cf 4655#if defined(__MINGW32__) && defined(__cplusplus)
beeded0b
YO		 4656#define CAST_HWND__(x) (HWND__*)(x)
4657#else
4658#define CAST_HWND__(x) x
4659#endif
4660
7766f137 4661void
52853b95
GS		 4662Perl_sys_intern_init(pTHX)
4663{
3fadfdf1 4664 int i;
aeecf691 4665
4e205ed6 4666 w32_perlshell_tokens = NULL;
52853b95
GS		 4667 w32_perlshell_vec = (char**)NULL;
4668 w32_perlshell_items = 0;
4669 w32_fdpid = newAV();
a02a5408 4670 Newx(w32_children, 1, child_tab);
52853b95
GS		 4671 w32_num_children = 0;
4672# ifdef USE_ITHREADS
4673 w32_pseudo_id = 0;
aeecf691 4674 Newx(w32_pseudo_children, 1, pseudo_child_tab);
52853b95
GS		 4675 w32_num_pseudo_children = 0;
4676# endif
222c300a 4677 w32_timerid = 0;
beeded0b 4678 w32_message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);
05ec9bb3 4679 w32_poll_count = 0;
8ca2a5d6
DD		 4680#ifdef PERL_IS_MINIPERL
4681 w32_sloppystat = TRUE;
4682#else
4683 w32_sloppystat = FALSE;
4684#endif
3fadfdf1
NIS		 4685 for (i=0; i < SIG_SIZE; i++) {
4686 w32_sighandler[i] = SIG_DFL;
4687 }
00967642 4688# ifdef MULTIPLICITY
1018e26f 4689 if (my_perl == PL_curinterp) {
96116d93
MB		 4690# else
4691 {
4692# endif
3fadfdf1 4693 /* Force C runtime signal stuff to set its console handler */
1c127fab
SH		 4694 signal(SIGINT,win32_csighandler);
4695 signal(SIGBREAK,win32_csighandler);
0a311364
JD		 4696
4697 /* We spawn asynchronous processes with the CREATE_NEW_PROCESS_GROUP
4698 * flag. This has the side-effect of disabling Ctrl-C events in all
8cbe99e5
JD		 4699 * processes in this group.
4700 * We re-enable Ctrl-C handling by calling SetConsoleCtrlHandler()
4701 * with a NULL handler.
0a311364 4702 */
8cbe99e5 4703 SetConsoleCtrlHandler(NULL,FALSE);
0a311364 4704
3fadfdf1 4705 /* Push our handler on top */
c843839f
NIS		 4706 SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
4707 }
52853b95
GS		 4708}
4709
3dbbd0f5
GS		 4710void
4711Perl_sys_intern_clear(pTHX)
4712{
4713 Safefree(w32_perlshell_tokens);
4714 Safefree(w32_perlshell_vec);
4715 /* NOTE: w32_fdpid is freed by sv_clean_all() */
4716 Safefree(w32_children);
222c300a 4717 if (w32_timerid) {
aeecf691
JD		 4718 KillTimer(w32_message_hwnd, w32_timerid);
4719 w32_timerid = 0;
222c300a 4720 }
aeecf691
JD		 4721 if (w32_message_hwnd != NULL && w32_message_hwnd != INVALID_HANDLE_VALUE)
4722 DestroyWindow(w32_message_hwnd);
96116d93 4723# ifdef MULTIPLICITY
1018e26f 4724 if (my_perl == PL_curinterp) {
96116d93
MB		 4725# else
4726 {
4727# endif
c843839f 4728 SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
c843839f 4729 }
3dbbd0f5
GS		 4730# ifdef USE_ITHREADS
4731 Safefree(w32_pseudo_children);
4732# endif
4733}
4734
52853b95
GS		 4735# ifdef USE_ITHREADS
4736
4737void
7766f137
GS		 4738Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
4739{
7918f24d
NC		 4740 PERL_ARGS_ASSERT_SYS_INTERN_DUP;
4741
4e205ed6 4742 dst->perlshell_tokens = NULL;
7766f137
GS		 4743 dst->perlshell_vec = (char**)NULL;
4744 dst->perlshell_items = 0;
4745 dst->fdpid = newAV();
a02a5408 4746 Newxz(dst->children, 1, child_tab);
7766f137 4747 dst->pseudo_id = 0;
aeecf691
JD		 4748 Newxz(dst->pseudo_children, 1, pseudo_child_tab);
4749 dst->timerid = 0;
beeded0b 4750 dst->message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);
aeecf691 4751 dst->poll_count = 0;
8ca2a5d6 4752 dst->sloppystat = src->sloppystat;
3fadfdf1 4753 Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
7766f137 4754}
52853b95
GS		 4755# endif /* USE_ITHREADS */
4756#endif /* HAVE_INTERP_INTERN */
Unnamed repository; edit this file 'description' to name the repository.