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