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