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