This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32: implement symlink() and readlink()
[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
680b2c5e
TC
1700static BOOL
1701is_symlink_name(const char *name) {
1702 HANDLE f = CreateFileA(name, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1703 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1704 BOOL result;
1705
1706 if (f == INVALID_HANDLE_VALUE) {
1707 return FALSE;
1708 }
1709 result = is_symlink(f);
1710 CloseHandle(f);
1711
1712 return result;
1713}
1714
1715DllExport int
1716win32_readlink(const char *pathname, char *buf, size_t bufsiz) {
1717 MY_REPARSE_DATA_BUFFER linkdata;
1718 const MY_SYMLINK_REPARSE_BUFFER * const sd =
1719 &linkdata.Data.SymbolicLinkReparseBuffer;
1720 HANDLE hlink;
1721 DWORD fileattr = GetFileAttributes(pathname);
1722 DWORD linkdata_returned;
1723 int bytes_out;
1724 BOOL used_default;
1725
1726 if (fileattr == INVALID_FILE_ATTRIBUTES) {
1727 translate_to_errno();
1728 return -1;
1729 }
1730
1731 if (!(fileattr & FILE_ATTRIBUTE_REPARSE_POINT)) {
1732 /* not a symbolic link */
1733 errno = EINVAL;
1734 return -1;
1735 }
1736
1737 hlink =
1738 CreateFileA(pathname, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1739 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1740 if (hlink == INVALID_HANDLE_VALUE) {
1741 translate_to_errno();
1742 return -1;
1743 }
1744
1745 if (!DeviceIoControl(hlink, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) {
1746 translate_to_errno();
1747 CloseHandle(hlink);
1748 return -1;
1749 }
1750 CloseHandle(hlink);
1751
1752 if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer)
1753 || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) {
1754 errno = EINVAL;
1755 return -1;
1756 }
1757
1758 bytes_out = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
1759 sd->PathBuffer+sd->SubstituteNameOffset/2,
1760 sd->SubstituteNameLength/2,
1761 buf, bufsiz, NULL, &used_default);
1762 if (bytes_out == 0 || used_default) {
1763 /* failed conversion from unicode to ANSI or otherwise failed */
1764 errno = EINVAL;
1765 return -1;
1766 }
1767 if ((size_t)bytes_out > bufsiz) {
1768 errno = EINVAL;
1769 return -1;
1770 }
1771
1772 return bytes_out;
1773}
1774
92b3a3eb
TC
1775DllExport int
1776win32_lstat(const char *path, Stat_t *sbuf)
1777{
1778 HANDLE f;
1779 int fd;
1780 int result;
1781 DWORD attr = GetFileAttributes(path); /* doesn't follow symlinks */
1782
1783 if (attr == INVALID_FILE_ATTRIBUTES) {
1784 translate_to_errno();
1785 return -1;
1786 }
1787
1788 if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
1789 return win32_stat(path, sbuf);
1790 }
1791
1792 f = CreateFileA(path, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1793 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1794 if (f == INVALID_HANDLE_VALUE) {
1795 translate_to_errno();
1796 return -1;
1797 }
1798
1799 if (!is_symlink(f)) {
1800 CloseHandle(f);
1801 return win32_stat(path, sbuf);
1802 }
1803
1804 fd = win32_open_osfhandle((intptr_t)f, 0);
1805 result = win32_fstat(fd, sbuf);
1806 if (result != -1){
1807 sbuf->st_mode = (sbuf->st_mode & ~_S_IFMT) | _S_IFLNK;
1808 }
1809 close(fd);
1810 return result;
1811}
1812
bb27e7b6
JH
1813#define isSLASH(c) ((c) == '/' || (c) == '\\')
1814#define SKIP_SLASHES(s) \
1815 STMT_START { \
1816 while (*(s) && isSLASH(*(s))) \
1817 ++(s); \
1818 } STMT_END
1819#define COPY_NONSLASHES(d,s) \
1820 STMT_START { \
1821 while (*(s) && !isSLASH(*(s))) \
1822 *(d)++ = *(s)++; \
1823 } STMT_END
1824
8ac9c18d
GS
1825/* Find the longname of a given path. path is destructively modified.
1826 * It should have space for at least MAX_PATH characters. */
1827DllExport char *
1828win32_longpath(char *path)
1829{
1830 WIN32_FIND_DATA fdata;
1831 HANDLE fhand;
1832 char tmpbuf[MAX_PATH+1];
1833 char *tmpstart = tmpbuf;
1834 char *start = path;
1835 char sep;
1836 if (!path)
4e205ed6 1837 return NULL;
8ac9c18d
GS
1838
1839 /* drive prefix */
bb27e7b6 1840 if (isALPHA(path[0]) && path[1] == ':') {
8ac9c18d
GS
1841 start = path + 2;
1842 *tmpstart++ = path[0];
1843 *tmpstart++ = ':';
1844 }
1845 /* UNC prefix */
bb27e7b6 1846 else if (isSLASH(path[0]) && isSLASH(path[1])) {
8ac9c18d 1847 start = path + 2;
52fcf7ee
GS
1848 *tmpstart++ = path[0];
1849 *tmpstart++ = path[1];
bb27e7b6
JH
1850 SKIP_SLASHES(start);
1851 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
8ac9c18d 1852 if (*start) {
bb27e7b6
JH
1853 *tmpstart++ = *start++;
1854 SKIP_SLASHES(start);
1855 COPY_NONSLASHES(tmpstart,start); /* copy share name */
8ac9c18d
GS
1856 }
1857 }
8ac9c18d 1858 *tmpstart = '\0';
bb27e7b6
JH
1859 while (*start) {
1860 /* copy initial slash, if any */
1861 if (isSLASH(*start)) {
1862 *tmpstart++ = *start++;
1863 *tmpstart = '\0';
1864 SKIP_SLASHES(start);
1865 }
1866
1867 /* FindFirstFile() expands "." and "..", so we need to pass
1868 * those through unmolested */
1869 if (*start == '.'
1870 && (!start[1] || isSLASH(start[1])
1871 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1872 {
1873 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1874 *tmpstart = '\0';
1875 continue;
1876 }
1877
1878 /* if this is the end, bust outta here */
1879 if (!*start)
1880 break;
8ac9c18d 1881
bb27e7b6
JH
1882 /* now we're at a non-slash; walk up to next slash */
1883 while (*start && !isSLASH(*start))
8ac9c18d 1884 ++start;
8ac9c18d
GS
1885
1886 /* stop and find full name of component */
bb27e7b6 1887 sep = *start;
8ac9c18d
GS
1888 *start = '\0';
1889 fhand = FindFirstFile(path,&fdata);
bb27e7b6 1890 *start = sep;
8ac9c18d 1891 if (fhand != INVALID_HANDLE_VALUE) {
bb27e7b6
JH
1892 STRLEN len = strlen(fdata.cFileName);
1893 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1894 strcpy(tmpstart, fdata.cFileName);
1895 tmpstart += len;
1896 FindClose(fhand);
1897 }
1898 else {
1899 FindClose(fhand);
1900 errno = ERANGE;
4e205ed6 1901 return NULL;
bb27e7b6 1902 }
8ac9c18d
GS
1903 }
1904 else {
1905 /* failed a step, just return without side effects */
bb27e7b6 1906 errno = EINVAL;
4e205ed6 1907 return NULL;
8ac9c18d
GS
1908 }
1909 }
1910 strcpy(path,tmpbuf);
1911 return path;
1912}
1913
aa2b96ec 1914static void
0934c9d9 1915out_of_memory(void)
aa2b96ec 1916{
1565c085 1917
4cbe3a7d
DD
1918 if (PL_curinterp)
1919 croak_no_mem();
ae6198af 1920 exit(1);
aa2b96ec
JD
1921}
1922
073dd035
DD
1923void
1924win32_croak_not_implemented(const char * fname)
1925{
1926 PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
1927
1928 Perl_croak_nocontext("%s not implemented!\n", fname);
1929}
1930
00a0ae28
SH
1931/* Converts a wide character (UTF-16) string to the Windows ANSI code page,
1932 * potentially using the system's default replacement character for any
1933 * unrepresentable characters. The caller must free() the returned string. */
1934static char*
1935wstr_to_str(const wchar_t* wstr)
1936{
1937 BOOL used_default = FALSE;
1938 size_t wlen = wcslen(wstr) + 1;
1939 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1940 NULL, 0, NULL, NULL);
f76b679e 1941 char* str = (char*)malloc(len);
00a0ae28
SH
1942 if (!str)
1943 out_of_memory();
1944 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
1945 str, len, NULL, &used_default);
1946 return str;
1947}
1948
aa2b96ec
JD
1949/* The win32_ansipath() function takes a Unicode filename and converts it
1950 * into the current Windows codepage. If some characters cannot be mapped,
1951 * then it will convert the short name instead.
1952 *
1953 * The buffer to the ansi pathname must be freed with win32_free() when it
a3815e44 1954 * is no longer needed.
aa2b96ec
JD
1955 *
1956 * The argument to win32_ansipath() must exist before this function is
1957 * called; otherwise there is no way to determine the short path name.
1958 *
1959 * Ideas for future refinement:
1960 * - Only convert those segments of the path that are not in the current
1961 * codepage, but leave the other segments in their long form.
1962 * - If the resulting name is longer than MAX_PATH, start converting
1963 * additional path segments into short names until the full name
1964 * is shorter than MAX_PATH. Shorten the filename part last!
1965 */
1966DllExport char *
1967win32_ansipath(const WCHAR *widename)
1968{
1969 char *name;
1970 BOOL use_default = FALSE;
1971 size_t widelen = wcslen(widename)+1;
1972 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1973 NULL, 0, NULL, NULL);
f76b679e 1974 name = (char*)win32_malloc(len);
aa2b96ec
JD
1975 if (!name)
1976 out_of_memory();
1977
1978 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1979 name, len, NULL, &use_default);
1980 if (use_default) {
aa2b96ec 1981 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af 1982 if (shortlen) {
f76b679e 1983 WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
ae6198af
JD
1984 if (!shortname)
1985 out_of_memory();
1986 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1987
1988 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1989 NULL, 0, NULL, NULL);
f76b679e 1990 name = (char*)win32_realloc(name, len);
ae6198af
JD
1991 if (!name)
1992 out_of_memory();
1993 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1994 name, len, NULL, NULL);
1995 win32_free(shortname);
1996 }
aa2b96ec
JD
1997 }
1998 return name;
1999}
2000
2c8ca683
DD
2001/* the returned string must be freed with win32_freeenvironmentstrings which is
2002 * implemented as a macro
2003 * void win32_freeenvironmentstrings(void* block)
2004 */
0551aaa8 2005DllExport char *
4f46e52b
KR
2006win32_getenvironmentstrings(void)
2007{
2008 LPWSTR lpWStr, lpWTmp;
2009 LPSTR lpStr, lpTmp;
2010 DWORD env_len, wenvstrings_len = 0, aenvstrings_len = 0;
2011
2012 /* Get the process environment strings */
2013 lpWTmp = lpWStr = (LPWSTR) GetEnvironmentStringsW();
fa467b9b 2014 for (wenvstrings_len = 1; *lpWTmp != '\0'; lpWTmp += env_len + 1) {
4f46e52b
KR
2015 env_len = wcslen(lpWTmp);
2016 /* calculate the size of the environment strings */
2017 wenvstrings_len += env_len + 1;
2018 }
2019
fa467b9b 2020 /* Get the number of bytes required to store the ACP encoded string */
4f46e52b 2021 aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
fa467b9b 2022 lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
4f46e52b
KR
2023 lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
2024 if(!lpTmp)
2025 out_of_memory();
2026
2027 /* Convert the string from UTF-16 encoding to ACP encoding */
2028 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
fa467b9b 2029 aenvstrings_len, NULL, NULL);
4f46e52b 2030
a6abe943 2031 FreeEnvironmentStringsW(lpWStr);
90674eaa 2032
4f46e52b
KR
2033 return(lpStr);
2034}
2035
4f46e52b 2036DllExport char *
0551aaa8
GS
2037win32_getenv(const char *name)
2038{
acfe0abc 2039 dTHX;
0551aaa8 2040 DWORD needlen;
4e205ed6 2041 SV *curitem = NULL;
1fcb0052 2042 DWORD last_err;
58a50f62 2043
8c56068e 2044 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 2045 if (needlen != 0) {
c2b90b61 2046 curitem = sv_2mortal(newSVpvs(""));
8c56068e
JD
2047 do {
2048 SvGROW(curitem, needlen+1);
2049 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
2050 needlen);
2051 } while (needlen >= SvLEN(curitem));
2052 SvCUR_set(curitem, needlen);
0551aaa8 2053 }
c934e9d4 2054 else {
1fcb0052
PM
2055 last_err = GetLastError();
2056 if (last_err == ERROR_NOT_ENOUGH_MEMORY) {
2057 /* It appears the variable is in the env, but the Win32 API
2058 doesn't have a canned way of getting it. So we fall back to
2059 grabbing the whole env and pulling this value out if possible */
2060 char *envv = GetEnvironmentStrings();
2061 char *cur = envv;
2062 STRLEN len;
2063 while (*cur) {
2064 char *end = strchr(cur,'=');
2065 if (end && end != cur) {
2066 *end = '\0';
083b2a61 2067 if (strEQ(cur,name)) {
1fcb0052
PM
2068 curitem = sv_2mortal(newSVpv(end+1,0));
2069 *end = '=';
2070 break;
2071 }
2072 *end = '=';
2073 cur = end + strlen(end+1)+2;
2074 }
2075 else if ((len = strlen(cur)))
2076 cur += len+1;
2077 }
2078 FreeEnvironmentStrings(envv);
2079 }
6937817d 2080#ifndef WIN32_NO_REGISTRY
1fcb0052
PM
2081 else {
2082 /* last ditch: allow any environment variables that begin with 'PERL'
2083 to be obtained from the registry, if found there */
f55ac4a4 2084 if (strBEGINs(name, "PERL"))
1fcb0052
PM
2085 (void)get_regstr(name, &curitem);
2086 }
6937817d 2087#endif
c69f6586 2088 }
51371543
GS
2089 if (curitem && SvCUR(curitem))
2090 return SvPVX(curitem);
58a50f62 2091
4e205ed6 2092 return NULL;
0551aaa8
GS
2093}
2094
ac5c734f
GS
2095DllExport int
2096win32_putenv(const char *name)
2097{
2098 char* curitem;
2099 char* val;
b813a9c7 2100 int relval = -1;
51371543 2101
73c4f7a1 2102 if (name) {
9399a70c 2103 curitem = (char *) win32_malloc(strlen(name)+1);
8c56068e
JD
2104 strcpy(curitem, name);
2105 val = strchr(curitem, '=');
2106 if (val) {
2107 /* The sane way to deal with the environment.
2108 * Has these advantages over putenv() & co.:
2109 * * enables us to store a truly empty value in the
2110 * environment (like in UNIX).
8d0cd07e
SH
2111 * * we don't have to deal with RTL globals, bugs and leaks
2112 * (specifically, see http://support.microsoft.com/kb/235601).
8c56068e 2113 * * Much faster.
d0fc6d8d
SH
2114 * Why you may want to use the RTL environment handling
2115 * (previously enabled by USE_WIN32_RTL_ENV):
8c56068e
JD
2116 * * environ[] and RTL functions will not reflect changes,
2117 * which might be an issue if extensions want to access
2118 * the env. via RTL. This cuts both ways, since RTL will
2119 * not see changes made by extensions that call the Win32
2120 * functions directly, either.
2121 * GSAR 97-06-07
2122 */
2123 *val++ = '\0';
2124 if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
2125 relval = 0;
2126 }
9399a70c 2127 win32_free(curitem);
ac5c734f
GS
2128 }
2129 return relval;
2130}
2131
d55594ae 2132static long
2d7a9237 2133filetime_to_clock(PFILETIME ft)
d55594ae 2134{
7766f137
GS
2135 __int64 qw = ft->dwHighDateTime;
2136 qw <<= 32;
2137 qw |= ft->dwLowDateTime;
2138 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
2139 return (long) qw;
d55594ae
GS
2140}
2141
f3986ebb
GS
2142DllExport int
2143win32_times(struct tms *timebuf)
0a753a76 2144{
d55594ae
GS
2145 FILETIME user;
2146 FILETIME kernel;
2147 FILETIME dummy;
50ee8e5e 2148 clock_t process_time_so_far = clock();
3fadfdf1 2149 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
d55594ae 2150 &kernel,&user)) {
2d7a9237
GS
2151 timebuf->tms_utime = filetime_to_clock(&user);
2152 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS
2153 timebuf->tms_cutime = 0;
2154 timebuf->tms_cstime = 0;
3fadfdf1 2155 } else {
d55594ae 2156 /* That failed - e.g. Win95 fallback to clock() */
50ee8e5e 2157 timebuf->tms_utime = process_time_so_far;
d55594ae
GS
2158 timebuf->tms_stime = 0;
2159 timebuf->tms_cutime = 0;
2160 timebuf->tms_cstime = 0;
2161 }
50ee8e5e 2162 return process_time_so_far;
0a753a76
PP
2163}
2164
9c51cf4c 2165/* fix utime() so it works on directories in NT */
ad0751ec
GS
2166static BOOL
2167filetime_from_time(PFILETIME pFileTime, time_t Time)
2168{
9c51cf4c 2169 struct tm *pTM = localtime(&Time);
ad0751ec 2170 SYSTEMTIME SystemTime;
9c51cf4c 2171 FILETIME LocalTime;
ad0751ec
GS
2172
2173 if (pTM == NULL)
2174 return FALSE;
2175
2176 SystemTime.wYear = pTM->tm_year + 1900;
2177 SystemTime.wMonth = pTM->tm_mon + 1;
2178 SystemTime.wDay = pTM->tm_mday;
2179 SystemTime.wHour = pTM->tm_hour;
2180 SystemTime.wMinute = pTM->tm_min;
2181 SystemTime.wSecond = pTM->tm_sec;
2182 SystemTime.wMilliseconds = 0;
2183
9c51cf4c
GS
2184 return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
2185 LocalFileTimeToFileTime(&LocalTime, pFileTime);
ad0751ec
GS
2186}
2187
2188DllExport int
7766f137
GS
2189win32_unlink(const char *filename)
2190{
acfe0abc 2191 dTHX;
7766f137
GS
2192 int ret;
2193 DWORD attrs;
2194
8c56068e
JD
2195 filename = PerlDir_mapA(filename);
2196 attrs = GetFileAttributesA(filename);
2197 if (attrs == 0xFFFFFFFF) {
2198 errno = ENOENT;
2199 return -1;
7766f137 2200 }
8c56068e
JD
2201 if (attrs & FILE_ATTRIBUTE_READONLY) {
2202 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
2203 ret = unlink(filename);
2204 if (ret == -1)
2205 (void)SetFileAttributesA(filename, attrs);
7766f137 2206 }
680b2c5e
TC
2207 else if ((attrs & (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY))
2208 == (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY)
2209 && is_symlink_name(filename)) {
2210 ret = rmdir(filename);
2211 }
2212 else {
8c56068e 2213 ret = unlink(filename);
680b2c5e 2214 }
7766f137
GS
2215 return ret;
2216}
2217
2218DllExport int
3b405fc5 2219win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 2220{
acfe0abc 2221 dTHX;
ad0751ec
GS
2222 HANDLE handle;
2223 FILETIME ftCreate;
2224 FILETIME ftAccess;
2225 FILETIME ftWrite;
2226 struct utimbuf TimeBuffer;
7fac1903 2227 int rc;
8c56068e
JD
2228
2229 filename = PerlDir_mapA(filename);
2230 rc = utime(filename, times);
2231
ad0751ec 2232 /* EACCES: path specifies directory or readonly file */
8cbe99e5 2233 if (rc == 0 || errno != EACCES)
ad0751ec
GS
2234 return rc;
2235
2236 if (times == NULL) {
2237 times = &TimeBuffer;
2238 time(&times->actime);
2239 times->modtime = times->actime;
2240 }
2241
2242 /* This will (and should) still fail on readonly files */
8c56068e
JD
2243 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
2244 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
2245 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
ad0751ec
GS
2246 if (handle == INVALID_HANDLE_VALUE)
2247 return rc;
2248
2249 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
2250 filetime_from_time(&ftAccess, times->actime) &&
2251 filetime_from_time(&ftWrite, times->modtime) &&
2252 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
2253 {
2254 rc = 0;
2255 }
2256
2257 CloseHandle(handle);
2258 return rc;
2259}
2260
6e3b076d
JH
2261typedef union {
2262 unsigned __int64 ft_i64;
2263 FILETIME ft_val;
2264} FT_t;
2265
2266#ifdef __GNUC__
2267#define Const64(x) x##LL
2268#else
2269#define Const64(x) x##i64
2270#endif
2271/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
2272#define EPOCH_BIAS Const64(116444736000000000)
2273
57ab3dfe
GS
2274/* NOTE: This does not compute the timezone info (doing so can be expensive,
2275 * and appears to be unsupported even by glibc) */
2276DllExport int
2277win32_gettimeofday(struct timeval *tp, void *not_used)
2278{
6e3b076d
JH
2279 FT_t ft;
2280
2281 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
2282 GetSystemTimeAsFileTime(&ft.ft_val);
2283
2284 /* seconds since epoch */
2285 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
2286
2287 /* microseconds remaining */
2288 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
2289
2290 return 0;
57ab3dfe
GS
2291}
2292
2d7a9237 2293DllExport int
b2af26b1
GS
2294win32_uname(struct utsname *name)
2295{
2296 struct hostent *hep;
2297 STRLEN nodemax = sizeof(name->nodename)-1;
b2af26b1 2298
aeecf691
JD
2299 /* sysname */
2300 switch (g_osver.dwPlatformId) {
2301 case VER_PLATFORM_WIN32_WINDOWS:
2302 strcpy(name->sysname, "Windows");
2303 break;
2304 case VER_PLATFORM_WIN32_NT:
2305 strcpy(name->sysname, "Windows NT");
2306 break;
2307 case VER_PLATFORM_WIN32s:
2308 strcpy(name->sysname, "Win32s");
2309 break;
2310 default:
2311 strcpy(name->sysname, "Win32 Unknown");
2312 break;
b2af26b1 2313 }
aeecf691
JD
2314
2315 /* release */
2316 sprintf(name->release, "%d.%d",
2317 g_osver.dwMajorVersion, g_osver.dwMinorVersion);
2318
2319 /* version */
2320 sprintf(name->version, "Build %d",
2321 g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
2322 ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
2323 if (g_osver.szCSDVersion[0]) {
2324 char *buf = name->version + strlen(name->version);
2325 sprintf(buf, " (%s)", g_osver.szCSDVersion);
b2af26b1
GS
2326 }
2327
2328 /* nodename */
2329 hep = win32_gethostbyname("localhost");
2330 if (hep) {
2331 STRLEN len = strlen(hep->h_name);
2332 if (len <= nodemax) {
2333 strcpy(name->nodename, hep->h_name);
2334 }
2335 else {
2336 strncpy(name->nodename, hep->h_name, nodemax);
2337 name->nodename[nodemax] = '\0';
2338 }
2339 }
2340 else {
2341 DWORD sz = nodemax;
2342 if (!GetComputerName(name->nodename, &sz))
2343 *name->nodename = '\0';
2344 }
2345
2346 /* machine (architecture) */
2347 {
2348 SYSTEM_INFO info;
fe537c65 2349 DWORD procarch;
b2af26b1
GS
2350 char *arch;
2351 GetSystemInfo(&info);
a6c40364 2352
378eeda7 2353#if (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION) && !defined(__MINGW_EXTENSION))
fe537c65 2354 procarch = info.u.s.wProcessorArchitecture;
a6c40364 2355#else
fe537c65 2356 procarch = info.wProcessorArchitecture;
a6c40364 2357#endif
fe537c65 2358 switch (procarch) {
b2af26b1
GS
2359 case PROCESSOR_ARCHITECTURE_INTEL:
2360 arch = "x86"; break;
fe537c65
GS
2361 case PROCESSOR_ARCHITECTURE_IA64:
2362 arch = "ia64"; break;
fe537c65
GS
2363 case PROCESSOR_ARCHITECTURE_AMD64:
2364 arch = "amd64"; break;
fe537c65 2365 case PROCESSOR_ARCHITECTURE_UNKNOWN:
b2af26b1 2366 arch = "unknown"; break;
fe537c65
GS
2367 default:
2368 sprintf(name->machine, "unknown(0x%x)", procarch);
2369 arch = name->machine;
2370 break;
b2af26b1 2371 }
fe537c65
GS
2372 if (name->machine != arch)
2373 strcpy(name->machine, arch);
b2af26b1
GS
2374 }
2375 return 0;
2376}
2377
8fb3fcfb
NIS
2378/* Timing related stuff */
2379
3fadfdf1
NIS
2380int
2381do_raise(pTHX_ int sig)
2382{
2383 if (sig < SIG_SIZE) {
2384 Sighandler_t handler = w32_sighandler[sig];
2385 if (handler == SIG_IGN) {
2386 return 0;
2387 }
2388 else if (handler != SIG_DFL) {
2389 (*handler)(sig);
2390 return 0;
2391 }
2392 else {
2393 /* Choose correct default behaviour */
2394 switch (sig) {
2395#ifdef SIGCLD
2396 case SIGCLD:
2397#endif
2398#ifdef SIGCHLD
2399 case SIGCHLD:
2400#endif
2401 case 0:
2402 return 0;
2403 case SIGTERM:
2404 default:
2405 break;
2406 }
2407 }
2408 }
bb0f0a6a 2409 /* Tell caller to exit thread/process as appropriate */
3fadfdf1
NIS
2410 return 1;
2411}
2412
2413void
2414sig_terminate(pTHX_ int sig)
2415{
2416 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2417 /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2418 thread
2419 */
2420 exit(sig);
2421}
2422
8fb3fcfb
NIS
2423DllExport int
2424win32_async_check(pTHX)
2425{
2426 MSG msg;
aeecf691
JD
2427 HWND hwnd = w32_message_hwnd;
2428
099b16d3
RM
2429 /* Reset w32_poll_count before doing anything else, incase we dispatch
2430 * messages that end up calling back into perl */
aeecf691
JD
2431 w32_poll_count = 0;
2432
099b16d3
RM
2433 if (hwnd != INVALID_HANDLE_VALUE) {
2434 /* Passing PeekMessage -1 as HWND (2nd arg) only gets PostThreadMessage() messages
2435 * and ignores window messages - should co-exist better with windows apps e.g. Tk
2436 */
2437 if (hwnd == NULL)
2438 hwnd = (HWND)-1;
2439
2440 while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) ||
2441 PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2442 {
2443 /* re-post a WM_QUIT message (we'll mark it as read later) */
2444 if(msg.message == WM_QUIT) {
2445 PostQuitMessage((int)msg.wParam);
2446 break;
2447 }
8fb3fcfb 2448
099b16d3
RM
2449 if(!CallMsgFilter(&msg, MSGF_USER))
2450 {
2451 TranslateMessage(&msg);
2452 DispatchMessage(&msg);
aeecf691 2453 }
099b16d3 2454 }
8fb3fcfb
NIS
2455 }
2456
099b16d3
RM
2457 /* Call PeekMessage() to mark all pending messages in the queue as "old".
2458 * This is necessary when we are being called by win32_msgwait() to
2459 * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2460 * message over and over. An example how this can happen is when
2461 * Perl is calling win32_waitpid() inside a GUI application and the GUI
2462 * is generating messages before the process terminated.
2463 */
4386d69d 2464 PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
099b16d3 2465
7e5f34c0 2466 /* Above or other stuff may have set a signal flag */
099b16d3
RM
2467 if (PL_sig_pending)
2468 despatch_signals();
2469
aeecf691 2470 return 1;
8fb3fcfb
NIS
2471}
2472
089197fa
GS
2473/* This function will not return until the timeout has elapsed, or until
2474 * one of the handles is ready. */
8fb3fcfb
NIS
2475DllExport DWORD
2476win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2477{
2478 /* We may need several goes at this - so compute when we stop */
001e9f89
DD
2479 FT_t ticks = {0};
2480 unsigned __int64 endtime = timeout;
8fb3fcfb 2481 if (timeout != INFINITE) {
001e9f89
DD
2482 GetSystemTimeAsFileTime(&ticks.ft_val);
2483 ticks.ft_i64 /= 10000;
2484 endtime += ticks.ft_i64;
2485 }
2486 /* This was a race condition. Do not let a non INFINITE timeout to
2487 * MsgWaitForMultipleObjects roll under 0 creating a near
2488 * infinity/~(UINT32)0 timeout which will appear as a deadlock to the
2489 * user who did a CORE perl function with a non infinity timeout,
2490 * sleep for example. This is 64 to 32 truncation minefield.
2491 *
2492 * This scenario can only be created if the timespan from the return of
2493 * MsgWaitForMultipleObjects to GetSystemTimeAsFileTime exceeds 1 ms. To
2494 * generate the scenario, manual breakpoints in a C debugger are required,
bb0f0a6a 2495 * or a context switch occurred in win32_async_check in PeekMessage, or random
001e9f89
DD
2496 * messages are delivered to the *thread* message queue of the Perl thread
2497 * from another process (msctf.dll doing IPC among its instances, VS debugger
2498 * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096].
2499 */
81295a42 2500 while (ticks.ft_i64 <= endtime) {
9afd6203
SH
2501 /* if timeout's type is lengthened, remember to split 64b timeout
2502 * into multiple non-infinity runs of MWFMO */
2503 DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE,
2504 (DWORD)(endtime - ticks.ft_i64),
2505 QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
8fb3fcfb
NIS
2506 if (resultp)
2507 *resultp = result;
2508 if (result == WAIT_TIMEOUT) {
3fadfdf1
NIS
2509 /* Ran out of time - explicit return of zero to avoid -ve if we
2510 have scheduling issues
2511 */
8fb3fcfb
NIS
2512 return 0;
2513 }
2514 if (timeout != INFINITE) {
001e9f89
DD
2515 GetSystemTimeAsFileTime(&ticks.ft_val);
2516 ticks.ft_i64 /= 10000;
2517 }
8fb3fcfb
NIS
2518 if (result == WAIT_OBJECT_0 + count) {
2519 /* Message has arrived - check it */
089197fa 2520 (void)win32_async_check(aTHX);
81295a42
TK
2521
2522 /* retry */
2523 if (ticks.ft_i64 > endtime)
2524 endtime = ticks.ft_i64;
2525
2526 continue;
8fb3fcfb
NIS
2527 }
2528 else {
2529 /* Not timeout or message - one of handles is ready */
2530 break;
2531 }
2532 }
8fb3fcfb 2533 /* If we are past the end say zero */
9afd6203 2534 if (!ticks.ft_i64 || ticks.ft_i64 > endtime)
001e9f89
DD
2535 return 0;
2536 /* compute time left to wait */
2537 ticks.ft_i64 = endtime - ticks.ft_i64;
9afd6203
SH
2538 /* if more ms than DWORD, then return max DWORD */
2539 return ticks.ft_i64 <= UINT_MAX ? (DWORD)ticks.ft_i64 : UINT_MAX;
8fb3fcfb
NIS
2540}
2541
932b7487 2542int
04a2c3d9 2543win32_internal_wait(pTHX_ int *status, DWORD timeout)
932b7487
RC
2544{
2545 /* XXX this wait emulation only knows about processes
2546 * spawned via win32_spawnvp(P_NOWAIT, ...).
2547 */
932b7487
RC
2548 int i, retval;
2549 DWORD exitcode, waitcode;
2550
2551#ifdef USE_ITHREADS
2552 if (w32_num_pseudo_children) {
8fb3fcfb
NIS
2553 win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2554 timeout, &waitcode);
932b7487
RC
2555 /* Time out here if there are no other children to wait for. */
2556 if (waitcode == WAIT_TIMEOUT) {
2557 if (!w32_num_children) {
2558 return 0;
2559 }
2560 }
2561 else if (waitcode != WAIT_FAILED) {
2562 if (waitcode >= WAIT_ABANDONED_0
2563 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2564 i = waitcode - WAIT_ABANDONED_0;
2565 else
2566 i = waitcode - WAIT_OBJECT_0;
2567 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2568 *status = (int)((exitcode & 0xff) << 8);
2569 retval = (int)w32_pseudo_child_pids[i];
2570 remove_dead_pseudo_process(i);
2571 return -retval;
2572 }
2573 }
2574 }
2575#endif
2576
2577 if (!w32_num_children) {
2578 errno = ECHILD;
2579 return -1;
2580 }
2581
2582 /* if a child exists, wait for it to die */
8fb3fcfb 2583 win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
932b7487
RC
2584 if (waitcode == WAIT_TIMEOUT) {
2585 return 0;
2586 }
2587 if (waitcode != WAIT_FAILED) {
2588 if (waitcode >= WAIT_ABANDONED_0
2589 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2590 i = waitcode - WAIT_ABANDONED_0;
2591 else
2592 i = waitcode - WAIT_OBJECT_0;
2593 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2594 *status = (int)((exitcode & 0xff) << 8);
2595 retval = (int)w32_child_pids[i];
2596 remove_dead_process(i);
2597 return retval;
2598 }
2599 }
2600
932b7487
RC
2601 errno = GetLastError();
2602 return -1;
2603}
2604
b2af26b1 2605DllExport int
f55ee38a
GS
2606win32_waitpid(int pid, int *status, int flags)
2607{
acfe0abc 2608 dTHX;
922b1888 2609 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
0aaad0ff 2610 int retval = -1;
c66b022d 2611 long child;
7766f137 2612 if (pid == -1) /* XXX threadid == 1 ? */
04a2c3d9 2613 return win32_internal_wait(aTHX_ status, timeout);
7766f137
GS
2614#ifdef USE_ITHREADS
2615 else if (pid < 0) {
04a2c3d9 2616 child = find_pseudo_pid(aTHX_ -pid);
7766f137
GS
2617 if (child >= 0) {
2618 HANDLE hThread = w32_pseudo_child_handles[child];
8fb3fcfb
NIS
2619 DWORD waitcode;
2620 win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2f67576d
BC
2621 if (waitcode == WAIT_TIMEOUT) {
2622 return 0;
2623 }
8fb3fcfb 2624 else if (waitcode == WAIT_OBJECT_0) {
7766f137
GS
2625 if (GetExitCodeThread(hThread, &waitcode)) {
2626 *status = (int)((waitcode & 0xff) << 8);
2627 retval = (int)w32_pseudo_child_pids[child];
2628 remove_dead_pseudo_process(child);
68a29c53 2629 return -retval;
7766f137
GS
2630 }
2631 }
2632 else
2633 errno = ECHILD;
2634 }
2635 }
2636#endif
f55ee38a 2637 else {
922b1888
GS
2638 HANDLE hProcess;
2639 DWORD waitcode;
04a2c3d9 2640 child = find_pid(aTHX_ pid);
0aaad0ff 2641 if (child >= 0) {
922b1888 2642 hProcess = w32_child_handles[child];
8fb3fcfb 2643 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
a7867d0a
GS
2644 if (waitcode == WAIT_TIMEOUT) {
2645 return 0;
2646 }
8fb3fcfb 2647 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS
2648 if (GetExitCodeProcess(hProcess, &waitcode)) {
2649 *status = (int)((waitcode & 0xff) << 8);
2650 retval = (int)w32_child_pids[child];
2651 remove_dead_process(child);
2652 return retval;
2653 }
a7867d0a 2654 }
0aaad0ff
GS
2655 else
2656 errno = ECHILD;
2657 }
2658 else {
8cbe99e5 2659 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
922b1888 2660 if (hProcess) {
8fb3fcfb 2661 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
922b1888 2662 if (waitcode == WAIT_TIMEOUT) {
48db714f 2663 CloseHandle(hProcess);
922b1888
GS
2664 return 0;
2665 }
8fb3fcfb 2666 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS
2667 if (GetExitCodeProcess(hProcess, &waitcode)) {
2668 *status = (int)((waitcode & 0xff) << 8);
2669 CloseHandle(hProcess);
2670 return pid;
2671 }
2672 }
2673 CloseHandle(hProcess);
2674 }
2675 else
2676 errno = ECHILD;
0aaad0ff 2677 }
f55ee38a 2678 }
3fadfdf1 2679 return retval >= 0 ? pid : retval;
f55ee38a
GS
2680}
2681
2682DllExport int
2d7a9237
GS
2683win32_wait(int *status)
2684{
04a2c3d9
DD
2685 dTHX;
2686 return win32_internal_wait(aTHX_ status, INFINITE);
2d7a9237 2687}
d55594ae 2688
8fb3fcfb
NIS
2689DllExport unsigned int
2690win32_sleep(unsigned int t)
d55594ae 2691{
acfe0abc 2692 dTHX;
8fb3fcfb 2693 /* Win32 times are in ms so *1000 in and /1000 out */
3b9aea04
SH
2694 if (t > UINT_MAX / 1000) {
2695 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
2696 "sleep(%lu) too large", t);
2697 }
2698 return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000;
d55594ae
GS
2699}
2700
bbc9927b
TK
2701DllExport int
2702win32_pause(void)
2703{
2704 dTHX;
2705 win32_msgwait(aTHX_ 0, NULL, INFINITE, NULL);
2706 return -1;
2707}
2708
f3986ebb
GS
2709DllExport unsigned int
2710win32_alarm(unsigned int sec)
0a753a76 2711{
3fadfdf1 2712 /*
d55594ae 2713 * the 'obvious' implentation is SetTimer() with a callback
3fadfdf1
NIS
2714 * which does whatever receiving SIGALRM would do
2715 * we cannot use SIGALRM even via raise() as it is not
d55594ae 2716 * one of the supported codes in <signal.h>
3fadfdf1 2717 */
acfe0abc 2718 dTHX;
aeecf691
JD
2719
2720 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2721 w32_message_hwnd = win32_create_message_window();
2722
8fb3fcfb 2723 if (sec) {
aeecf691
JD
2724 if (w32_message_hwnd == NULL)
2725 w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2726 else {
2727 w32_timerid = 1;
2728 SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2729 }
8fb3fcfb
NIS
2730 }
2731 else {
2732 if (w32_timerid) {
aeecf691
JD
2733 KillTimer(w32_message_hwnd, w32_timerid);
2734 w32_timerid = 0;
8fb3fcfb 2735 }
3fadfdf1 2736 }
afe91769 2737 return 0;
0a753a76
PP
2738}
2739
2d77217b 2740extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
26618a56
GS
2741
2742DllExport char *
2743win32_crypt(const char *txt, const char *salt)
2744{
acfe0abc 2745 dTHX;
3352bfcb 2746 return des_fcrypt(txt, salt, w32_crypt_buffer);
26618a56 2747}
26618a56 2748
390b85e7
GS
2749/* simulate flock by locking a range on the file */
2750
390b85e7
GS
2751#define LK_LEN 0xffff0000
2752
f3986ebb
GS
2753DllExport int
2754win32_flock(int fd, int oper)
390b85e7
GS
2755{
2756 OVERLAPPED o;
2757 int i = -1;
2758 HANDLE fh;
2759
2760 fh = (HANDLE)_get_osfhandle(fd);
97b33cac
JD
2761 if (fh == (HANDLE)-1) /* _get_osfhandle() already sets errno to EBADF */
2762 return -1;
2763
390b85e7
GS
2764 memset(&o, 0, sizeof(o));
2765
2766 switch(oper) {
2767 case LOCK_SH: /* shared lock */
97b33cac
JD
2768 if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o))
2769 i = 0;
390b85e7
GS
2770 break;
2771 case LOCK_EX: /* exclusive lock */
97b33cac
JD
2772 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o))
2773 i = 0;
390b85e7
GS
2774 break;
2775 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
97b33cac
JD
2776 if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o))
2777 i = 0;
390b85e7
GS
2778 break;
2779 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
97b33cac
JD
2780 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2781 0, LK_LEN, 0, &o))
2782 i = 0;
390b85e7
GS
2783 break;
2784 case LOCK_UN: /* unlock lock */
97b33cac
JD
2785 if (UnlockFileEx(fh, 0, LK_LEN, 0, &o))
2786 i = 0;
390b85e7
GS
2787 break;
2788 default: /* unknown */
2789 errno = EINVAL;
97b33cac
JD
2790 return -1;
2791 }
2792 if (i == -1) {
2793 if (GetLastError() == ERROR_LOCK_VIOLATION)
b0ba2190 2794 errno = EWOULDBLOCK;
97b33cac
JD
2795 else
2796 errno = EINVAL;
390b85e7
GS
2797 }
2798 return i;
2799}
2800
390b85e7
GS
2801#undef LK_LEN
2802
cd6a3131
SH
2803extern int convert_wsa_error_to_errno(int wsaerr); /* in win32sck.c */
2804
c9beaf97
SH
2805/* Get the errno value corresponding to the given err. This function is not
2806 * intended to handle conversion of general GetLastError() codes. It only exists
2807 * to translate Windows sockets error codes from WSAGetLastError(). Such codes
2808 * used to be assigned to errno/$! in earlier versions of perl; this function is
2809 * used to catch any old Perl code which is still trying to assign such values
2810 * to $! and convert them to errno values instead.
2811 */
2812int
2813win32_get_errno(int err)
2814{
2815 return convert_wsa_error_to_errno(err);
2816}
2817
68dc0745
PP
2818/*
2819 * redirected io subsystem for all XS modules
2820 *
2821 */
0a753a76 2822
68dc0745
PP
2823DllExport int *
2824win32_errno(void)
0a753a76 2825{
390b85e7 2826 return (&errno);
0a753a76
PP
2827}
2828
dcb2879a
GS
2829DllExport char ***
2830win32_environ(void)
2831{
390b85e7 2832 return (&(_environ));
dcb2879a
GS
2833}
2834
68dc0745
PP
2835/* the rest are the remapped stdio routines */
2836DllExport FILE *
2837win32_stderr(void)
0a753a76 2838{
390b85e7 2839 return (stderr);
0a753a76
PP
2840}
2841
68dc0745
PP
2842DllExport FILE *
2843win32_stdin(void)
0a753a76 2844{
390b85e7 2845 return (stdin);
0a753a76
PP
2846}
2847
68dc0745 2848DllExport FILE *
0934c9d9 2849win32_stdout(void)
0a753a76 2850{
390b85e7 2851 return (stdout);
0a753a76
PP
2852}
2853
68dc0745
PP
2854DllExport int
2855win32_ferror(FILE *fp)
0a753a76 2856{
390b85e7 2857 return (ferror(fp));
0a753a76
PP
2858}
2859
2860
68dc0745
PP
2861DllExport int
2862win32_feof(FILE *fp)
0a753a76 2863{
390b85e7 2864 return (feof(fp));
0a753a76
PP
2865}
2866
e85fa3eb 2867#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
cd6a3131 2868extern int convert_errno_to_wsa_error(int err); /* in win32sck.c */
e85fa3eb 2869#endif
cd6a3131 2870
68dc0745 2871/*
3fadfdf1 2872 * Since the errors returned by the socket error function
68dc0745 2873 * WSAGetLastError() are not known by the library routine strerror
cd6a3131
SH
2874 * we have to roll our own to cover the case of socket errors
2875 * that could not be converted to regular errno values by
2876 * get_last_socket_error() in win32/win32sck.c.
68dc0745 2877 */
0a753a76 2878
68dc0745 2879DllExport char *
3fadfdf1 2880win32_strerror(int e)
0a753a76 2881{
378eeda7 2882#if !defined __MINGW32__ /* compiler intolerance */
68dc0745 2883 extern int sys_nerr;
3e3baf6d 2884#endif
0a753a76 2885
9404a519 2886 if (e < 0 || e > sys_nerr) {
9399a70c 2887 dTHXa(NULL);
9404a519 2888 if (e < 0)
68dc0745 2889 e = GetLastError();
e85fa3eb 2890#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
4f79e9b1
SH
2891 /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno
2892 * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but
2893 * sys_nerr is still 43 and strerror() returns "Unknown error" for them.
2894 * We must therefore still roll our own messages for these codes, and
2895 * additionally map them to corresponding Windows (sockets) error codes
2896 * first to avoid getting the wrong system message.
cd6a3131 2897 */
e7e45461 2898 else if (inRANGE(e, EADDRINUSE, EWOULDBLOCK)) {
cd6a3131
SH
2899 e = convert_errno_to_wsa_error(e);
2900 }
2901#endif
0a753a76 2902
9399a70c 2903 aTHXa(PERL_GET_THX);
364d54ba
JD
2904 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
2905 |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
2906 w32_strerror_buffer, sizeof(w32_strerror_buffer),
2907 NULL) == 0)
2908 {
3352bfcb 2909 strcpy(w32_strerror_buffer, "Unknown Error");
364d54ba 2910 }
3352bfcb 2911 return w32_strerror_buffer;
68dc0745 2912 }
364d54ba 2913#undef strerror
390b85e7 2914 return strerror(e);
364d54ba 2915#define strerror win32_strerror
0a753a76
PP
2916}
2917
22fae026 2918DllExport void
c5be433b 2919win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM
2920{
2921 DWORD dwLen;
2922 char *sMsg;
2923 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
2924 |FORMAT_MESSAGE_IGNORE_INSERTS
2925 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2926 dwErr, 0, (char *)&sMsg, 1, NULL);
2ce77adf 2927 /* strip trailing whitespace and period */
22fae026 2928 if (0 < dwLen) {
2ce77adf
GS
2929 do {
2930 --dwLen; /* dwLen doesn't include trailing null */
2931 } while (0 < dwLen && isSPACE(sMsg[dwLen]));
22fae026
TM
2932 if ('.' != sMsg[dwLen])
2933 dwLen++;
2ce77adf 2934 sMsg[dwLen] = '\0';
22fae026
TM
2935 }
2936 if (0 == dwLen) {
c69f6586 2937 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
db7c17d7
GS
2938 if (sMsg)
2939 dwLen = sprintf(sMsg,
2940 "Unknown error #0x%lX (lookup 0x%lX)",
2941 dwErr, GetLastError());
2942 }
2943 if (sMsg) {
acfe0abc 2944 dTHX;
db7c17d7
GS
2945 sv_setpvn((SV*)sv, sMsg, dwLen);
2946 LocalFree(sMsg);
22fae026 2947 }
22fae026
TM
2948}
2949
68dc0745
PP
2950DllExport int
2951win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 2952{
68dc0745
PP
2953 va_list marker;
2954 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2955
390b85e7 2956 return (vfprintf(fp, format, marker));
0a753a76
PP
2957}
2958
68dc0745
PP
2959DllExport int
2960win32_printf(const char *format, ...)
0a753a76 2961{
68dc0745
PP
2962 va_list marker;
2963 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2964
390b85e7 2965 return (vprintf(format, marker));
0a753a76
PP
2966}
2967
68dc0745
PP
2968DllExport int
2969win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 2970{
390b85e7 2971 return (vfprintf(fp, format, args));
0a753a76
PP
2972}
2973
96e4d5b1
PP
2974DllExport int
2975win32_vprintf(const char *format, va_list args)
2976{
390b85e7 2977 return (vprintf(format, args));
96e4d5b1
PP
2978}
2979
68dc0745
PP
2980DllExport size_t
2981win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2982{
390b85e7 2983 return fread(buf, size, count, fp);
0a753a76
PP
2984}
2985
68dc0745
PP
2986DllExport size_t
2987win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2988{
390b85e7 2989 return fwrite(buf, size, count, fp);
0a753a76
PP
2990}
2991
7fac1903
GS
2992#define MODE_SIZE 10
2993
68dc0745
PP
2994DllExport FILE *
2995win32_fopen(const char *filename, const char *mode)
0a753a76 2996{
04a2c3d9 2997 dTHXa(NULL);
1c5905c2 2998 FILE *f;
3fadfdf1 2999
c5be433b
GS
3000 if (!*filename)
3001 return NULL;
3002
68dc0745 3003 if (stricmp(filename, "/dev/null")==0)
7fac1903
GS
3004 filename = "NUL";
3005
04a2c3d9 3006 aTHXa(PERL_GET_THX);
8c56068e 3007 f = fopen(PerlDir_mapA(filename), mode);
1c5905c2
GS
3008 /* avoid buffering headaches for child processes */
3009 if (f && *mode == 'a')
3010 win32_fseek(f, 0, SEEK_END);
3011 return f;
0a753a76
PP
3012}
3013
68dc0745 3014DllExport FILE *
7fac1903 3015win32_fdopen(int handle, const char *mode)
0a753a76 3016{
1c5905c2 3017 FILE *f;
8c56068e 3018 f = fdopen(handle, (char *) mode);
1c5905c2
GS
3019 /* avoid buffering headaches for child processes */
3020 if (f && *mode == 'a')
3021 win32_fseek(f, 0, SEEK_END);
3022 return f;
0a753a76
PP
3023}
3024
68dc0745 3025DllExport FILE *
7fac1903 3026win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 3027{
04a2c3d9 3028 dTHXa(NULL);
68dc0745 3029 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
3030 path = "NUL";
3031
04a2c3d9 3032 aTHXa(PERL_GET_THX);
7766f137 3033 return freopen(PerlDir_mapA(path), mode, stream);
0a753a76
PP
3034}
3035
68dc0745
PP
3036DllExport int
3037win32_fclose(FILE *pf)
0a753a76 3038{
19253ae6
DD
3039#ifdef WIN32_NO_SOCKETS
3040 return fclose(pf);
3041#else
f3986ebb 3042 return my_fclose(pf); /* defined in win32sck.c */
19253ae6 3043#endif
0a753a76
PP
3044}
3045
68dc0745
PP
3046DllExport int
3047win32_fputs(const char *s,FILE *pf)
0a753a76 3048{
390b85e7 3049 return fputs(s, pf);
0a753a76
PP
3050}
3051
68dc0745
PP
3052DllExport int
3053win32_fputc(int c,FILE *pf)
0a753a76 3054{
390b85e7 3055 return fputc(c,pf);
0a753a76
PP
3056}
3057
68dc0745
PP
3058DllExport int
3059win32_ungetc(int c,FILE *pf)
0a753a76 3060{
390b85e7 3061 return ungetc(c,pf);
0a753a76
PP
3062}
3063
68dc0745
PP
3064DllExport int
3065win32_getc(FILE *pf)
0a753a76 3066{
390b85e7 3067 return getc(pf);
0a753a76
PP
3068}
3069
68dc0745
PP
3070DllExport int
3071win32_fileno(FILE *pf)
0a753a76 3072{
390b85e7 3073 return fileno(pf);
0a753a76
PP
3074}
3075
68dc0745
PP
3076DllExport void
3077win32_clearerr(FILE *pf)
0a753a76 3078{
390b85e7 3079 clearerr(pf);
68dc0745 3080 return;
0a753a76
PP
3081}
3082
68dc0745
PP
3083DllExport int
3084win32_fflush(FILE *pf)
0a753a76 3085{
390b85e7 3086 return fflush(pf);
0a753a76
PP
3087}
3088
c623ac67 3089DllExport Off_t
68dc0745 3090win32_ftell(FILE *pf)
0a753a76 3091{
c623ac67
GS
3092 fpos_t pos;
3093 if (fgetpos(pf, &pos))
3094 return -1;
3095 return (Off_t)pos;
0a753a76
PP
3096}
3097
68dc0745 3098DllExport int
c623ac67 3099win32_fseek(FILE *pf, Off_t offset,int origin)
0a753a76 3100{
c623ac67
GS
3101 fpos_t pos;
3102 switch (origin) {
3103 case SEEK_CUR:
3104 if (fgetpos(pf, &pos))
3105 return -1;
3106 offset += pos;
3107 break;
3108 case SEEK_END:
3109 fseek(pf, 0, SEEK_END);
3110 pos = _telli64(fileno(pf));
3111 offset += pos;
3112 break;
3113 case SEEK_SET:
3114 break;
3115 default:
3116 errno = EINVAL;
3117 return -1;
3118 }
3119 return fsetpos(pf, &offset);
0a753a76
PP
3120}
3121
68dc0745
PP
3122DllExport int
3123win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 3124{
390b85e7 3125 return fgetpos(pf, p);
0a753a76
PP
3126}
3127
68dc0745
PP
3128DllExport int
3129win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 3130{
390b85e7 3131 return fsetpos(pf, p);
0a753a76
PP
3132}
3133
68dc0745
PP
3134DllExport void
3135win32_rewind(FILE *pf)
0a753a76 3136{
390b85e7 3137 rewind(pf);
68dc0745 3138 return;
0a753a76
PP
3139}
3140
2941a2e1
JH
3141DllExport int
3142win32_tmpfd(void)
0a753a76 3143{
04247234
TC
3144 return win32_tmpfd_mode(0);
3145}
3146
3147DllExport int
3148win32_tmpfd_mode(int mode)
3149{
b3122bc4
JH
3150 char prefix[MAX_PATH+1];
3151 char filename[MAX_PATH+1];
3152 DWORD len = GetTempPath(MAX_PATH, prefix);
04247234
TC
3153 mode &= ~( O_ACCMODE | O_CREAT | O_EXCL );
3154 mode |= O_RDWR;
b3122bc4
JH
3155 if (len && len < MAX_PATH) {
3156 if (GetTempFileName(prefix, "plx", 0, filename)) {
3157 HANDLE fh = CreateFile(filename,
3158 DELETE | GENERIC_READ | GENERIC_WRITE,
3159 0,
3160 NULL,
3161 CREATE_ALWAYS,
3162 FILE_ATTRIBUTE_NORMAL
3163 | FILE_FLAG_DELETE_ON_CLOSE,
3164 NULL);
3165 if (fh != INVALID_HANDLE_VALUE) {
04247234 3166 int fd = win32_open_osfhandle((intptr_t)fh, mode);
b3122bc4 3167 if (fd >= 0) {
2b01189b 3168 PERL_DEB(dTHX;)
b3122bc4
JH
3169 DEBUG_p(PerlIO_printf(Perl_debug_log,
3170 "Created tmpfile=%s\n",filename));
2941a2e1 3171 return fd;
b3122bc4
JH
3172 }
3173 }
3174 }
3175 }
2941a2e1
JH
3176 return -1;
3177}
3178
3179DllExport FILE*
3180win32_tmpfile(void)
3181{
3182 int fd = win32_tmpfd();
3183 if (fd >= 0)
3184 return win32_fdopen(fd, "w+b");
b3122bc4 3185 return NULL;
0a753a76
PP
3186}
3187
68dc0745
PP
3188DllExport void
3189win32_abort(void)
0a753a76 3190{
390b85e7 3191 abort();
68dc0745 3192 return;
0a753a76
PP
3193}
3194
68dc0745 3195DllExport int
c623ac67 3196win32_fstat(int fd, Stat_t *sbufptr)
0a753a76 3197{
92b3a3eb
TC
3198 int result;
3199 struct _stati64 st;
3200 dTHX;
3201 result = _fstati64(fd, &st);
3202 if (result == 0) {
3203 sbufptr->st_mode = st.st_mode;
3204 sbufptr->st_uid = st.st_uid;
3205 sbufptr->st_gid = st.st_gid;
3206 sbufptr->st_rdev = st.st_rdev;
3207 sbufptr->st_size = st.st_size;
3208 sbufptr->st_atime = st.st_atime;
3209 sbufptr->st_mtime = st.st_mtime;
3210 sbufptr->st_ctime = st.st_ctime;
3211
3212 if (w32_sloppystat) {
3213 sbufptr->st_nlink = st.st_nlink;
3214 sbufptr->st_dev = st.st_dev;
3215 sbufptr->st_ino = st.st_ino;
3216 }
3217 else {
3218 HANDLE handle = (HANDLE)win32_get_osfhandle(fd);
3219 BY_HANDLE_FILE_INFORMATION bhi;
3220 if (GetFileInformationByHandle(handle, &bhi)) {
3221 sbufptr->st_nlink = bhi.nNumberOfLinks;
3222 sbufptr->st_ino = bhi.nFileIndexHigh;
3223 sbufptr->st_ino <<= 32;
3224 sbufptr->st_ino |= bhi.nFileIndexLow;
3225 sbufptr->st_dev = bhi.dwVolumeSerialNumber;
3226 }
3227 }
3228 }
3229
3230 return result;
0a753a76
PP
3231}
3232
68dc0745
PP
3233DllExport int
3234win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 3235{
390b85e7 3236 return _pipe(pfd, size, mode);
0a753a76
PP
3237}
3238
8c0134a8
NIS
3239DllExport PerlIO*
3240win32_popenlist(const char *mode, IV narg, SV **args)
3241{
aac983ac 3242 get_shell();
8c0134a8 3243
aac983ac
TC
3244 return do_popen(mode, NULL, narg, args);
3245}
50892819 3246
aac983ac
TC
3247STATIC PerlIO*
3248do_popen(const char *mode, const char *command, IV narg, SV **args) {
50892819 3249 int p[2];
f06c8825 3250 int handles[3];
50892819 3251 int parent, child;
c161da64 3252 int stdfd;
50892819
GS
3253 int ourmode;
3254 int childpid;
1095be37 3255 DWORD nhandle;
1095be37 3256 int lock_held = 0;
aac983ac 3257 const char **args_pvs = NULL;
50892819
GS
3258
3259 /* establish which ends read and write */
3260 if (strchr(mode,'w')) {
3261 stdfd = 0; /* stdin */
3262 parent = 1;
3263 child = 0;
1095be37 3264 nhandle = STD_INPUT_HANDLE;
50892819
GS
3265 }
3266 else if (strchr(mode,'r')) {
3267 stdfd = 1; /* stdout */
3268 parent = 0;
3269 child = 1;
1095be37 3270 nhandle = STD_OUTPUT_HANDLE;
50892819
GS
3271 }
3272 else
3273 return NULL;
3274
3275 /* set the correct mode */
3276 if (strchr(mode,'b'))
3277 ourmode = O_BINARY;
3278 else if (strchr(mode,'t'))
3279 ourmode = O_TEXT;
3280 else
3281 ourmode = _fmode & (O_TEXT | O_BINARY);
3282
3283 /* the child doesn't inherit handles */
3284 ourmode |= O_NOINHERIT;
3285
1095be37 3286 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS
3287 return NULL;
3288
f06c8825
TC
3289 /* Previously this code redirected stdin/out temporarily so the
3290 child process inherited those handles, this caused race
3291 conditions when another thread was writing/reading those
3292 handles.
498d7dc4 3293
f06c8825
TC
3294 To avoid that we just feed the handles to CreateProcess() so
3295 the handles are redirected only in the child.
3296 */
3297 handles[child] = p[child];
3298 handles[parent] = -1;
3299 handles[2] = -1;
564914cd 3300
f06c8825 3301 /* CreateProcess() requires inheritable handles */
c161da64 3302 if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT,
f06c8825 3303 HANDLE_FLAG_INHERIT)) {
50892819 3304 goto cleanup;
f06c8825 3305 }
1095be37 3306
50892819 3307 /* start the child */
4f63d024 3308 {
acfe0abc 3309 dTHX;
50892819 3310
aac983ac
TC
3311 if (command) {
3312 if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
3313 goto cleanup;
3314
3315 }
3316 else {
3317 int i;
f5fe1b19 3318 const char *exe_name;
aac983ac
TC
3319
3320 Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
3321 SAVEFREEPV(args_pvs);
3322 for (i = 0; i < narg; ++i)
3323 args_pvs[i] = SvPV_nolen(args[i]);
3324 args_pvs[i] = NULL;
f5fe1b19
TC
3325 exe_name = qualified_path(args_pvs[0], TRUE);
3326 if (!exe_name)
3327 /* let CreateProcess() try to find it instead */
3328 exe_name = args_pvs[0];
aac983ac 3329
f5fe1b19
TC
3330 if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) {
3331 goto cleanup;
aac983ac
TC
3332 }
3333 }
498d7dc4 3334
f06c8825 3335 win32_close(p[child]);
1095be37 3336
4f63d024 3337 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1
R
3338
3339 /* set process id so that it can be returned by perl's open() */
3340 PL_forkprocess = childpid;
4f63d024 3341 }
50892819
GS
3342
3343 /* we have an fd, return a file stream */
00b02797 3344 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS
3345
3346cleanup:
3347 /* we don't need to check for errors here */
3348 win32_close(p[0]);
3349 win32_close(p[1]);
f06c8825 3350
50892819 3351 return (NULL);
aac983ac
TC
3352}
3353
3354/*
3355 * a popen() clone that respects PERL5SHELL
3356 *
3357 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
3358 */
50892819 3359
aac983ac
TC
3360DllExport PerlIO*
3361win32_popen(const char *command, const char *mode)
3362{
3363#ifdef USE_RTL_POPEN
3364 return _popen(command, mode);
3365#else
3366 return do_popen(mode, command, 0, NULL);
4b556e6c 3367#endif /* USE_RTL_POPEN */
0a753a76
PP
3368}
3369
50892819
GS
3370/*
3371 * pclose() clone
3372 */
3373
68dc0745 3374DllExport int
00b02797 3375win32_pclose(PerlIO *pf)
0a753a76 3376{
4b556e6c 3377#ifdef USE_RTL_POPEN
390b85e7 3378 return _pclose(pf);
50892819 3379#else
acfe0abc 3380 dTHX;
e17cb2a9
JD
3381 int childpid, status;
3382 SV *sv;
3383
00b02797 3384 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3385
e17cb2a9
JD
3386 if (SvIOK(sv))
3387 childpid = SvIVX(sv);
3388 else
3389 childpid = 0;
50892819
GS
3390
3391 if (!childpid) {
3392 errno = EBADF;
3393 return -1;
3394 }
3395
00b02797
JH
3396#ifdef USE_PERLIO
3397 PerlIO_close(pf);
3398#else
3399 fclose(pf);
3400#endif
e17cb2a9
JD
3401 SvIVX(sv) = 0;
3402
0aaad0ff
GS
3403 if (win32_waitpid(childpid, &status, 0) == -1)
3404 return -1;
50892819 3405
0aaad0ff 3406 return status;
50892819 3407
4b556e6c 3408#endif /* USE_RTL_POPEN */
0a753a76 3409}
6b980173 3410
6b980173
JD
3411DllExport int
3412win32_link(const char *oldname, const char *newname)
3413{
04a2c3d9 3414 dTHXa(NULL);
82867ecf
GS
3415 WCHAR wOldName[MAX_PATH+1];
3416 WCHAR wNewName[MAX_PATH+1];
6b980173 3417
8c56068e
JD
3418 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3419 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
04a2c3d9 3420 ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
8cbe99e5 3421 CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173
JD
3422 {
3423 return 0;
3424 }
680b2c5e
TC
3425 translate_to_errno();
3426 return -1;
3427}
2b42d7ed 3428
680b2c5e
TC
3429#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
3430# define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2
3431#endif
3432
3433DllExport int
3434win32_symlink(const char *oldfile, const char *newfile)
3435{
3436 dTHX;
3437 const char *dest_path = oldfile;
3438 char szTargetName[MAX_PATH+1];
3439 size_t oldfile_len = strlen(oldfile);
3440 DWORD dest_attr;
3441 DWORD create_flags = SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE;
3442
3443 /* oldfile might be relative and we don't want to change that,
3444 so don't map that.
2b42d7ed 3445 */
680b2c5e
TC
3446 newfile = PerlDir_mapA(newfile);
3447
3448 /* are we linking to a directory?
3449 CreateSymlinkA() needs to know if the target is a directory,
3450 if the oldfile is relative we need to make a relative path
3451 based on the newfile
3452 */
3453 if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') {
3454 /* relative to current directory on a drive */
3455 /* dest_path = oldfile; already done */
3456 }
3457 else if (oldfile[0] != '\\' && oldfile[0] != '/') {
3458 size_t newfile_len = strlen(newfile);
3459 char *last_slash = strrchr(newfile, '/');
3460 char *last_bslash = strrchr(newfile, '\\');
3461 char *end_dir = last_slash && last_bslash
3462 ? ( last_slash > last_bslash ? last_slash : last_bslash)
3463 : last_slash ? last_slash : last_bslash ? last_bslash : NULL;
3464
3465 if (end_dir) {
3466 if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) {
3467 /* too long */
3468 errno = EINVAL;
3469 return -1;
3470 }
3471
3472 memcpy(szTargetName, newfile, end_dir - newfile + 1);
3473 strcpy(szTargetName + (end_dir - newfile + 1), oldfile);
3474 dest_path = szTargetName;
3475 }
3476 else {
3477 /* newpath is just a filename */
3478 /* dest_path = oldfile; */
3479 }
2b42d7ed 3480 }
680b2c5e
TC
3481
3482 dest_attr = GetFileAttributes(dest_path);
3483 if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) {
3484 create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY;
3485 }
3486
3487 if (!CreateSymbolicLinkA(newfile, oldfile, create_flags)) {
3488 translate_to_errno();
3489 return -1;
3490 }
3491
3492 return 0;
6b980173 3493}
0a753a76 3494
68dc0745 3495DllExport int
8d9b2e3c 3496win32_rename(const char *oname, const char *newname)
e24c7c18 3497{
65cb15a1 3498 char szOldName[MAX_PATH+1];
7fac1903 3499 BOOL bResult;
8cbe99e5 3500 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
acfe0abc 3501 dTHX;
65cb15a1 3502
8cbe99e5
JD
3503 if (stricmp(newname, oname))
3504 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3505 strcpy(szOldName, PerlDir_mapA(oname));
3506
3507 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3508 if (!bResult) {
3509 DWORD err = GetLastError();
3510 switch (err) {
3511 case ERROR_BAD_NET_NAME:
3512 case ERROR_BAD_NETPATH:
3513 case ERROR_BAD_PATHNAME:
3514 case ERROR_FILE_NOT_FOUND:
3515 case ERROR_FILENAME_EXCED_RANGE:
3516 case ERROR_INVALID_DRIVE:
3517 case ERROR_NO_MORE_FILES:
3518 case ERROR_PATH_NOT_FOUND:
3519 errno = ENOENT;
3520 break;
e41416c3
CM
3521 case ERROR_DISK_FULL:
3522 errno = ENOSPC;
3523 break;
3524 case ERROR_NOT_ENOUGH_QUOTA:
3525 errno = EDQUOT;
3526 break;
8cbe99e5
JD
3527 default:
3528 errno = EACCES;
3529 break;
3530 }
3531 return -1;
e24c7c18 3532 }
8cbe99e5 3533 return 0;
e24c7c18
GS
3534}
3535
3536DllExport int
68dc0745 3537win32_setmode(int fd, int mode)
0a753a76 3538{
390b85e7 3539 return setmode(fd, mode);
0a753a76
PP
3540}
3541
4a9d6100
GS
3542DllExport int
3543win32_chsize(int fd, Off_t size)
3544{
4a9d6100
GS
3545 int retval = 0;
3546 Off_t cur, end, extend;
3547
3548 cur = win32_tell(fd);
3549 if (cur < 0)
3550 return -1;
3551 end = win32_lseek(fd, 0, SEEK_END);
3552 if (end < 0)
3553 return -1;
3554 extend = size - end;
3555 if (extend == 0) {
3556 /* do nothing */
3557 }
3558 else if (extend > 0) {
3559 /* must grow the file, padding with nulls */
3560 char b[4096];
3561 int oldmode = win32_setmode(fd, O_BINARY);
3562 size_t count;
3563 memset(b, '\0', sizeof(b));
3564 do {
3565 count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3566 count = win32_write(fd, b, count);
21424390 3567 if ((int)count < 0) {
4a9d6100
GS
3568 retval = -1;
3569 break;
3570 }
3571 } while ((extend -= count) > 0);
3572 win32_setmode(fd, oldmode);
3573 }
3574 else {
3575 /* shrink the file */
3576 win32_lseek(fd, size, SEEK_SET);
3577 if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3578 errno = EACCES;
3579 retval = -1;
3580 }
3581 }
4a9d6100
GS
3582 win32_lseek(fd, cur, SEEK_SET);
3583 return retval;
4a9d6100
GS
3584}
3585
c623ac67
GS
3586DllExport Off_t
3587win32_lseek(int fd, Off_t offset, int origin)
96e4d5b1 3588{
c623ac67 3589 return _lseeki64(fd, offset, origin);
96e4d5b1
PP
3590}
3591
c623ac67 3592DllExport Off_t
96e4d5b1
PP
3593win32_tell(int fd)
3594{
c623ac67 3595 return _telli64(fd);
96e4d5b1
PP
3596}
3597
68dc0745
PP
3598DllExport int
3599win32_open(const char *path, int flag, ...)
0a753a76 3600{
04a2c3d9 3601 dTHXa(NULL);
68dc0745
PP
3602 va_list ap;
3603 int pmode;
0a753a76
PP
3604
3605 va_start(ap, flag);
3606 pmode = va_arg(ap, int);
3607 va_end(ap);