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