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