This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bump Data::Dumper version
[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 112static void my_invalid_parameter_handler(const wchar_t* expression,
1604cfb0
MS		 113 const wchar_t* function, const wchar_t* file,
114 unsigned int line, uintptr_t pReserved);
e2cd629f
SH		 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 122static char* get_emd_part(SV **prev_pathp, STRLEN *const len,
1604cfb0 123 char *trailing, ...);
6937817d 124static char* win32_get_xlib(const char *pl,
1604cfb0
MS		 125 WIN32_NO_REGISTRY_M_(const char *xlib)
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 137static PerlIO * do_popen(const char *mode, const char *command, IV narg,
1604cfb0 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,
1604cfb0 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,
1604cfb0 153 WPARAM wParam, LPARAM lParam);
e2cd629f
SH		 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 223 if (silent_invalid_parameter_handler)
1604cfb0 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) {
1604cfb0
MS		 280 if (*ptr == '\\')
281 *ptr = '/';
282 ++ptr;
2fa86c13
GS		 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
1604cfb0 299 && (type == REG_SZ || type == REG_EXPAND_SZ))
0517ed38 300 {
1604cfb0
MS		 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);
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) {
1604cfb0
MS		 321 str = get_regstr_from(HKCU_Perl_hnd, valuename, svp);
322 if (!str)
323 goto try_HKLM;
0517ed38
DD		 324 }
325 else {
1604cfb0
MS		 326 try_HKLM:
327 if (HKLM_Perl_hnd)
328 str = get_regstr_from(HKLM_Perl_hnd, valuename, svp);
329 else
330 str = NULL;
0517ed38 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) {
1604cfb0 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 */
1604cfb0
MS		 361 optr = ptr;
362 *ptr = '\0';
363 ptr = strrchr(mod_name, '/');
364 /* avoid stripping component if there is no slash,
365 * or it doesn't match ... */
366 if (!ptr || stricmp(ptr+1, strip) != 0) {
367 /* ... but not if component matches m|5\.$patchlevel.*| */
368 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
369 && strnEQ(strip, base, baselen)
370 && strnEQ(ptr+1, base, baselen)))
371 {
372 *optr = '/';
373 ptr = optr;
374 }
375 }
376 strip = va_arg(ap, char *);
00dc2f4f 377 }
e5a95ffb 378 if (!ptr) {
1604cfb0
MS		 379 ptr = mod_name;
380 *ptr++ = '.';
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) {
1604cfb0
MS		 388 /* directory exists */
389 dTHX;
390 if (!*prev_pathp)
391 *prev_pathp = sv_2mortal(newSVpvs(""));
392 else if (SvPVX(*prev_pathp))
393 sv_catpvs(*prev_pathp, ";");
394 sv_catpv(*prev_pathp, mod_name);
395 if(len)
396 *len = SvCUR(*prev_pathp);
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 413 if (!get_regstr(buffer, &sv))
1604cfb0 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 422win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib)
1604cfb0 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)
1604cfb0 454 return NULL;
e6a0bbf8 455 if (!sv1) {
1604cfb0 456 sv1 = sv2;
e6a0bbf8 457 } else if (sv2) {
04a2c3d9 458 dTHX;
1604cfb0
MS		 459 sv_catpvs(sv1, ";");
460 sv_catsv(sv1, sv2);
e6a0bbf8 461 }
e5a95ffb 462
e6a0bbf8 463 if (len)
1604cfb0 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) {
1604cfb0
MS		 496 switch(*ptr) {
497 case '%':
498 return TRUE;
499 case '\'':
500 case '\"':
501 if (inquote) {
502 if (quote == *ptr) {
503 inquote = 0;
504 quote = '\0';
505 }
506 }
507 else {
508 quote = *ptr;
509 inquote++;
510 }
511 break;
512 case '>':
513 case '<':
514 case '|':
515 if (!inquote)
516 return TRUE;
517 default:
518 break;
519 }
520 ++ptr;
68dc0745
PP		 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 554 if (w32_pseudo_id)
1604cfb0 555 return -((int)w32_pseudo_id);
7766f137 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) {
1604cfb0
MS		 573 int slen = strlen(str);
574 char *ret;
575 char **retv;
576 Newx(ret, slen+2, char);
577 Newx(retv, (slen+3)/2, char*);
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 }
603 retvstart[items] = NULL;
604 *ret++ = '\0';
605 *ret = '\0';
ce1da67e
GS		 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) {
1604cfb0
MS		 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 */
624 const char* defaultshell = "cmd.exe /x/d/c";
625 const char *usershell = PerlEnv_getenv("PERL5SHELL");
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 644 if (sp <= mark)
1604cfb0 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))) {
1604cfb0
MS		 651 ++mark;
652 flag = SvIVx(*mark);
68dc0745
PP		 653 }
654
9404a519 655 while (++mark <= sp) {
1604cfb0
MS		 656 if (*mark && (str = SvPV_nolen(*mark)))
657 argv[index++] = str;
658 else
659 argv[index++] = "";
68dc0745
PP		 660 }
661 argv[index++] = 0;
3fadfdf1 662
2d7a9237 663 status = win32_spawnvp(flag,
1604cfb0
MS		 664 (const char*)(really ? SvPV_nolen(really) : argv[0]),
665 (const char* const*)argv);
2d7a9237 666
69374fe7 667 if (status < 0 && (eno = errno, (eno == ENOEXEC || eno == ENOENT))) {
1604cfb0
MS		 668 /* possible shell-builtin, invoke with shell */
669 int sh_items;
670 sh_items = w32_perlshell_items;
671 while (--index >= 0)
672 argv[index+sh_items] = argv[index];
673 while (--sh_items >= 0)
674 argv[sh_items] = w32_perlshell_vec[sh_items];
3fadfdf1 675
1604cfb0
MS		 676 status = win32_spawnvp(flag,
677 (const char*)(really ? SvPV_nolen(really) : argv[0]),
678 (const char* const*)argv);
2d7a9237 679 }
68dc0745 680
922b1888 681 if (flag == P_NOWAIT) {
1604cfb0 682 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS		 683 }
684 else {
1604cfb0
MS		 685 if (status < 0) {
686 if (ckWARN(WARN_EXEC))
687 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
688 status = 255 * 256;
689 }
690 else
691 status *= 256;
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) {
1604cfb0
MS		 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++;
dd7038b3
JH		 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)) {
1604cfb0
MS		 740 Newx(argv, strlen(cmd) / 2 + 2, char*);
741 Newx(cmd2, strlen(cmd) + 1, char);
742 strcpy(cmd2, cmd);
743 a = argv;
744 for (s = cmd2; *s;) {
745 while (*s && isSPACE(*s))
746 s++;
747 if (*s)
748 *(a++) = s;
749 s = find_next_space(s);
750 if (*s)
751 *s++ = '\0';
752 }
753 *a = NULL;
754 if (argv[0]) {
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:
761 status = do_spawnvp_handles(P_NOWAIT, argv[0],
762 (const char* const*)argv, handles);
763 break;
764 case EXECF_EXEC:
765 status = win32_execvp(argv[0], (const char* const*)argv);
766 break;
767 }
768 if (status != -1 || errno == 0)
769 needToTry = FALSE;
770 }
771 Safefree(argv);
772 Safefree(cmd2);
68dc0745 773 }
2d7a9237 774 if (needToTry) {
1604cfb0
MS		 775 char **argv;
776 int i = -1;
777 get_shell();
778 Newx(argv, w32_perlshell_items + 2, char*);
779 while (++i < w32_perlshell_items)
780 argv[i] = w32_perlshell_vec[i];
781 argv[i++] = (char *)cmd;
782 argv[i] = NULL;
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:
789 status = do_spawnvp_handles(P_NOWAIT, argv[0],
790 (const char* const*)argv, handles);
791 break;
792 case EXECF_EXEC:
793 status = win32_execvp(argv[0], (const char* const*)argv);
794 break;
795 }
796 cmd = argv[0];
797 Safefree(argv);
68dc0745 798 }
922b1888 799 if (exectype == EXECF_SPAWN_NOWAIT) {
1604cfb0 800 PL_statusvalue = -1; /* >16bits hint for pp_system() */
922b1888
GS		 801 }
802 else {
1604cfb0
MS		 803 if (status < 0) {
804 if (ckWARN(WARN_EXEC))
805 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
806 (exectype == EXECF_EXEC ? "exec" : "spawn"),
807 cmd, strerror(errno));
808 status = 255 * 256;
809 }
810 else
811 status *= 256;
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 860 if (len == 0) {
1604cfb0
MS		 861 errno = ENOENT;
862 return NULL;
525f9ba8
AD		 863 }
864 if (len > MAX_PATH) {
1604cfb0
MS		 865 errno = ENAMETOOLONG;
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] == ':') {
1604cfb0
MS		 877 scanname[len++] = '.';
878 scanname[len++] = '/';
23db2e2d
GS		 879 }
880 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
1604cfb0 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) {
1604cfb0
MS		 892 DWORD err = GetLastError();
893 /* FindFirstFile() fails on empty drives! */
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);
909 return NULL;
68dc0745
PP		 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)
1604cfb0 927 dirp->size = 256;
95136add 928 else
1604cfb0 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 947 if (dirp->curr) {
1604cfb0
MS		 948 /* first set up the structure to return */
949 len = strlen(dirp->curr);
950 strcpy(dirp->dirstr.d_name, dirp->curr);
951 dirp->dirstr.d_namlen = len;
0a753a76 952
1604cfb0
MS		 953 /* Fake an inode */
954 dirp->dirstr.d_ino = dirp->curr - dirp->start;
0a753a76 955
1604cfb0
MS		 956 /* Now set up for the next call to readdir */
957 dirp->curr += len + 1;
958 if (dirp->curr >= dirp->end) {
959 BOOL res;
960 char buffer[MAX_PATH*2];
95136add 961
60b22aca
JD		 962 if (dirp->handle == INVALID_HANDLE_VALUE) {
963 res = 0;
964 }
1604cfb0
MS		 965 /* finding the next file that matches the wildcard
966 * (which should be all of them in this directory!).
967 */
968 else {
35cf1ab6 969 WIN32_FIND_DATAW wFindData;
1604cfb0
MS		 970 res = FindNextFileW(dirp->handle, &wFindData);
971 if (res) {
35cf1ab6
JD		 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 }
1604cfb0
MS		 983 if (res) {
984 long endpos = dirp->end - dirp->start;
985 long newsize = endpos + strlen(buffer) + 1;
986 /* bump the string table size by enough for the
987 * new name and its null terminator */
988 while (newsize > dirp->size) {
989 long curpos = dirp->curr - dirp->start;
990 Renew(dirp->start, dirp->size * 2, char);
991 dirp->size *= 2;
992 dirp->curr = dirp->start + curpos;
993 }
994 strcpy(dirp->start + endpos, buffer);
995 dirp->end = dirp->start + newsize;
996 dirp->nfiles++;
997 }
998 else {
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 }
1604cfb0
MS		 1005 }
1006 return &(dirp->dirstr);
3fadfdf1 1007 }
68dc0745 1008 else
1604cfb0 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)
1604cfb0 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 1147 if (GetUserName(buf,&size))
1604cfb0 1148 return buf;
e34ffe5a
GS		 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*/
341a561f
SH		 1163#if((!defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4) && \
1164 (!defined(__MINGW32_MAJOR_VERSION) || __MINGW32_MAJOR_VERSION < 3 || \
1165 (__MINGW32_MAJOR_VERSION == 3 && __MINGW32_MINOR_VERSION < 21)))
00b02797
JH		 1166int mkstemp(const char *path)
1167{
1168 dTHX;
1169 char buf[MAX_PATH+1];
1170 int i = 0, fd = -1;
1171
1172retry:
1173 if (i++ > 10) { /* give up */
1604cfb0
MS		 1174 errno = ENOENT;
1175 return -1;
00b02797
JH		 1176 }
1177 if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1604cfb0
MS		 1178 errno = ENOENT;
1179 return -1;
00b02797
JH		 1180 }
1181 fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1182 if (fd == -1)
1604cfb0 1183 goto retry;
00b02797
JH		 1184 return fd;
1185}
f33b2f58 1186#endif
00b02797 1187
0aaad0ff 1188static long
04a2c3d9 1189find_pid(pTHX_ int pid)
0a753a76 1190{
7766f137
GS		 1191 long child = w32_num_children;
1192 while (--child >= 0) {
1604cfb0
MS		 1193 if ((int)w32_child_pids[child] == pid)
1194 return child;
0aaad0ff
GS		 1195 }
1196 return -1;
1197}
1198
1199static void
1200remove_dead_process(long child)
1201{
1202 if (child >= 0) {
1604cfb0
MS		 1203 dTHX;
1204 CloseHandle(w32_child_handles[child]);
1205 Move(&w32_child_handles[child+1], &w32_child_handles[child],
1206 (w32_num_children-child-1), HANDLE);
1207 Move(&w32_child_pids[child+1], &w32_child_pids[child],
1208 (w32_num_children-child-1), DWORD);
1209 w32_num_children--;
f55ee38a 1210 }
f55ee38a
GS		 1211}
1212
7766f137
GS		 1213#ifdef USE_ITHREADS
1214static long
04a2c3d9 1215find_pseudo_pid(pTHX_ int pid)
7766f137 1216{
7766f137
GS		 1217 long child = w32_num_pseudo_children;
1218 while (--child >= 0) {
1604cfb0
MS		 1219 if ((int)w32_pseudo_child_pids[child] == pid)
1220 return child;
7766f137
GS		 1221 }
1222 return -1;
1223}
1224
1225static void
1226remove_dead_pseudo_process(long child)
1227{
1228 if (child >= 0) {
1604cfb0
MS		 1229 dTHX;
1230 CloseHandle(w32_pseudo_child_handles[child]);
1231 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
1232 (w32_num_pseudo_children-child-1), HANDLE);
1233 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
1234 (w32_num_pseudo_children-child-1), DWORD);
1235 Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1236 (w32_num_pseudo_children-child-1), HWND);
1237 Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child],
1238 (w32_num_pseudo_children-child-1), char);
1239 w32_num_pseudo_children--;
7766f137
GS		 1240 }
1241}
8a3cb9c6
JD		 1242
1243void
1244win32_wait_for_children(pTHX)
1245{
1246 if (w32_pseudo_children && w32_num_pseudo_children) {
1247 long child = 0;
1248 long count = 0;
1249 HANDLE handles[MAXIMUM_WAIT_OBJECTS];
1250
1251 for (child = 0; child < w32_num_pseudo_children; ++child) {
1252 if (!w32_pseudo_child_sigterm[child])
1253 handles[count++] = w32_pseudo_child_handles[child];
1254 }
1255 /* XXX should use MsgWaitForMultipleObjects() to continue
1256 * XXX processing messages while we wait.
1257 */
1258 WaitForMultipleObjects(count, handles, TRUE, INFINITE);
1259
1260 while (w32_num_pseudo_children)
1261 CloseHandle(w32_pseudo_child_handles[--w32_num_pseudo_children]);
1262 }
1263}
7766f137
GS		 1264#endif
1265
542cb85f
JD		 1266static int
1267terminate_process(DWORD pid, HANDLE process_handle, int sig)
1268{
1269 switch(sig) {
1270 case 0:
1271 /* "Does process exist?" use of kill */
1272 return 1;
1273 case 2:
1274 if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1275 return 1;
1276 break;
1277 case SIGBREAK:
1278 case SIGTERM:
1279 if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1280 return 1;
1281 break;
1282 default: /* For now be backwards compatible with perl 5.6 */
1283 case 9:
1284 /* Note that we will only be able to kill processes owned by the
1285 * current process owner, even when we are running as an administrator.
1286 * To kill processes of other owners we would need to set the
1287 * 'SeDebugPrivilege' privilege before obtaining the process handle.
1288 */
1289 if (TerminateProcess(process_handle, sig))
1290 return 1;
1291 break;
1292 }
1293 return 0;
1294}
1295
721b2674
DD		 1296/* returns number of processes killed */
1297static int
1298my_killpg(int pid, int sig)
542cb85f
JD		 1299{
1300 HANDLE process_handle;
1301 HANDLE snapshot_handle;
1302 int killed = 0;
1303
1304 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1305 if (process_handle == NULL)
542cb85f
JD		 1306 return 0;
1307
1308 killed += terminate_process(pid, process_handle, sig);
1309
8cbe99e5 1310 snapshot_handle = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
542cb85f
JD		 1311 if (snapshot_handle != INVALID_HANDLE_VALUE) {
1312 PROCESSENTRY32 entry;
1313
1314 entry.dwSize = sizeof(entry);
8cbe99e5 1315 if (Process32First(snapshot_handle, &entry)) {
542cb85f 1316 do {
8cbe99e5 1317 if (entry.th32ParentProcessID == (DWORD)pid)
721b2674 1318 killed += my_killpg(entry.th32ProcessID, sig);
542cb85f
JD		 1319 entry.dwSize = sizeof(entry);
1320 }
8cbe99e5 1321 while (Process32Next(snapshot_handle, &entry));
542cb85f
JD		 1322 }
1323 CloseHandle(snapshot_handle);
1324 }
1325 CloseHandle(process_handle);
1326 return killed;
1327}
1328
721b2674 1329/* returns number of processes killed */
542cb85f
JD		 1330static int
1331my_kill(int pid, int sig)
1332{
1333 int retval = 0;
1334 HANDLE process_handle;
1335
1336 if (sig < 0)
721b2674 1337 return my_killpg(pid, -sig);
542cb85f
JD		 1338
1339 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af
JD		 1340 /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
1341 if (process_handle != NULL) {
542cb85f
JD		 1342 retval = terminate_process(pid, process_handle, sig);
1343 CloseHandle(process_handle);
1344 }
1345 return retval;
1346}
1347
d903973c 1348#ifdef USE_ITHREADS
17ce47a8
SH		 1349/* Get a child pseudo-process HWND, with retrying and delaying/yielding.
1350 * The "tries" parameter is the number of retries to make, with a Sleep(1)
1351 * (waiting and yielding the time slot) between each try. Specifying 0 causes
1352 * only Sleep(0) (no waiting and potentially no yielding) to be used, so is not
1353 * recommended
1354 * Returns an hwnd != INVALID_HANDLE_VALUE (so be aware that NULL can be
1355 * returned) or croaks if the child pseudo-process doesn't schedule and deliver
1356 * a HWND in the time period allowed.
1357 */
d903973c 1358static HWND
17ce47a8
SH		 1359get_hwnd_delay(pTHX, long child, DWORD tries)
1360{
d903973c 1361 HWND hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1362 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8
SH		 1363
1364 /* Pseudo-process has not yet properly initialized since hwnd isn't set.
1365 * Fast sleep: On some NT kernels/systems, a Sleep(0) won't deschedule a
1366 * thread 100% of the time since threads are attached to a CPU for NUMA and
1367 * caching reasons, and the child thread was attached to a different CPU
1368 * therefore there is no workload on that CPU and Sleep(0) returns control
1369 * without yielding the time slot.
8034715d 1370 * https://github.com/Perl/perl5/issues/11267
17ce47a8 1371 */
d903973c
DD		 1372 Sleep(0);
1373 win32_async_check(aTHX);
17ce47a8 1374 hwnd = w32_pseudo_child_message_hwnds[child];
d903973c 1375 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
17ce47a8 1376
d903973c 1377 {
1604cfb0
MS		 1378 unsigned int count = 0;
1379 /* No Sleep(1) if tries==0, just fail instead if we get this far. */
1380 while (count++ < tries) {
1381 Sleep(1);
1382 win32_async_check(aTHX);
1383 hwnd = w32_pseudo_child_message_hwnds[child];
1384 if (hwnd != INVALID_HANDLE_VALUE) return hwnd;
1385 }
d903973c 1386 }
17ce47a8
SH		 1387
1388 Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled");
d903973c
DD		 1389}
1390#endif
1391
f55ee38a
GS		 1392DllExport int
1393win32_kill(int pid, int sig)
1394{
acfe0abc 1395 dTHX;
c66b022d 1396 long child;
7766f137
GS		 1397#ifdef USE_ITHREADS
1398 if (pid < 0) {
1604cfb0
MS		 1399 /* it is a pseudo-forked child */
1400 child = find_pseudo_pid(aTHX_ -pid);
1401 if (child >= 0) {
1402 HANDLE hProcess = w32_pseudo_child_handles[child];
1403 switch (sig) {
1404 case 0:
1405 /* "Does process exist?" use of kill */
1406 return 0;
1407
1408 case 9: {
1409 /* kill -9 style un-graceful exit */
1410 /* Do a wait to make sure child starts and isn't in DLL
1411 * Loader Lock */
1412 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1413 if (TerminateThread(hProcess, sig)) {
1414 /* Allow the scheduler to finish cleaning up the other
1415 * thread.
1416 * Otherwise, if we ExitProcess() before another context
1417 * switch happens we will end up with a process exit
1418 * code of "sig" instead of our own exit status.
1419 * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
1420 */
1421 Sleep(0);
1422 remove_dead_pseudo_process(child);
1423 return 0;
1424 }
1425 break;
1426 }
1427
1428 default: {
1429 HWND hwnd = get_hwnd_delay(aTHX, child, 5);
1430 /* We fake signals to pseudo-processes using Win32
1431 * message queue. */
1432 if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1433 PostThreadMessage(-pid, WM_USER_KILL, sig, 0))
1434 {
1435 /* Don't wait for child process to terminate after we send a
1436 * SIGTERM because the child may be blocked in a system call
1437 * and never receive the signal.
1438 */
1439 if (sig == SIGTERM) {
1440 Sleep(0);
1441 w32_pseudo_child_sigterm[child] = 1;
1442 }
1443 /* It might be us ... */
1444 PERL_ASYNC_CHECK();
1445 return 0;
1446 }
1447 break;
1448 }
1449 } /* switch */
1450 }
68dc0745 1451 }
7766f137
GS		 1452 else
1453#endif
1454 {
1604cfb0
MS		 1455 child = find_pid(aTHX_ pid);
1456 if (child >= 0) {
542cb85f
JD		 1457 if (my_kill(pid, sig)) {
1458 DWORD exitcode = 0;
1459 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1460 exitcode != STILL_ACTIVE)
1461 {
1462 remove_dead_process(child);
1463 }
1464 return 0;
7e5f34c0 1465 }
1604cfb0
MS		 1466 }
1467 else {
8cbe99e5 1468 if (my_kill(pid, sig))
48db714f 1469 return 0;
1604cfb0 1470 }
7766f137
GS		 1471 }
1472 errno = EINVAL;
1473 return -1;
0a753a76 1474}
fbbbcc48 1475
e935ef33
TC		 1476PERL_STATIC_INLINE
1477time_t
1478translate_ft_to_time_t(FILETIME ft) {
690ab4ba
TC		 1479 SYSTEMTIME st, local_st;
1480 struct tm pt;
1481
1482 if (!FileTimeToSystemTime(&ft, &st) ||
1483 !SystemTimeToTzSpecificLocalTime(NULL, &st, &local_st)) {
1484 return -1;
1485 }
1486
1487 Zero(&pt, 1, struct tm);
1488 pt.tm_year = local_st.wYear - 1900;
1489 pt.tm_mon = local_st.wMonth - 1;
1490 pt.tm_mday = local_st.wDay;
1491 pt.tm_hour = local_st.wHour;
1492 pt.tm_min = local_st.wMinute;
1493 pt.tm_sec = local_st.wSecond;
1494 pt.tm_isdst = -1;
1495
1496 return mktime(&pt);
e935ef33
TC		 1497}
1498
9a125091
TC		 1499typedef DWORD (__stdcall *pGetFinalPathNameByHandleA_t)(HANDLE, LPSTR, DWORD, DWORD);
1500
e935ef33
TC		 1501static int
1502win32_stat_low(HANDLE handle, const char *path, STRLEN len, Stat_t *sbuf) {
1503 DWORD type = GetFileType(handle);
1504 BY_HANDLE_FILE_INFORMATION bhi;
1505
1506 Zero(sbuf, 1, Stat_t);
1507
1508 type &= ~FILE_TYPE_REMOTE;
1509
1510 switch (type) {
1511 case FILE_TYPE_DISK:
1512 if (GetFileInformationByHandle(handle, &bhi)) {
1513 sbuf->st_dev = bhi.dwVolumeSerialNumber;
1514 sbuf->st_ino = bhi.nFileIndexHigh;
1515 sbuf->st_ino <<= 32;
1516 sbuf->st_ino |= bhi.nFileIndexLow;
1517 sbuf->st_nlink = bhi.nNumberOfLinks;
1518 sbuf->st_uid = 0;
1519 sbuf->st_gid = 0;
1520 /* ucrt sets this to the drive letter for
1521 stat(), lets not reproduce that mistake */
1522 sbuf->st_rdev = 0;
1523 sbuf->st_size = bhi.nFileSizeHigh;
1524 sbuf->st_size <<= 32;
1525 sbuf->st_size |= bhi.nFileSizeLow;
1526
1527 sbuf->st_atime = translate_ft_to_time_t(bhi.ftLastAccessTime);
1528 sbuf->st_mtime = translate_ft_to_time_t(bhi.ftLastWriteTime);
1529 sbuf->st_ctime = translate_ft_to_time_t(bhi.ftCreationTime);
1530
1531 if (bhi.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) {
1532 sbuf->st_mode = _S_IFDIR | _S_IREAD | _S_IEXEC;
1533 /* duplicate the logic from the end of the old win32_stat() */
1534 if (!(bhi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) {
1535 sbuf->st_mode |= S_IWRITE;
1536 }
1537 }
1538 else {
1539 char path_buf[MAX_PATH+1];
1540 sbuf->st_mode = _S_IFREG;
1541
1542 if (!path) {
9a125091
TC		 1543 pGetFinalPathNameByHandleA_t pGetFinalPathNameByHandleA =
1544 (pGetFinalPathNameByHandleA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "GetFinalPathNameByHandleA");
1545 if (pGetFinalPathNameByHandleA) {
1546 len = pGetFinalPathNameByHandleA(handle, path_buf, sizeof(path_buf), 0);
1547 }
1548 else {
1549 len = 0;
1550 }
1551
e935ef33
TC		 1552 /* < to ensure there's space for the \0 */
1553 if (len && len < sizeof(path_buf)) {
1554 path = path_buf;
1555 }
1556 }
1557
1558 if (path && len > 4 &&
1559 (_stricmp(path + len - 4, ".exe") == 0 ||
1560 _stricmp(path + len - 4, ".bat") == 0 ||
1561 _stricmp(path + len - 4, ".cmd") == 0 ||
1562 _stricmp(path + len - 4, ".com") == 0)) {
1563 sbuf->st_mode |= _S_IEXEC;
1564 }
1565 if (!(bhi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) {
1566 sbuf->st_mode |= _S_IWRITE;
1567 }
1568 sbuf->st_mode |= _S_IREAD;
1569 }
1570 }
1571 else {
1572 translate_to_errno();
1573 return -1;
1574 }
1575 break;
1576
1577 case FILE_TYPE_CHAR:
1578 case FILE_TYPE_PIPE:
1579 sbuf->st_mode = (type == FILE_TYPE_CHAR) ? _S_IFCHR : _S_IFIFO;
1580 if (handle == GetStdHandle(STD_INPUT_HANDLE) ||
1581 handle == GetStdHandle(STD_OUTPUT_HANDLE) ||
1582 handle == GetStdHandle(STD_ERROR_HANDLE)) {
1583 sbuf->st_mode |= _S_IWRITE | _S_IREAD;
1584 }
1585 break;
1586
1587 default:
1588 return -1;
1589 }
1590
1591 /* owner == user == group */
1592 sbuf->st_mode |= (sbuf->st_mode & 0700) >> 3;
1593 sbuf->st_mode |= (sbuf->st_mode & 0700) >> 6;
1594
1595 return 0;
1596}
1597
68dc0745 1598DllExport int
c623ac67 1599win32_stat(const char *path, Stat_t *sbuf)
0a753a76 1600{
e935ef33 1601 size_t l = strlen(path);
04a2c3d9 1602 dTHX;
44221b20 1603 BOOL expect_dir = FALSE;
e935ef33
TC		 1604 int result;
1605 HANDLE handle;
6b980173 1606
8c56068e
JD		 1607 path = PerlDir_mapA(path);
1608 l = strlen(path);
cba61fe1 1609
e935ef33
TC		 1610 handle =
1611 CreateFileA(path, FILE_READ_ATTRIBUTES,
1612 FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE,
1613 NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
1614 if (handle != INVALID_HANDLE_VALUE) {
1615 result = win32_stat_low(handle, path, l, sbuf);
1616 CloseHandle(handle);
24caa93f 1617 }
24caa93f 1618 else {
e935ef33
TC		 1619 translate_to_errno();
1620 result = -1;
2293b0e9 1621 }
e935ef33
TC		 1622
1623 return result;
0a753a76
PP		 1624}
1625
92b3a3eb
TC		 1626static void
1627translate_to_errno(void)
1628{
1629 /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for
1630 both permissions errors and if the source is a directory, while
1631 POSIX wants EACCES and EPERM respectively.
92b3a3eb
TC		 1632 */
1633 switch (GetLastError()) {
1634 case ERROR_BAD_NET_NAME:
1635 case ERROR_BAD_NETPATH:
1636 case ERROR_BAD_PATHNAME:
1637 case ERROR_FILE_NOT_FOUND:
1638 case ERROR_FILENAME_EXCED_RANGE:
1639 case ERROR_INVALID_DRIVE:
1640 case ERROR_PATH_NOT_FOUND:
1641 errno = ENOENT;
1642 break;
1643 case ERROR_ALREADY_EXISTS:
1644 errno = EEXIST;
1645 break;
1646 case ERROR_ACCESS_DENIED:
92b3a3eb
TC		 1647 errno = EACCES;
1648 break;
e935ef33
TC		 1649 case ERROR_PRIVILEGE_NOT_HELD:
1650 errno = EPERM;
1651 break;
92b3a3eb
TC		 1652 case ERROR_NOT_SAME_DEVICE:
1653 errno = EXDEV;
1654 break;
1655 case ERROR_DISK_FULL:
1656 errno = ENOSPC;
1657 break;
1658 case ERROR_NOT_ENOUGH_QUOTA:
1659 errno = EDQUOT;
1660 break;
1661 default:
1662 /* ERROR_INVALID_FUNCTION - eg. symlink on a FAT volume */
1663 errno = EINVAL;
1664 break;
1665 }
1666}
1667
1668/* Adapted from:
1669
1670https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/ntifs/ns-ntifs-_reparse_data_buffer
1671
1672Renamed to avoid conflicts, apparently some SDKs define this
1673structure.
1674
2bfb75d2
TC		 1675Hoisted the symlink and mount point data into a new type to allow us
1676to make a pointer to it, and to avoid C++ scoping issues.
92b3a3eb
TC		 1677
1678*/
1679
1680typedef struct {
1681 USHORT SubstituteNameOffset;
1682 USHORT SubstituteNameLength;
1683 USHORT PrintNameOffset;
1684 USHORT PrintNameLength;
1685 ULONG Flags;
1686 WCHAR PathBuffer[MAX_PATH*3];
1687} MY_SYMLINK_REPARSE_BUFFER, *PMY_SYMLINK_REPARSE_BUFFER;
1688
1689typedef struct {
2bfb75d2
TC		 1690 USHORT SubstituteNameOffset;
1691 USHORT SubstituteNameLength;
1692 USHORT PrintNameOffset;
1693 USHORT PrintNameLength;
1694 WCHAR PathBuffer[MAX_PATH*3];
1695} MY_MOUNT_POINT_REPARSE_BUFFER;
1696
1697typedef struct {
92b3a3eb
TC		 1698 ULONG ReparseTag;
1699 USHORT ReparseDataLength;
1700 USHORT Reserved;
1701 union {
1702 MY_SYMLINK_REPARSE_BUFFER SymbolicLinkReparseBuffer;
2bfb75d2 1703 MY_MOUNT_POINT_REPARSE_BUFFER MountPointReparseBuffer;
92b3a3eb
TC		 1704 struct {
1705 UCHAR DataBuffer[1];
1706 } GenericReparseBuffer;
1707 } Data;
1708} MY_REPARSE_DATA_BUFFER, *PMY_REPARSE_DATA_BUFFER;
1709
9a125091
TC		 1710#ifndef IO_REPARSE_TAG_SYMLINK
1711# define IO_REPARSE_TAG_SYMLINK (0xA000000CL)
1712#endif
1713
92b3a3eb
TC		 1714static BOOL
1715is_symlink(HANDLE h) {
1716 MY_REPARSE_DATA_BUFFER linkdata;
1717 const MY_SYMLINK_REPARSE_BUFFER * const sd =
1718 &linkdata.Data.SymbolicLinkReparseBuffer;
1719 DWORD linkdata_returned;
1720
1721 if (!DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) {
1722 return FALSE;
1723 }
1724
1725 if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer)
2bfb75d2
TC		 1726 || (linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK
1727 && linkdata.ReparseTag != IO_REPARSE_TAG_MOUNT_POINT)) {
92b3a3eb
TC		 1728 /* some other type of reparse point */
1729 return FALSE;
1730 }
1731
1732 return TRUE;
1733}
1734
680b2c5e
TC		 1735static BOOL
1736is_symlink_name(const char *name) {
1737 HANDLE f = CreateFileA(name, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1738 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1739 BOOL result;
1740
1741 if (f == INVALID_HANDLE_VALUE) {
1742 return FALSE;
1743 }
1744 result = is_symlink(f);
1745 CloseHandle(f);
1746
1747 return result;
1748}
1749
1750DllExport int
1751win32_readlink(const char *pathname, char *buf, size_t bufsiz) {
1752 MY_REPARSE_DATA_BUFFER linkdata;
680b2c5e
TC		 1753 HANDLE hlink;
1754 DWORD fileattr = GetFileAttributes(pathname);
1755 DWORD linkdata_returned;
1756 int bytes_out;
1757 BOOL used_default;
1758
1759 if (fileattr == INVALID_FILE_ATTRIBUTES) {
1760 translate_to_errno();
1761 return -1;
1762 }
1763
1764 if (!(fileattr & FILE_ATTRIBUTE_REPARSE_POINT)) {
1765 /* not a symbolic link */
1766 errno = EINVAL;
1767 return -1;
1768 }
1769
1770 hlink =
1771 CreateFileA(pathname, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1772 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1773 if (hlink == INVALID_HANDLE_VALUE) {
1774 translate_to_errno();
1775 return -1;
1776 }
1777
1778 if (!DeviceIoControl(hlink, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) {
1779 translate_to_errno();
1780 CloseHandle(hlink);
1781 return -1;
1782 }
1783 CloseHandle(hlink);
1784
2bfb75d2
TC		 1785 switch (linkdata.ReparseTag) {
1786 case IO_REPARSE_TAG_SYMLINK:
1787 {
1788 const MY_SYMLINK_REPARSE_BUFFER * const sd =
1789 &linkdata.Data.SymbolicLinkReparseBuffer;
1790 if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer)) {
1791 errno = EINVAL;
1792 return -1;
1793 }
1794 bytes_out =
1795 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
1796 sd->PathBuffer + sd->SubstituteNameOffset/2,
1797 sd->SubstituteNameLength/2,
1798 buf, (int)bufsiz, NULL, &used_default);
1799 }
1800 break;
1801 case IO_REPARSE_TAG_MOUNT_POINT:
1802 {
1803 const MY_MOUNT_POINT_REPARSE_BUFFER * const rd =
1804 &linkdata.Data.MountPointReparseBuffer;
1805 if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.MountPointReparseBuffer.PathBuffer)) {
1806 errno = EINVAL;
1807 return -1;
1808 }
1809 bytes_out =
1810 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
1811 rd->PathBuffer + rd->SubstituteNameOffset/2,
1812 rd->SubstituteNameLength/2,
1813 buf, (int)bufsiz, NULL, &used_default);
1814 }
1815 break;
1816
1817 default:
680b2c5e
TC		 1818 errno = EINVAL;
1819 return -1;
1820 }
1821
680b2c5e
TC		 1822 if (bytes_out == 0 || used_default) {
1823 /* failed conversion from unicode to ANSI or otherwise failed */
1824 errno = EINVAL;
1825 return -1;
1826 }
1827 if ((size_t)bytes_out > bufsiz) {
1828 errno = EINVAL;
1829 return -1;
1830 }
1831
1832 return bytes_out;
1833}
1834
92b3a3eb
TC		 1835DllExport int
1836win32_lstat(const char *path, Stat_t *sbuf)
1837{
1838 HANDLE f;
92b3a3eb
TC		 1839 int result;
1840 DWORD attr = GetFileAttributes(path); /* doesn't follow symlinks */
1841
1842 if (attr == INVALID_FILE_ATTRIBUTES) {
1843 translate_to_errno();
1844 return -1;
1845 }
1846
1847 if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
1848 return win32_stat(path, sbuf);
1849 }
1850
1851 f = CreateFileA(path, GENERIC_READ, 0, NULL, OPEN_EXISTING,
1852 FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0);
1853 if (f == INVALID_HANDLE_VALUE) {
1854 translate_to_errno();
1855 return -1;
1856 }
1857
1858 if (!is_symlink(f)) {
1859 CloseHandle(f);
1860 return win32_stat(path, sbuf);
1861 }
1862
e935ef33
TC		 1863 result = win32_stat_low(f, NULL, 0, sbuf);
1864 CloseHandle(f);
1865
92b3a3eb
TC		 1866 if (result != -1){
1867 sbuf->st_mode = (sbuf->st_mode & ~_S_IFMT) | _S_IFLNK;
1868 }
e935ef33 1869
92b3a3eb
TC		 1870 return result;
1871}
1872
bb27e7b6
JH		 1873#define isSLASH(c) ((c) == '/' || (c) == '\\')
1874#define SKIP_SLASHES(s) \
1875 STMT_START { \
1604cfb0
MS		 1876 while (*(s) && isSLASH(*(s))) \
1877 ++(s); \
bb27e7b6
JH		 1878 } STMT_END
1879#define COPY_NONSLASHES(d,s) \
1880 STMT_START { \
1604cfb0
MS		 1881 while (*(s) && !isSLASH(*(s))) \
1882 *(d)++ = *(s)++; \
bb27e7b6
JH		 1883 } STMT_END
1884
8ac9c18d
GS		 1885/* Find the longname of a given path. path is destructively modified.
1886 * It should have space for at least MAX_PATH characters. */
1887DllExport char *
1888win32_longpath(char *path)
1889{
1890 WIN32_FIND_DATA fdata;
1891 HANDLE fhand;
1892 char tmpbuf[MAX_PATH+1];
1893 char *tmpstart = tmpbuf;
1894 char *start = path;
1895 char sep;
1896 if (!path)
1604cfb0 1897 return NULL;
8ac9c18d
GS		 1898
1899 /* drive prefix */
bb27e7b6 1900 if (isALPHA(path[0]) && path[1] == ':') {
1604cfb0
MS		 1901 start = path + 2;
1902 *tmpstart++ = path[0];
1903 *tmpstart++ = ':';
8ac9c18d
GS		 1904 }
1905 /* UNC prefix */
bb27e7b6 1906 else if (isSLASH(path[0]) && isSLASH(path[1])) {
1604cfb0
MS		 1907 start = path + 2;
1908 *tmpstart++ = path[0];
1909 *tmpstart++ = path[1];
1910 SKIP_SLASHES(start);
1911 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
1912 if (*start) {
1913 *tmpstart++ = *start++;
1914 SKIP_SLASHES(start);
1915 COPY_NONSLASHES(tmpstart,start); /* copy share name */
1916 }
8ac9c18d 1917 }
8ac9c18d 1918 *tmpstart = '\0';
bb27e7b6 1919 while (*start) {
1604cfb0
MS		 1920 /* copy initial slash, if any */
1921 if (isSLASH(*start)) {
1922 *tmpstart++ = *start++;
1923 *tmpstart = '\0';
1924 SKIP_SLASHES(start);
1925 }
1926
1927 /* FindFirstFile() expands "." and "..", so we need to pass
1928 * those through unmolested */
1929 if (*start == '.'
1930 && (!start[1] || isSLASH(start[1])
1931 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1932 {
1933 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1934 *tmpstart = '\0';
1935 continue;
1936 }
1937
1938 /* if this is the end, bust outta here */
1939 if (!*start)
1940 break;
1941
1942 /* now we're at a non-slash; walk up to next slash */
1943 while (*start && !isSLASH(*start))
1944 ++start;
1945
1946 /* stop and find full name of component */
1947 sep = *start;
1948 *start = '\0';
1949 fhand = FindFirstFile(path,&fdata);
1950 *start = sep;
1951 if (fhand != INVALID_HANDLE_VALUE) {
1952 STRLEN len = strlen(fdata.cFileName);
1953 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1954 strcpy(tmpstart, fdata.cFileName);
1955 tmpstart += len;
1956 FindClose(fhand);
1957 }
1958 else {
1959 FindClose(fhand);
1960 errno = ERANGE;
1961 return NULL;
1962 }
1963 }
1964 else {
1965 /* failed a step, just return without side effects */
1966 errno = EINVAL;
1967 return NULL;
1968 }
8ac9c18d
GS		 1969 }
1970 strcpy(path,tmpbuf);
1971 return path;
1972}
1973
aa2b96ec 1974static void
0934c9d9 1975out_of_memory(void)
aa2b96ec 1976{
1565c085 1977
4cbe3a7d 1978 if (PL_curinterp)
1604cfb0 1979 croak_no_mem();
ae6198af 1980 exit(1);
aa2b96ec
JD		 1981}
1982
073dd035
DD		 1983void
1984win32_croak_not_implemented(const char * fname)
1985{
1986 PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
1987
1988 Perl_croak_nocontext("%s not implemented!\n", fname);
1989}
1990
00a0ae28
SH		 1991/* Converts a wide character (UTF-16) string to the Windows ANSI code page,
1992 * potentially using the system's default replacement character for any
1993 * unrepresentable characters. The caller must free() the returned string. */
1994static char*
1995wstr_to_str(const wchar_t* wstr)
1996{
1997 BOOL used_default = FALSE;
1998 size_t wlen = wcslen(wstr) + 1;
1999 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
2000 NULL, 0, NULL, NULL);
f76b679e 2001 char* str = (char*)malloc(len);
00a0ae28
SH		 2002 if (!str)
2003 out_of_memory();
2004 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
2005 str, len, NULL, &used_default);
2006 return str;
2007}
2008
aa2b96ec
JD		 2009/* The win32_ansipath() function takes a Unicode filename and converts it
2010 * into the current Windows codepage. If some characters cannot be mapped,
2011 * then it will convert the short name instead.
2012 *
2013 * The buffer to the ansi pathname must be freed with win32_free() when it
a3815e44 2014 * is no longer needed.
aa2b96ec
JD		 2015 *
2016 * The argument to win32_ansipath() must exist before this function is
2017 * called; otherwise there is no way to determine the short path name.
2018 *
2019 * Ideas for future refinement:
2020 * - Only convert those segments of the path that are not in the current
2021 * codepage, but leave the other segments in their long form.
2022 * - If the resulting name is longer than MAX_PATH, start converting
2023 * additional path segments into short names until the full name
2024 * is shorter than MAX_PATH. Shorten the filename part last!
2025 */
2026DllExport char *
2027win32_ansipath(const WCHAR *widename)
2028{
2029 char *name;
2030 BOOL use_default = FALSE;
2031 size_t widelen = wcslen(widename)+1;
2032 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
2033 NULL, 0, NULL, NULL);
f76b679e 2034 name = (char*)win32_malloc(len);
aa2b96ec
JD		 2035 if (!name)
2036 out_of_memory();
2037
2038 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
2039 name, len, NULL, &use_default);
2040 if (use_default) {
aa2b96ec 2041 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af 2042 if (shortlen) {
f76b679e 2043 WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
ae6198af
JD		 2044 if (!shortname)
2045 out_of_memory();
2046 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
2047
2048 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
2049 NULL, 0, NULL, NULL);
f76b679e 2050 name = (char*)win32_realloc(name, len);
ae6198af
JD		 2051 if (!name)
2052 out_of_memory();
2053 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
2054 name, len, NULL, NULL);
2055 win32_free(shortname);
2056 }
aa2b96ec
JD		 2057 }
2058 return name;
2059}
2060
2c8ca683
DD		 2061/* the returned string must be freed with win32_freeenvironmentstrings which is
2062 * implemented as a macro
2063 * void win32_freeenvironmentstrings(void* block)
2064 */
0551aaa8 2065DllExport char *
4f46e52b
KR		 2066win32_getenvironmentstrings(void)
2067{
2068 LPWSTR lpWStr, lpWTmp;
2069 LPSTR lpStr, lpTmp;
2070 DWORD env_len, wenvstrings_len = 0, aenvstrings_len = 0;
2071
2072 /* Get the process environment strings */
2073 lpWTmp = lpWStr = (LPWSTR) GetEnvironmentStringsW();
fa467b9b 2074 for (wenvstrings_len = 1; *lpWTmp != '\0'; lpWTmp += env_len + 1) {
4f46e52b
KR		 2075 env_len = wcslen(lpWTmp);
2076 /* calculate the size of the environment strings */
2077 wenvstrings_len += env_len + 1;
2078 }
2079
fa467b9b 2080 /* Get the number of bytes required to store the ACP encoded string */
4f46e52b 2081 aenvstrings_len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
fa467b9b 2082 lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
4f46e52b
KR		 2083 lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
2084 if(!lpTmp)
2085 out_of_memory();
2086
2087 /* Convert the string from UTF-16 encoding to ACP encoding */
2088 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,
fa467b9b 2089 aenvstrings_len, NULL, NULL);
4f46e52b 2090
a6abe943 2091 FreeEnvironmentStringsW(lpWStr);
90674eaa 2092
4f46e52b
KR		 2093 return(lpStr);
2094}
2095
4f46e52b 2096DllExport char *
0551aaa8
GS		 2097win32_getenv(const char *name)
2098{
acfe0abc 2099 dTHX;
0551aaa8 2100 DWORD needlen;
4e205ed6 2101 SV *curitem = NULL;
1fcb0052 2102 DWORD last_err;
58a50f62 2103
8c56068e 2104 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 2105 if (needlen != 0) {
1604cfb0 2106 curitem = sv_2mortal(newSVpvs(""));
8c56068e
JD		 2107 do {
2108 SvGROW(curitem, needlen+1);
2109 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
2110 needlen);
2111 } while (needlen >= SvLEN(curitem));
2112 SvCUR_set(curitem, needlen);
0551aaa8 2113 }
c934e9d4 2114 else {
1604cfb0
MS		 2115 last_err = GetLastError();
2116 if (last_err == ERROR_NOT_ENOUGH_MEMORY) {
2117 /* It appears the variable is in the env, but the Win32 API
2118 doesn't have a canned way of getting it. So we fall back to
2119 grabbing the whole env and pulling this value out if possible */
2120 char *envv = GetEnvironmentStrings();
2121 char *cur = envv;
2122 STRLEN len;
2123 while (*cur) {
2124 char *end = strchr(cur,'=');
2125 if (end && end != cur) {
2126 *end = '\0';
2127 if (strEQ(cur,name)) {
2128 curitem = sv_2mortal(newSVpv(end+1,0));
2129 *end = '=';
2130 break;
2131 }
2132 *end = '=';
2133 cur = end + strlen(end+1)+2;
2134 }
2135 else if ((len = strlen(cur)))
2136 cur += len+1;
2137 }
2138 FreeEnvironmentStrings(envv);
2139 }
6937817d 2140#ifndef WIN32_NO_REGISTRY
1604cfb0
MS		 2141 else {
2142 /* last ditch: allow any environment variables that begin with 'PERL'
2143 to be obtained from the registry, if found there */
2144 if (strBEGINs(name, "PERL"))
2145 (void)get_regstr(name, &curitem);
2146 }
6937817d 2147#endif
c69f6586 2148 }
51371543 2149 if (curitem && SvCUR(curitem))
1604cfb0 2150 return SvPVX(curitem);
58a50f62 2151
4e205ed6 2152 return NULL;
0551aaa8
GS		 2153}
2154
ac5c734f
GS		 2155DllExport int
2156win32_putenv(const char *name)
2157{
2158 char* curitem;
2159 char* val;
b813a9c7 2160 int relval = -1;
51371543 2161
73c4f7a1 2162 if (name) {
9399a70c 2163 curitem = (char *) win32_malloc(strlen(name)+1);
8c56068e
JD		 2164 strcpy(curitem, name);
2165 val = strchr(curitem, '=');
2166 if (val) {
2167 /* The sane way to deal with the environment.
2168 * Has these advantages over putenv() & co.:
2169 * * enables us to store a truly empty value in the
2170 * environment (like in UNIX).
8d0cd07e
SH		 2171 * * we don't have to deal with RTL globals, bugs and leaks
2172 * (specifically, see http://support.microsoft.com/kb/235601).
8c56068e 2173 * * Much faster.
d0fc6d8d
SH		 2174 * Why you may want to use the RTL environment handling
2175 * (previously enabled by USE_WIN32_RTL_ENV):
8c56068e
JD		 2176 * * environ[] and RTL functions will not reflect changes,
2177 * which might be an issue if extensions want to access
2178 * the env. via RTL. This cuts both ways, since RTL will
2179 * not see changes made by extensions that call the Win32
2180 * functions directly, either.
2181 * GSAR 97-06-07
2182 */
2183 *val++ = '\0';
2184 if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
2185 relval = 0;
2186 }
9399a70c 2187 win32_free(curitem);
ac5c734f
GS		 2188 }
2189 return relval;
2190}
2191
d55594ae 2192static long
2d7a9237 2193filetime_to_clock(PFILETIME ft)
d55594ae 2194{
7766f137
GS		 2195 __int64 qw = ft->dwHighDateTime;
2196 qw <<= 32;
2197 qw |= ft->dwLowDateTime;
2198 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
2199 return (long) qw;
d55594ae
GS		 2200}
2201
f3986ebb
GS		 2202DllExport int
2203win32_times(struct tms *timebuf)
0a753a76 2204{
d55594ae
GS		 2205 FILETIME user;
2206 FILETIME kernel;
2207 FILETIME dummy;
50ee8e5e 2208 clock_t process_time_so_far = clock();
3fadfdf1 2209 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
d55594ae 2210 &kernel,&user)) {
1604cfb0
MS		 2211 timebuf->tms_utime = filetime_to_clock(&user);
2212 timebuf->tms_stime = filetime_to_clock(&kernel);
2213 timebuf->tms_cutime = 0;
2214 timebuf->tms_cstime = 0;
3fadfdf1 2215 } else {
d55594ae 2216 /* That failed - e.g. Win95 fallback to clock() */
1604cfb0
MS		 2217 timebuf->tms_utime = process_time_so_far;
2218 timebuf->tms_stime = 0;
2219 timebuf->tms_cutime = 0;
2220 timebuf->tms_cstime = 0;
d55594ae 2221 }
50ee8e5e 2222 return process_time_so_far;
0a753a76
PP		 2223}
2224
ad0751ec
GS		 2225static BOOL
2226filetime_from_time(PFILETIME pFileTime, time_t Time)
2227{
690ab4ba
TC		 2228 struct tm *pt;
2229 SYSTEMTIME st;
ad0751ec 2230
690ab4ba
TC		 2231 pt = gmtime(&Time);
2232 if (!pt) {
2233 pFileTime->dwLowDateTime = 0;
2234 pFileTime->dwHighDateTime = 0;
2235 fprintf(stderr, "fail bad gmtime\n");
2236 return FALSE;
2237 }
2238
2239 st.wYear = pt->tm_year + 1900;
2240 st.wMonth = pt->tm_mon + 1;
2241 st.wDay = pt->tm_mday;
2242 st.wHour = pt->tm_hour;
2243 st.wMinute = pt->tm_min;
2244 st.wSecond = pt->tm_sec;
2245 st.wMilliseconds = 0;
2246
2247 if (!SystemTimeToFileTime(&st, pFileTime)) {
2248 pFileTime->dwLowDateTime = 0;
2249 pFileTime->dwHighDateTime = 0;
2250 return FALSE;
2251 }
ad0751ec 2252
e935ef33 2253 return TRUE;
ad0751ec
GS		 2254}
2255
2256DllExport int
7766f137
GS		 2257win32_unlink(const char *filename)
2258{
acfe0abc 2259 dTHX;
7766f137
GS		 2260 int ret;
2261 DWORD attrs;
2262
8c56068e
JD		 2263 filename = PerlDir_mapA(filename);
2264 attrs = GetFileAttributesA(filename);
2265 if (attrs == 0xFFFFFFFF) {
2266 errno = ENOENT;
2267 return -1;
7766f137 2268 }
8c56068e
JD		 2269 if (attrs & FILE_ATTRIBUTE_READONLY) {
2270 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
2271 ret = unlink(filename);
2272 if (ret == -1)
2273 (void)SetFileAttributesA(filename, attrs);
7766f137 2274 }
680b2c5e
TC		 2275 else if ((attrs & (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY))
2276 == (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY)
2277 && is_symlink_name(filename)) {
2278 ret = rmdir(filename);
2279 }
2280 else {
8c56068e 2281 ret = unlink(filename);
680b2c5e 2282 }
7766f137
GS		 2283 return ret;
2284}
2285
2286DllExport int
3b405fc5 2287win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 2288{
acfe0abc 2289 dTHX;
ad0751ec 2290 HANDLE handle;
ad0751ec
GS		 2291 FILETIME ftAccess;
2292 FILETIME ftWrite;
2293 struct utimbuf TimeBuffer;
e935ef33 2294 int rc = -1;
8c56068e
JD		 2295
2296 filename = PerlDir_mapA(filename);
ad0751ec 2297 /* This will (and should) still fail on readonly files */
8c56068e 2298 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
e935ef33 2299 FILE_SHARE_READ | FILE_SHARE_WRITE, NULL,
8c56068e 2300 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
e935ef33
TC		 2301 if (handle == INVALID_HANDLE_VALUE) {
2302 translate_to_errno();
2303 return -1;
2304 }
ad0751ec 2305
e935ef33
TC		 2306 if (times == NULL) {
2307 times = &TimeBuffer;
2308 time(&times->actime);
2309 times->modtime = times->actime;
2310 }
2311
2312 if (filetime_from_time(&ftAccess, times->actime) &&
1604cfb0 2313 filetime_from_time(&ftWrite, times->modtime)) {
e935ef33
TC		 2314 if (SetFileTime(handle, NULL, &ftAccess, &ftWrite)) {
2315 rc = 0;
2316 }
2317 else {
2318 translate_to_errno();
2319 }
2320 }
2321 else {
2322 errno = EINVAL; /* bad time? */
ad0751ec
GS		 2323 }
2324
2325 CloseHandle(handle);
2326 return rc;
2327}
2328
6e3b076d
JH		 2329typedef union {
2330 unsigned __int64 ft_i64;
2331 FILETIME ft_val;
2332} FT_t;
2333
2334#ifdef __GNUC__
2335#define Const64(x) x##LL
2336#else
2337#define Const64(x) x##i64
2338#endif
2339/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
2340#define EPOCH_BIAS Const64(116444736000000000)
2341
57ab3dfe
GS		 2342/* NOTE: This does not compute the timezone info (doing so can be expensive,
2343 * and appears to be unsupported even by glibc) */
2344DllExport int
2345win32_gettimeofday(struct timeval *tp, void *not_used)
2346{
6e3b076d
JH		 2347 FT_t ft;
2348
2349 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
2350 GetSystemTimeAsFileTime(&ft.ft_val);
2351
2352 /* seconds since epoch */
2353 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
2354
2355 /* microseconds remaining */
2356 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
2357
2358 return 0;
57ab3dfe
GS		 2359}
2360
2d7a9237 2361DllExport int
b2af26b1
GS		 2362win32_uname(struct utsname *name)
2363{
2364 struct hostent *hep;
2365 STRLEN nodemax = sizeof(name->nodename)-1;
b2af26b1 2366
aeecf691
JD		 2367 /* sysname */
2368 switch (g_osver.dwPlatformId) {
2369 case VER_PLATFORM_WIN32_WINDOWS:
2370 strcpy(name->sysname, "Windows");
2371 break;
2372 case VER_PLATFORM_WIN32_NT:
2373 strcpy(name->sysname, "Windows NT");
2374 break;
2375 case VER_PLATFORM_WIN32s:
2376 strcpy(name->sysname, "Win32s");
2377 break;
2378 default:
2379 strcpy(name->sysname, "Win32 Unknown");
2380 break;
b2af26b1 2381 }
aeecf691
JD		 2382
2383 /* release */
2384 sprintf(name->release, "%d.%d",
2385 g_osver.dwMajorVersion, g_osver.dwMinorVersion);
2386
2387 /* version */
2388 sprintf(name->version, "Build %d",
2389 g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
2390 ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
2391 if (g_osver.szCSDVersion[0]) {
2392 char *buf = name->version + strlen(name->version);
2393 sprintf(buf, " (%s)", g_osver.szCSDVersion);
b2af26b1
GS		 2394 }
2395
2396 /* nodename */
2397 hep = win32_gethostbyname("localhost");
2398 if (hep) {
1604cfb0
MS		 2399 STRLEN len = strlen(hep->h_name);
2400 if (len <= nodemax) {
2401 strcpy(name->nodename, hep->h_name);
2402 }
2403 else {
2404 strncpy(name->nodename, hep->h_name, nodemax);
2405 name->nodename[nodemax] = '\0';
2406 }
b2af26b1
GS		 2407 }
2408 else {
1604cfb0
MS		 2409 DWORD sz = nodemax;
2410 if (!GetComputerName(name->nodename, &sz))
2411 *name->nodename = '\0';
b2af26b1
GS		 2412 }
2413
2414 /* machine (architecture) */
2415 {
1604cfb0
MS		 2416 SYSTEM_INFO info;
2417 DWORD procarch;
2418 char *arch;
2419 GetSystemInfo(&info);
a6c40364 2420
378eeda7 2421#if (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION) && !defined(__MINGW_EXTENSION))
1604cfb0 2422 procarch = info.u.s.wProcessorArchitecture;
a6c40364 2423#else
1604cfb0 2424 procarch = info.wProcessorArchitecture;
a6c40364 2425#endif
1604cfb0
MS		 2426 switch (procarch) {
2427 case PROCESSOR_ARCHITECTURE_INTEL:
2428 arch = "x86"; break;
2429 case PROCESSOR_ARCHITECTURE_IA64:
2430 arch = "ia64"; break;
2431 case PROCESSOR_ARCHITECTURE_AMD64:
2432 arch = "amd64"; break;
2433 case PROCESSOR_ARCHITECTURE_UNKNOWN:
2434 arch = "unknown"; break;
2435 default:
2436 sprintf(name->machine, "unknown(0x%x)", procarch);
2437 arch = name->machine;
2438 break;
2439 }
2440 if (name->machine != arch)
2441 strcpy(name->machine, arch);
b2af26b1
GS		 2442 }
2443 return 0;
2444}
2445
8fb3fcfb
NIS		 2446/* Timing related stuff */
2447
3fadfdf1
NIS		 2448int
2449do_raise(pTHX_ int sig)
2450{
2451 if (sig < SIG_SIZE) {
1604cfb0
MS		 2452 Sighandler_t handler = w32_sighandler[sig];
2453 if (handler == SIG_IGN) {
2454 return 0;
2455 }
2456 else if (handler != SIG_DFL) {
2457 (*handler)(sig);
2458 return 0;
2459 }
2460 else {
2461 /* Choose correct default behaviour */
2462 switch (sig) {
3fadfdf1 2463#ifdef SIGCLD
1604cfb0 2464 case SIGCLD:
3fadfdf1
NIS		 2465#endif
2466#ifdef SIGCHLD
1604cfb0 2467 case SIGCHLD:
3fadfdf1 2468#endif
1604cfb0
MS		 2469 case 0:
2470 return 0;
2471 case SIGTERM:
2472 default:
2473 break;
2474 }
2475 }
3fadfdf1 2476 }
bb0f0a6a 2477 /* Tell caller to exit thread/process as appropriate */
3fadfdf1
NIS		 2478 return 1;
2479}
2480
2481void
2482sig_terminate(pTHX_ int sig)
2483{
2484 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2485 /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2486 thread
2487 */
2488 exit(sig);
2489}
2490
8fb3fcfb
NIS		 2491DllExport int
2492win32_async_check(pTHX)
2493{
2494 MSG msg;
aeecf691
JD		 2495 HWND hwnd = w32_message_hwnd;
2496
099b16d3
RM		 2497 /* Reset w32_poll_count before doing anything else, incase we dispatch
2498 * messages that end up calling back into perl */
aeecf691
JD		 2499 w32_poll_count = 0;
2500
099b16d3
RM		 2501 if (hwnd != INVALID_HANDLE_VALUE) {
2502 /* Passing PeekMessage -1 as HWND (2nd arg) only gets PostThreadMessage() messages
2503 * and ignores window messages - should co-exist better with windows apps e.g. Tk
2504 */
2505 if (hwnd == NULL)
2506 hwnd = (HWND)-1;
2507
2508 while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) ||
2509 PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2510 {
2511 /* re-post a WM_QUIT message (we'll mark it as read later) */
2512 if(msg.message == WM_QUIT) {
2513 PostQuitMessage((int)msg.wParam);
2514 break;
2515 }
8fb3fcfb 2516
099b16d3
RM		 2517 if(!CallMsgFilter(&msg, MSGF_USER))
2518 {
2519 TranslateMessage(&msg);
2520 DispatchMessage(&msg);
aeecf691 2521 }
099b16d3 2522 }
8fb3fcfb
NIS		 2523 }
2524
099b16d3
RM		 2525 /* Call PeekMessage() to mark all pending messages in the queue as "old".
2526 * This is necessary when we are being called by win32_msgwait() to
2527 * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2528 * message over and over. An example how this can happen is when
2529 * Perl is calling win32_waitpid() inside a GUI application and the GUI
2530 * is generating messages before the process terminated.
2531 */
4386d69d 2532 PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
099b16d3 2533
7e5f34c0 2534 /* Above or other stuff may have set a signal flag */
099b16d3
RM		 2535 if (PL_sig_pending)
2536 despatch_signals();
2537
aeecf691 2538 return 1;
8fb3fcfb
NIS		 2539}
2540
089197fa
GS		 2541/* This function will not return until the timeout has elapsed, or until
2542 * one of the handles is ready. */
8fb3fcfb
NIS		 2543DllExport DWORD
2544win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2545{
2546 /* We may need several goes at this - so compute when we stop */
001e9f89
DD		 2547 FT_t ticks = {0};
2548 unsigned __int64 endtime = timeout;
8fb3fcfb 2549 if (timeout != INFINITE) {
1604cfb0
MS		 2550 GetSystemTimeAsFileTime(&ticks.ft_val);
2551 ticks.ft_i64 /= 10000;
2552 endtime += ticks.ft_i64;
001e9f89
DD		 2553 }
2554 /* This was a race condition. Do not let a non INFINITE timeout to
2555 * MsgWaitForMultipleObjects roll under 0 creating a near
2556 * infinity/~(UINT32)0 timeout which will appear as a deadlock to the
2557 * user who did a CORE perl function with a non infinity timeout,
2558 * sleep for example. This is 64 to 32 truncation minefield.
2559 *
2560 * This scenario can only be created if the timespan from the return of
2561 * MsgWaitForMultipleObjects to GetSystemTimeAsFileTime exceeds 1 ms. To
2562 * generate the scenario, manual breakpoints in a C debugger are required,
bb0f0a6a 2563 * or a context switch occurred in win32_async_check in PeekMessage, or random
001e9f89
DD		 2564 * messages are delivered to the *thread* message queue of the Perl thread
2565 * from another process (msctf.dll doing IPC among its instances, VS debugger
2566 * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096].
2567 */
81295a42 2568 while (ticks.ft_i64 <= endtime) {
1604cfb0
MS		 2569 /* if timeout's type is lengthened, remember to split 64b timeout
2570 * into multiple non-infinity runs of MWFMO */
2571 DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE,
2572 (DWORD)(endtime - ticks.ft_i64),
2573 QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE);
2574 if (resultp)
2575 *resultp = result;
2576 if (result == WAIT_TIMEOUT) {
2577 /* Ran out of time - explicit return of zero to avoid -ve if we
2578 have scheduling issues
3fadfdf1 2579 */
1604cfb0
MS		 2580 return 0;
2581 }
2582 if (timeout != INFINITE) {
2583 GetSystemTimeAsFileTime(&ticks.ft_val);
2584 ticks.ft_i64 /= 10000;
2585 }
2586 if (result == WAIT_OBJECT_0 + count) {
2587 /* Message has arrived - check it */
2588 (void)win32_async_check(aTHX);
81295a42
TK		 2589
2590 /* retry */
2591 if (ticks.ft_i64 > endtime)
2592 endtime = ticks.ft_i64;
2593
2594 continue;
1604cfb0
MS		 2595 }
2596 else {
2597 /* Not timeout or message - one of handles is ready */
2598 break;
2599 }
8fb3fcfb 2600 }
8fb3fcfb 2601 /* If we are past the end say zero */
9afd6203 2602 if (!ticks.ft_i64 || ticks.ft_i64 > endtime)
1604cfb0 2603 return 0;
001e9f89
DD		 2604 /* compute time left to wait */
2605 ticks.ft_i64 = endtime - ticks.ft_i64;
9afd6203
SH		 2606 /* if more ms than DWORD, then return max DWORD */
2607 return ticks.ft_i64 <= UINT_MAX ? (DWORD)ticks.ft_i64 : UINT_MAX;
8fb3fcfb
NIS		 2608}
2609
932b7487 2610int
04a2c3d9 2611win32_internal_wait(pTHX_ int *status, DWORD timeout)
932b7487
RC		 2612{
2613 /* XXX this wait emulation only knows about processes
2614 * spawned via win32_spawnvp(P_NOWAIT, ...).
2615 */
932b7487
RC		 2616 int i, retval;
2617 DWORD exitcode, waitcode;
2618
2619#ifdef USE_ITHREADS
2620 if (w32_num_pseudo_children) {
1604cfb0
MS		 2621 win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2622 timeout, &waitcode);
932b7487 2623 /* Time out here if there are no other children to wait for. */
1604cfb0
MS		 2624 if (waitcode == WAIT_TIMEOUT) {
2625 if (!w32_num_children) {
2626 return 0;
2627 }
2628 }
2629 else if (waitcode != WAIT_FAILED) {
2630 if (waitcode >= WAIT_ABANDONED_0
2631 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2632 i = waitcode - WAIT_ABANDONED_0;
2633 else
2634 i = waitcode - WAIT_OBJECT_0;
2635 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2636 *status = (int)((exitcode & 0xff) << 8);
2637 retval = (int)w32_pseudo_child_pids[i];
2638 remove_dead_pseudo_process(i);
2639 return -retval;
2640 }
2641 }
932b7487
RC		 2642 }
2643#endif
2644
2645 if (!w32_num_children) {
1604cfb0
MS		 2646 errno = ECHILD;
2647 return -1;
932b7487
RC		 2648 }
2649
2650 /* if a child exists, wait for it to die */
8fb3fcfb 2651 win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
932b7487 2652 if (waitcode == WAIT_TIMEOUT) {
1604cfb0 2653 return 0;
932b7487
RC		 2654 }
2655 if (waitcode != WAIT_FAILED) {
1604cfb0
MS		 2656 if (waitcode >= WAIT_ABANDONED_0
2657 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2658 i = waitcode - WAIT_ABANDONED_0;
2659 else
2660 i = waitcode - WAIT_OBJECT_0;
2661 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2662 *status = (int)((exitcode & 0xff) << 8);
2663 retval = (int)w32_child_pids[i];
2664 remove_dead_process(i);
2665 return retval;
2666 }
932b7487
RC		 2667 }
2668
932b7487
RC		 2669 errno = GetLastError();
2670 return -1;
2671}
2672
b2af26b1 2673DllExport int
f55ee38a
GS		 2674win32_waitpid(int pid, int *status, int flags)
2675{
acfe0abc 2676 dTHX;
922b1888 2677 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
0aaad0ff 2678 int retval = -1;
c66b022d 2679 long child;
7766f137 2680 if (pid == -1) /* XXX threadid == 1 ? */
1604cfb0 2681 return win32_internal_wait(aTHX_ status, timeout);
7766f137
GS		 2682#ifdef USE_ITHREADS
2683 else if (pid < 0) {
1604cfb0
MS		 2684 child = find_pseudo_pid(aTHX_ -pid);
2685 if (child >= 0) {
2686 HANDLE hThread = w32_pseudo_child_handles[child];
2687 DWORD waitcode;
2688 win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2689 if (waitcode == WAIT_TIMEOUT) {
2690 return 0;
2691 }
2692 else if (waitcode == WAIT_OBJECT_0) {
2693 if (GetExitCodeThread(hThread, &waitcode)) {
2694 *status = (int)((waitcode & 0xff) << 8);
2695 retval = (int)w32_pseudo_child_pids[child];
2696 remove_dead_pseudo_process(child);
2697 return -retval;
2698 }
2699 }
2700 else
2701 errno = ECHILD;
2702 }
7766f137
GS		 2703 }
2704#endif
f55ee38a 2705 else {
1604cfb0
MS		 2706 HANDLE hProcess;
2707 DWORD waitcode;
2708 child = find_pid(aTHX_ pid);
2709 if (child >= 0) {
2710 hProcess = w32_child_handles[child];
2711 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
2712 if (waitcode == WAIT_TIMEOUT) {
2713 return 0;
2714 }
2715 else if (waitcode == WAIT_OBJECT_0) {
2716 if (GetExitCodeProcess(hProcess, &waitcode)) {
2717 *status = (int)((waitcode & 0xff) << 8);
2718 retval = (int)w32_child_pids[child];
2719 remove_dead_process(child);
2720 return retval;
2721 }
2722 }
2723 else
2724 errno = ECHILD;
2725 }
2726 else {
2727 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
2728 if (hProcess) {
2729 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
2730 if (waitcode == WAIT_TIMEOUT) {
48db714f 2731 CloseHandle(hProcess);
1604cfb0
MS		 2732 return 0;
2733 }
2734 else if (waitcode == WAIT_OBJECT_0) {
2735 if (GetExitCodeProcess(hProcess, &waitcode)) {
2736 *status = (int)((waitcode & 0xff) << 8);
2737 CloseHandle(hProcess);
2738 return pid;
2739 }
2740 }
2741 CloseHandle(hProcess);
2742 }
2743 else
2744 errno = ECHILD;
2745 }
f55ee38a 2746 }
3fadfdf1 2747 return retval >= 0 ? pid : retval;
f55ee38a
GS		 2748}
2749
2750DllExport int
2d7a9237
GS		 2751win32_wait(int *status)
2752{
04a2c3d9
DD		 2753 dTHX;
2754 return win32_internal_wait(aTHX_ status, INFINITE);
2d7a9237 2755}
d55594ae 2756
8fb3fcfb
NIS		 2757DllExport unsigned int
2758win32_sleep(unsigned int t)
d55594ae 2759{
acfe0abc 2760 dTHX;
8fb3fcfb 2761 /* Win32 times are in ms so *1000 in and /1000 out */
3b9aea04 2762 if (t > UINT_MAX / 1000) {
1604cfb0
MS		 2763 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
2764 "sleep(%lu) too large", t);
3b9aea04
SH		 2765 }
2766 return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000;
d55594ae
GS		 2767}
2768
bbc9927b
TK		 2769DllExport int
2770win32_pause(void)
2771{
2772 dTHX;
2773 win32_msgwait(aTHX_ 0, NULL, INFINITE, NULL);
2774 return -1;
2775}
2776
f3986ebb
GS		 2777DllExport unsigned int
2778win32_alarm(unsigned int sec)
0a753a76 2779{
3fadfdf1 2780 /*
d55594ae 2781 * the 'obvious' implentation is SetTimer() with a callback
3fadfdf1
NIS		 2782 * which does whatever receiving SIGALRM would do
2783 * we cannot use SIGALRM even via raise() as it is not
d55594ae 2784 * one of the supported codes in <signal.h>
3fadfdf1 2785 */
acfe0abc 2786 dTHX;
aeecf691
JD		 2787
2788 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2789 w32_message_hwnd = win32_create_message_window();
2790
8fb3fcfb 2791 if (sec) {
aeecf691
JD		 2792 if (w32_message_hwnd == NULL)
2793 w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2794 else {
1604cfb0 2795 w32_timerid = 1;
aeecf691
JD		 2796 SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2797 }
8fb3fcfb
NIS		 2798 }
2799 else {
1604cfb0 2800 if (w32_timerid) {
aeecf691 2801 KillTimer(w32_message_hwnd, w32_timerid);
1604cfb0
MS		 2802 w32_timerid = 0;
2803 }
3fadfdf1 2804 }
afe91769 2805 return 0;
0a753a76
PP		 2806}
2807
2d77217b 2808extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
26618a56
GS		 2809
2810DllExport char *
2811win32_crypt(const char *txt, const char *salt)
2812{
acfe0abc 2813 dTHX;
3352bfcb 2814 return des_fcrypt(txt, salt, w32_crypt_buffer);
26618a56 2815}
26618a56 2816
390b85e7
GS		 2817/* simulate flock by locking a range on the file */
2818
390b85e7
GS		 2819#define LK_LEN 0xffff0000
2820
f3986ebb
GS		 2821DllExport int
2822win32_flock(int fd, int oper)
390b85e7
GS		 2823{
2824 OVERLAPPED o;
2825 int i = -1;
2826 HANDLE fh;
2827
2828 fh = (HANDLE)_get_osfhandle(fd);
97b33cac
JD		 2829 if (fh == (HANDLE)-1) /* _get_osfhandle() already sets errno to EBADF */
2830 return -1;
2831
390b85e7
GS		 2832 memset(&o, 0, sizeof(o));
2833
2834 switch(oper) {
2835 case LOCK_SH: /* shared lock */
1604cfb0 2836 if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o))
97b33cac 2837 i = 0;
1604cfb0 2838 break;
390b85e7 2839 case LOCK_EX: /* exclusive lock */
1604cfb0 2840 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o))
97b33cac 2841 i = 0;
1604cfb0 2842 break;
390b85e7 2843 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
1604cfb0 2844 if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o))
97b33cac 2845 i = 0;
1604cfb0 2846 break;
390b85e7 2847 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
1604cfb0
MS		 2848 if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2849 0, LK_LEN, 0, &o))
97b33cac 2850 i = 0;
1604cfb0 2851 break;
390b85e7 2852 case LOCK_UN: /* unlock lock */
1604cfb0 2853 if (UnlockFileEx(fh, 0, LK_LEN, 0, &o))
97b33cac 2854 i = 0;
1604cfb0 2855 break;
390b85e7 2856 default: /* unknown */
1604cfb0
MS		 2857 errno = EINVAL;
2858 return -1;
97b33cac
JD		 2859 }
2860 if (i == -1) {
2861 if (GetLastError() == ERROR_LOCK_VIOLATION)
b0ba2190 2862 errno = EWOULDBLOCK;
97b33cac
JD		 2863 else
2864 errno = EINVAL;
390b85e7
GS		 2865 }
2866 return i;
2867}
2868
390b85e7
GS		 2869#undef LK_LEN
2870
cd6a3131
SH		 2871extern int convert_wsa_error_to_errno(int wsaerr); /* in win32sck.c */
2872
c9beaf97
SH		 2873/* Get the errno value corresponding to the given err. This function is not
2874 * intended to handle conversion of general GetLastError() codes. It only exists
2875 * to translate Windows sockets error codes from WSAGetLastError(). Such codes
2876 * used to be assigned to errno/$! in earlier versions of perl; this function is
2877 * used to catch any old Perl code which is still trying to assign such values
2878 * to $! and convert them to errno values instead.
2879 */
2880int
2881win32_get_errno(int err)
2882{
2883 return convert_wsa_error_to_errno(err);
2884}
2885
68dc0745
PP		 2886/*
2887 * redirected io subsystem for all XS modules
2888 *
2889 */
0a753a76 2890
68dc0745
PP		 2891DllExport int *
2892win32_errno(void)
0a753a76 2893{
390b85e7 2894 return (&errno);
0a753a76
PP		 2895}
2896
dcb2879a
GS		 2897DllExport char ***
2898win32_environ(void)
2899{
390b85e7 2900 return (&(_environ));
dcb2879a
GS		 2901}
2902
68dc0745
PP		 2903/* the rest are the remapped stdio routines */
2904DllExport FILE *
2905win32_stderr(void)
0a753a76 2906{
390b85e7 2907 return (stderr);
0a753a76
PP		 2908}
2909
68dc0745
PP		 2910DllExport FILE *
2911win32_stdin(void)
0a753a76 2912{
390b85e7 2913 return (stdin);
0a753a76
PP		 2914}
2915
68dc0745 2916DllExport FILE *
0934c9d9 2917win32_stdout(void)
0a753a76 2918{
390b85e7 2919 return (stdout);
0a753a76
PP		 2920}
2921
68dc0745
PP		 2922DllExport int
2923win32_ferror(FILE *fp)
0a753a76 2924{
390b85e7 2925 return (ferror(fp));
0a753a76
PP		 2926}
2927
2928
68dc0745
PP		 2929DllExport int
2930win32_feof(FILE *fp)
0a753a76 2931{
390b85e7 2932 return (feof(fp));
0a753a76
PP		 2933}
2934
e85fa3eb 2935#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
cd6a3131 2936extern int convert_errno_to_wsa_error(int err); /* in win32sck.c */
e85fa3eb 2937#endif
cd6a3131 2938
68dc0745 2939/*
3fadfdf1 2940 * Since the errors returned by the socket error function
68dc0745 2941 * WSAGetLastError() are not known by the library routine strerror
cd6a3131
SH		 2942 * we have to roll our own to cover the case of socket errors
2943 * that could not be converted to regular errno values by
2944 * get_last_socket_error() in win32/win32sck.c.
68dc0745 2945 */
0a753a76 2946
68dc0745 2947DllExport char *
3fadfdf1 2948win32_strerror(int e)
0a753a76 2949{
378eeda7 2950#if !defined __MINGW32__ /* compiler intolerance */
68dc0745 2951 extern int sys_nerr;
3e3baf6d 2952#endif
0a753a76 2953
9404a519 2954 if (e < 0 || e > sys_nerr) {
9399a70c 2955 dTHXa(NULL);
1604cfb0
MS		 2956 if (e < 0)
2957 e = GetLastError();
e85fa3eb 2958#ifdef ERRNO_HAS_POSIX_SUPPLEMENT
1604cfb0
MS		 2959 /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno
2960 * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but
2961 * sys_nerr is still 43 and strerror() returns "Unknown error" for them.
2962 * We must therefore still roll our own messages for these codes, and
2963 * additionally map them to corresponding Windows (sockets) error codes
2964 * first to avoid getting the wrong system message.
2965 */
2966 else if (inRANGE(e, EADDRINUSE, EWOULDBLOCK)) {
2967 e = convert_errno_to_wsa_error(e);
2968 }
cd6a3131 2969#endif
0a753a76 2970
1604cfb0
MS		 2971 aTHXa(PERL_GET_THX);
2972 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
364d54ba 2973 |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
1604cfb0 2974 w32_strerror_buffer, sizeof(w32_strerror_buffer),
364d54ba
JD		 2975 NULL) == 0)
2976 {
1604cfb0 2977 strcpy(w32_strerror_buffer, "Unknown Error");
364d54ba 2978 }
1604cfb0 2979 return w32_strerror_buffer;
68dc0745 2980 }
364d54ba 2981#undef strerror
390b85e7 2982 return strerror(e);
364d54ba 2983#define strerror win32_strerror
0a753a76
PP		 2984}
2985
22fae026 2986DllExport void
c5be433b 2987win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM		 2988{
2989 DWORD dwLen;
2990 char *sMsg;
2991 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
1604cfb0
MS		 2992 |FORMAT_MESSAGE_IGNORE_INSERTS
2993 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2994 dwErr, 0, (char *)&sMsg, 1, NULL);
2ce77adf 2995 /* strip trailing whitespace and period */
22fae026 2996 if (0 < dwLen) {
1604cfb0
MS		 2997 do {
2998 --dwLen; /* dwLen doesn't include trailing null */
2999 } while (0 < dwLen && isSPACE(sMsg[dwLen]));
3000 if ('.' != sMsg[dwLen])
3001 dwLen++;
3002 sMsg[dwLen] = '\0';
22fae026
TM		 3003 }
3004 if (0 == dwLen) {
1604cfb0
MS		 3005 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
3006 if (sMsg)
3007 dwLen = sprintf(sMsg,
3008 "Unknown error #0x%lX (lookup 0x%lX)",
3009 dwErr, GetLastError());
db7c17d7
GS		 3010 }
3011 if (sMsg) {
1604cfb0
MS		 3012 dTHX;
3013 sv_setpvn((SV*)sv, sMsg, dwLen);
3014 LocalFree(sMsg);
22fae026 3015 }
22fae026
TM		 3016}
3017
68dc0745
PP		 3018DllExport int
3019win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 3020{
68dc0745
PP		 3021 va_list marker;
3022 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 3023
390b85e7 3024 return (vfprintf(fp, format, marker));
0a753a76
PP		 3025}
3026
68dc0745
PP		 3027DllExport int
3028win32_printf(const char *format, ...)
0a753a76 3029{
68dc0745
PP		 3030 va_list marker;
3031 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 3032
390b85e7 3033 return (vprintf(format, marker));
0a753a76
PP		 3034}
3035
68dc0745
PP		 3036DllExport int
3037win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 3038{
390b85e7 3039 return (vfprintf(fp, format, args));
0a753a76
PP		 3040}
3041
96e4d5b1
PP		 3042DllExport int
3043win32_vprintf(const char *format, va_list args)
3044{
390b85e7 3045 return (vprintf(format, args));
96e4d5b1
PP		 3046}
3047
68dc0745
PP		 3048DllExport size_t
3049win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 3050{
390b85e7 3051 return fread(buf, size, count, fp);
0a753a76
PP		 3052}
3053
68dc0745
PP		 3054DllExport size_t
3055win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 3056{
390b85e7 3057 return fwrite(buf, size, count, fp);
0a753a76
PP		 3058}
3059
7fac1903
GS		 3060#define MODE_SIZE 10
3061
68dc0745
PP		 3062DllExport FILE *
3063win32_fopen(const char *filename, const char *mode)
0a753a76 3064{
04a2c3d9 3065 dTHXa(NULL);
1c5905c2 3066 FILE *f;
3fadfdf1 3067
c5be433b 3068 if (!*filename)
1604cfb0 3069 return NULL;
c5be433b 3070
68dc0745 3071 if (stricmp(filename, "/dev/null")==0)
1604cfb0 3072 filename = "NUL";
7fac1903 3073
04a2c3d9 3074 aTHXa(PERL_GET_THX);
8c56068e 3075 f = fopen(PerlDir_mapA(filename), mode);
1c5905c2
GS		 3076 /* avoid buffering headaches for child processes */
3077 if (f && *mode == 'a')
1604cfb0 3078 win32_fseek(f, 0, SEEK_END);
1c5905c2 3079 return f;
0a753a76
PP		 3080}
3081
68dc0745 3082DllExport FILE *
7fac1903 3083win32_fdopen(int handle, const char *mode)
0a753a76 3084{
1c5905c2 3085 FILE *f;
8c56068e 3086 f = fdopen(handle, (char *) mode);
1c5905c2
GS		 3087 /* avoid buffering headaches for child processes */
3088 if (f && *mode == 'a')
1604cfb0 3089 win32_fseek(f, 0, SEEK_END);
1c5905c2 3090 return f;
0a753a76
PP		 3091}
3092
68dc0745 3093DllExport FILE *
7fac1903 3094win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 3095{
04a2c3d9 3096 dTHXa(NULL);
68dc0745 3097 if (stricmp(path, "/dev/null")==0)
1604cfb0 3098 path = "NUL";
7fac1903 3099
04a2c3d9 3100 aTHXa(PERL_GET_THX);
7766f137 3101 return freopen(PerlDir_mapA(path), mode, stream);
0a753a76
PP		 3102}
3103
68dc0745
PP		 3104DllExport int
3105win32_fclose(FILE *pf)
0a753a76 3106{
19253ae6
DD		 3107#ifdef WIN32_NO_SOCKETS
3108 return fclose(pf);
3109#else
f3986ebb 3110 return my_fclose(pf); /* defined in win32sck.c */
19253ae6 3111#endif
0a753a76
PP		 3112}
3113
68dc0745
PP		 3114DllExport int
3115win32_fputs(const char *s,FILE *pf)
0a753a76 3116{
390b85e7 3117 return fputs(s, pf);
0a753a76
PP		 3118}
3119
68dc0745
PP		 3120DllExport int
3121win32_fputc(int c,FILE *pf)
0a753a76 3122{
390b85e7 3123 return fputc(c,pf);
0a753a76
PP		 3124}
3125
68dc0745
PP		 3126DllExport int
3127win32_ungetc(int c,FILE *pf)
0a753a76 3128{
390b85e7 3129 return ungetc(c,pf);
0a753a76
PP		 3130}
3131
68dc0745
PP		 3132DllExport int
3133win32_getc(FILE *pf)
0a753a76 3134{
390b85e7 3135 return getc(pf);
0a753a76
PP		 3136}
3137
68dc0745
PP		 3138DllExport int
3139win32_fileno(FILE *pf)
0a753a76 3140{
390b85e7 3141 return fileno(pf);
0a753a76
PP		 3142}
3143
68dc0745
PP		 3144DllExport void
3145win32_clearerr(FILE *pf)
0a753a76 3146{
390b85e7 3147 clearerr(pf);
68dc0745 3148 return;
0a753a76
PP		 3149}
3150
68dc0745
PP		 3151DllExport int
3152win32_fflush(FILE *pf)
0a753a76 3153{
390b85e7 3154 return fflush(pf);
0a753a76
PP		 3155}
3156
c623ac67 3157DllExport Off_t
68dc0745 3158win32_ftell(FILE *pf)
0a753a76 3159{
c623ac67
GS		 3160 fpos_t pos;
3161 if (fgetpos(pf, &pos))
1604cfb0 3162 return -1;
c623ac67 3163 return (Off_t)pos;
0a753a76
PP		 3164}
3165
68dc0745 3166DllExport int
c623ac67 3167win32_fseek(FILE *pf, Off_t offset,int origin)
0a753a76 3168{
c623ac67
GS		 3169 fpos_t pos;
3170 switch (origin) {
3171 case SEEK_CUR:
1604cfb0
MS		 3172 if (fgetpos(pf, &pos))
3173 return -1;
3174 offset += pos;
3175 break;
c623ac67 3176 case SEEK_END:
1604cfb0
MS		 3177 fseek(pf, 0, SEEK_END);
3178 pos = _telli64(fileno(pf));
3179 offset += pos;
3180 break;
c623ac67 3181 case SEEK_SET:
1604cfb0 3182 break;
c623ac67 3183 default:
1604cfb0
MS		 3184 errno = EINVAL;
3185 return -1;
c623ac67
GS		 3186 }
3187 return fsetpos(pf, &offset);
0a753a76
PP		 3188}
3189
68dc0745
PP		 3190DllExport int
3191win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 3192{
390b85e7 3193 return fgetpos(pf, p);
0a753a76
PP		 3194}
3195
68dc0745
PP		 3196DllExport int
3197win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 3198{
390b85e7 3199 return fsetpos(pf, p);
0a753a76
PP		 3200}
3201
68dc0745
PP		 3202DllExport void
3203win32_rewind(FILE *pf)
0a753a76 3204{
390b85e7 3205 rewind(pf);
68dc0745 3206 return;
0a753a76
PP		 3207}
3208
2941a2e1
JH		 3209DllExport int
3210win32_tmpfd(void)
0a753a76 3211{
04247234
TC		 3212 return win32_tmpfd_mode(0);
3213}
3214
3215DllExport int
3216win32_tmpfd_mode(int mode)
3217{
b3122bc4
JH		 3218 char prefix[MAX_PATH+1];
3219 char filename[MAX_PATH+1];
3220 DWORD len = GetTempPath(MAX_PATH, prefix);
04247234
TC		 3221 mode &= ~( O_ACCMODE | O_CREAT | O_EXCL );
3222 mode |= O_RDWR;
b3122bc4 3223 if (len && len < MAX_PATH) {
1604cfb0
MS		 3224 if (GetTempFileName(prefix, "plx", 0, filename)) {
3225 HANDLE fh = CreateFile(filename,
3226 DELETE | GENERIC_READ | GENERIC_WRITE,
3227 0,
3228 NULL,
3229 CREATE_ALWAYS,
3230 FILE_ATTRIBUTE_NORMAL
3231 | FILE_FLAG_DELETE_ON_CLOSE,
3232 NULL);
3233 if (fh != INVALID_HANDLE_VALUE) {
3234 int fd = win32_open_osfhandle((intptr_t)fh, mode);
3235 if (fd >= 0) {
3236 PERL_DEB(dTHX;)
3237 DEBUG_p(PerlIO_printf(Perl_debug_log,
3238 "Created tmpfile=%s\n",filename));
3239 return fd;
3240 }
3241 }
3242 }
b3122bc4 3243 }
2941a2e1
JH		 3244 return -1;
3245}
3246
3247DllExport FILE*
3248win32_tmpfile(void)
3249{
3250 int fd = win32_tmpfd();
3251 if (fd >= 0)
1604cfb0 3252 return win32_fdopen(fd, "w+b");
b3122bc4 3253 return NULL;
0a753a76
PP		 3254}
3255
68dc0745
PP		 3256DllExport void
3257win32_abort(void)
0a753a76 3258{
390b85e7 3259 abort();
68dc0745 3260 return;
0a753a76
PP		 3261}
3262
68dc0745 3263DllExport int
c623ac67 3264win32_fstat(int fd, Stat_t *sbufptr)
0a753a76 3265{
e935ef33
TC		 3266 HANDLE handle = (HANDLE)win32_get_osfhandle(fd);
3267
3268 return win32_stat_low(handle, NULL, 0, sbufptr);
0a753a76
PP		 3269}
3270
68dc0745
PP		 3271DllExport int
3272win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 3273{
390b85e7 3274 return _pipe(pfd, size, mode);
0a753a76
PP		 3275}
3276
8c0134a8
NIS		 3277DllExport PerlIO*
3278win32_popenlist(const char *mode, IV narg, SV **args)
3279{
aac983ac 3280 get_shell();
8c0134a8 3281
aac983ac
TC		 3282 return do_popen(mode, NULL, narg, args);
3283}
50892819 3284
aac983ac
TC		 3285STATIC PerlIO*
3286do_popen(const char *mode, const char *command, IV narg, SV **args) {
50892819 3287 int p[2];
f06c8825 3288 int handles[3];
50892819 3289 int parent, child;
c161da64 3290 int stdfd;
50892819
GS		 3291 int ourmode;
3292 int childpid;
1095be37 3293 DWORD nhandle;
1095be37 3294 int lock_held = 0;
aac983ac 3295 const char **args_pvs = NULL;
50892819
GS		 3296
3297 /* establish which ends read and write */
3298 if (strchr(mode,'w')) {
3299 stdfd = 0; /* stdin */
3300 parent = 1;
3301 child = 0;
1604cfb0 3302 nhandle = STD_INPUT_HANDLE;
50892819
GS		 3303 }
3304 else if (strchr(mode,'r')) {
3305 stdfd = 1; /* stdout */
3306 parent = 0;
3307 child = 1;
1604cfb0 3308 nhandle = STD_OUTPUT_HANDLE;
50892819
GS		 3309 }
3310 else
3311 return NULL;
3312
3313 /* set the correct mode */
3314 if (strchr(mode,'b'))
3315 ourmode = O_BINARY;
3316 else if (strchr(mode,'t'))
3317 ourmode = O_TEXT;
3318 else
3319 ourmode = _fmode & (O_TEXT | O_BINARY);
3320
3321 /* the child doesn't inherit handles */
3322 ourmode |= O_NOINHERIT;
3323
1095be37 3324 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS		 3325 return NULL;
3326
f06c8825
TC		 3327 /* Previously this code redirected stdin/out temporarily so the
3328 child process inherited those handles, this caused race
3329 conditions when another thread was writing/reading those
3330 handles.
498d7dc4 3331
f06c8825
TC		 3332 To avoid that we just feed the handles to CreateProcess() so
3333 the handles are redirected only in the child.
3334 */
3335 handles[child] = p[child];
3336 handles[parent] = -1;
3337 handles[2] = -1;
564914cd 3338
f06c8825 3339 /* CreateProcess() requires inheritable handles */
c161da64 3340 if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT,
1604cfb0 3341 HANDLE_FLAG_INHERIT)) {
50892819 3342 goto cleanup;
f06c8825 3343 }
1095be37 3344
50892819 3345 /* start the child */
4f63d024 3346 {
1604cfb0 3347 dTHX;
aac983ac 3348
1604cfb0
MS		 3349 if (command) {
3350 if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
3351 goto cleanup;
aac983ac 3352
1604cfb0
MS		 3353 }
3354 else {
3355 int i;
3356 const char *exe_name;
3357
3358 Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
3359 SAVEFREEPV(args_pvs);
3360 for (i = 0; i < narg; ++i)
3361 args_pvs[i] = SvPV_nolen(args[i]);
3362 args_pvs[i] = NULL;
3363 exe_name = qualified_path(args_pvs[0], TRUE);
3364 if (!exe_name)
3365 /* let CreateProcess() try to find it instead */
3366 exe_name = args_pvs[0];
3367
3368 if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) {
3369 goto cleanup;
3370 }
3371 }
498d7dc4 3372
1604cfb0 3373 win32_close(p[child]);
1095be37 3374
1604cfb0 3375 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1 3376
1604cfb0
MS		 3377 /* set process id so that it can be returned by perl's open() */
3378 PL_forkprocess = childpid;
4f63d024 3379 }
50892819
GS		 3380
3381 /* we have an fd, return a file stream */
00b02797 3382 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS		 3383
3384cleanup:
3385 /* we don't need to check for errors here */
3386 win32_close(p[0]);
3387 win32_close(p[1]);
f06c8825 3388
50892819 3389 return (NULL);
aac983ac
TC		 3390}
3391
3392/*
3393 * a popen() clone that respects PERL5SHELL
3394 *
3395 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
3396 */
50892819 3397
aac983ac
TC		 3398DllExport PerlIO*
3399win32_popen(const char *command, const char *mode)
3400{
3401#ifdef USE_RTL_POPEN
3402 return _popen(command, mode);
3403#else
3404 return do_popen(mode, command, 0, NULL);
4b556e6c 3405#endif /* USE_RTL_POPEN */
0a753a76
PP		 3406}
3407
50892819
GS		 3408/*
3409 * pclose() clone
3410 */
3411
68dc0745 3412DllExport int
00b02797 3413win32_pclose(PerlIO *pf)
0a753a76 3414{
4b556e6c 3415#ifdef USE_RTL_POPEN
390b85e7 3416 return _pclose(pf);
50892819 3417#else
acfe0abc 3418 dTHX;
e17cb2a9
JD		 3419 int childpid, status;
3420 SV *sv;
3421
00b02797 3422 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3423
e17cb2a9 3424 if (SvIOK(sv))
1604cfb0 3425 childpid = SvIVX(sv);
e17cb2a9 3426 else
1604cfb0 3427 childpid = 0;
50892819
GS		 3428
3429 if (!childpid) {
1604cfb0 3430 errno = EBADF;
50892819
GS		 3431 return -1;
3432 }
3433
00b02797
JH		 3434#ifdef USE_PERLIO
3435 PerlIO_close(pf);
3436#else
3437 fclose(pf);
3438#endif
e17cb2a9
JD		 3439 SvIVX(sv) = 0;
3440
0aaad0ff
GS		 3441 if (win32_waitpid(childpid, &status, 0) == -1)
3442 return -1;
50892819 3443
0aaad0ff 3444 return status;
50892819 3445
4b556e6c 3446#endif /* USE_RTL_POPEN */
0a753a76 3447}
6b980173 3448
6b980173
JD		 3449DllExport int
3450win32_link(const char *oldname, const char *newname)
3451{
04a2c3d9 3452 dTHXa(NULL);
82867ecf
GS		 3453 WCHAR wOldName[MAX_PATH+1];
3454 WCHAR wNewName[MAX_PATH+1];
6b980173 3455
8c56068e
JD		 3456 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3457 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
1604cfb0 3458 ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
8cbe99e5 3459 CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173 3460 {
1604cfb0 3461 return 0;
6b980173 3462 }
680b2c5e
TC		 3463 translate_to_errno();
3464 return -1;
3465}
2b42d7ed 3466
7c046514
TC		 3467typedef BOOLEAN (__stdcall *pCreateSymbolicLinkA_t)(LPCSTR, LPCSTR, DWORD);
3468
3469#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY
3470# define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1
3471#endif
3472
680b2c5e
TC		 3473#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
3474# define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2
3475#endif
3476
3477DllExport int
3478win32_symlink(const char *oldfile, const char *newfile)
3479{
3480 dTHX;
680b2c5e 3481 size_t oldfile_len = strlen(oldfile);
7c046514
TC		 3482 pCreateSymbolicLinkA_t pCreateSymbolicLinkA =
3483 (pCreateSymbolicLinkA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateSymbolicLinkA");
17ab6b63
TC		 3484 DWORD create_flags = 0;
3485
3486 /* this flag can be used only on Windows 10 1703 or newer */
3487 if (g_osver.dwMajorVersion > 10 ||
3488 (g_osver.dwMajorVersion == 10 &&
3489 (g_osver.dwMinorVersion > 0 || g_osver.dwBuildNumber > 15063)))
3490 {
3491 create_flags |= SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE;
3492 }
680b2c5e 3493
7c046514
TC		 3494 if (!pCreateSymbolicLinkA) {
3495 errno = ENOSYS;
3496 return -1;
3497 }
3498
680b2c5e
TC		 3499 /* oldfile might be relative and we don't want to change that,
3500 so don't map that.
2b42d7ed 3501 */
680b2c5e
TC		 3502 newfile = PerlDir_mapA(newfile);
3503
3504 /* are we linking to a directory?
3505 CreateSymlinkA() needs to know if the target is a directory,
a2e9e863
TC		 3506 If it looks like a directory name:
3507 - ends in slash
3508 - is just . or ..
3509 - ends in /. or /.. (with either slash)
3510 - is a simple drive letter
3511 assume it's a directory.
3512
3513 Otherwise if the oldfile is relative we need to make a relative path
3514 based on the newfile to check if the target is a directory.
680b2c5e 3515 */
a2e9e863
TC		 3516 if ((oldfile_len >= 1 && isSLASH(oldfile[oldfile_len-1])) ||
3517 strEQ(oldfile, "..") ||
3518 strEQ(oldfile, ".") ||
3519 (isSLASH(oldfile[oldfile_len-2]) && oldfile[oldfile_len-1] == '.') ||
3520 strEQ(oldfile+oldfile_len-3, "\\..") ||
3521 strEQ(oldfile+oldfile_len-3, "/..") ||
3522 (oldfile_len == 2 && oldfile[1] == ':')) {
3523 create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY;
3524 }
0d2c9baa
TC		 3525 else {
3526 DWORD dest_attr;
3527 const char *dest_path = oldfile;
3528 char szTargetName[MAX_PATH+1];
680b2c5e 3529
0d2c9baa
TC		 3530 if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') {
3531 /* relative to current directory on a drive */
3532 /* dest_path = oldfile; already done */
680b2c5e 3533 }
0d2c9baa
TC		 3534 else if (oldfile[0] != '\\' && oldfile[0] != '/') {
3535 size_t newfile_len = strlen(newfile);
3536 char *last_slash = strrchr(newfile, '/');
3537 char *last_bslash = strrchr(newfile, '\\');
3538 char *end_dir = last_slash && last_bslash
3539 ? ( last_slash > last_bslash ? last_slash : last_bslash)
3540 : last_slash ? last_slash : last_bslash ? last_bslash : NULL;
3541
3542 if (end_dir) {
3543 if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) {
3544 /* too long */
3545 errno = EINVAL;
3546 return -1;
3547 }
3548
3549 memcpy(szTargetName, newfile, end_dir - newfile + 1);
3550 strcpy(szTargetName + (end_dir - newfile + 1), oldfile);
3551 dest_path = szTargetName;
3552 }
3553 else {
3554 /* newpath is just a filename */
3555 /* dest_path = oldfile; */
3556 }
680b2c5e 3557 }
680b2c5e 3558
0d2c9baa
TC		 3559 dest_attr = GetFileAttributes(dest_path);
3560 if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) {
3561 create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY;
3562 }
a2e9e863 3563 }
680b2c5e 3564
7c046514 3565 if (!pCreateSymbolicLinkA(newfile, oldfile, create_flags)) {
680b2c5e
TC		 3566 translate_to_errno();
3567 return -1;
3568 }
3569
3570 return 0;
6b980173 3571}
0a753a76 3572
68dc0745 3573DllExport int
8d9b2e3c 3574win32_rename(const char *oname, const char *newname)
e24c7c18 3575{
65cb15a1 3576 char szOldName[MAX_PATH+1];
7fac1903 3577 BOOL bResult;
8cbe99e5 3578 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
acfe0abc 3579 dTHX;
65cb15a1 3580
8cbe99e5
JD		 3581 if (stricmp(newname, oname))
3582 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3583 strcpy(szOldName, PerlDir_mapA(oname));
3584
3585 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3586 if (!bResult) {
3587 DWORD err = GetLastError();
3588 switch (err) {
3589 case ERROR_BAD_NET_NAME:
3590 case ERROR_BAD_NETPATH:
3591 case ERROR_BAD_PATHNAME:
3592 case ERROR_FILE_NOT_FOUND:
3593 case ERROR_FILENAME_EXCED_RANGE:
3594 case ERROR_INVALID_DRIVE:
3595 case ERROR_NO_MORE_FILES:
3596 case ERROR_PATH_NOT_FOUND:
3597 errno = ENOENT;
3598 break;
e41416c3
CM		 3599 case ERROR_DISK_FULL:
3600 errno = ENOSPC;
3601 break;
3602 case ERROR_NOT_ENOUGH_QUOTA:
3603 errno = EDQUOT;
3604 break;
8cbe99e5
JD		 3605 default:
3606 errno = EACCES;
3607 break;
3608 }
3609 return -1;
e24c7c18 3610 }
8cbe99e5 3611 return 0;
e24c7c18
GS		 3612}
3613
3614DllExport int
68dc0745 3615win32_setmode(int fd, int mode)
0a753a76 3616{
390b85e7 3617 return setmode(fd, mode);
0a753a76
PP		 3618}
3619
4a9d6100
GS		 3620DllExport int
3621win32_chsize(int fd, Off_t size)
3622{
4a9d6100
GS		 3623 int retval = 0;
3624 Off_t cur, end, extend;
3625
3626 cur = win32_tell(fd);
3627 if (cur < 0)
1604cfb0 3628 return -1;
4a9d6100
GS		 3629 end = win32_lseek(fd, 0, SEEK_END);
3630 if (end < 0)
1604cfb0 3631 return -1;
4a9d6100
GS		 3632