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