This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Rename "perl59" to "perl510"
[perl5.git] / win32 / win32.c
CommitLineData
68dc0745 1/* WIN32.C
2 *
3fadfdf1 3 * (c) 1995 Microsoft Corporation. All rights reserved.
68dc0745 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 11#define WIN32_LEAN_AND_MEAN
12#define WIN32IO_IS_STDIO
13#include <tchar.h>
a835ef8a
NIS		 14#ifdef __GNUC__
15#define Win32_Winsock
16#endif
0a753a76 17#include <windows.h>
aeecf691
JD		 18#ifndef HWND_MESSAGE
19# define HWND_MESSAGE ((HWND)-3)
20#endif
35cf1ab6 21#ifndef WC_NO_BEST_FIT_CHARS
3839a0fa 22# define WC_NO_BEST_FIT_CHARS 0x00000400 /* requires Windows 2000 or later */
35cf1ab6 23#endif
5db10396 24#include <winnt.h>
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 55#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
56#define PerlIO FILE
57#endif
58
7a9ec5a3 59#include <sys/stat.h>
0a753a76 60#include "EXTERN.h"
61#include "perl.h"
c69f6586
GS		 62
63#define NO_XSLOCKS
c5be433b 64#define PERL_NO_GET_CONTEXT
ad2e33dc 65#include "XSUB.h"
c69f6586
GS		 66
67#include "Win32iop.h"
0a753a76 68#include <fcntl.h>
5b0d9cbe
NIS		 69#ifndef __GNUC__
70/* assert.h conflicts with #define of assert in perl.h */
0a753a76 71#include <assert.h>
5b0d9cbe 72#endif
0a753a76 73#include <string.h>
74#include <stdarg.h>
ad2e33dc 75#include <float.h>
ad0751ec 76#include <time.h>
3730b96e 77#if defined(_MSC_VER) || defined(__MINGW32__)
ad0751ec
GS		 78#include <sys/utime.h>
79#else
80#include <utime.h>
81#endif
5b0d9cbe 82#ifdef __GNUC__
3fadfdf1 83/* Mingw32 defaults to globing command line
5b0d9cbe
NIS		 84 * So we turn it off like this:
85 */
86int _CRT_glob = 0;
87#endif
88
7c5b6093
AB		 89#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
90/* Mingw32-1.1 is missing some prototypes */
d06fc7d4 91START_EXTERN_C
f8fb7c90
GS		 92FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
93FILE * _wfdopen(int nFd, LPCWSTR wszMode);
94FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
95int _flushall();
96int _fcloseall();
d06fc7d4 97END_EXTERN_C
2b260de0
GS		 98#endif
99
100#if defined(__BORLANDC__)
0b94c7bb
GS		 101# define _stat stat
102# define _utimbuf utimbuf
103#endif
104
6890e559
GS		 105#define EXECF_EXEC 1
106#define EXECF_SPAWN 2
107#define EXECF_SPAWN_NOWAIT 3
108
32e30700
GS		 109#if defined(PERL_IMPLICIT_SYS)
110# undef win32_get_privlib
111# define win32_get_privlib g_win32_get_privlib
112# undef win32_get_sitelib
113# define win32_get_sitelib g_win32_get_sitelib
4ea817c6
GS		 114# undef win32_get_vendorlib
115# define win32_get_vendorlib g_win32_get_vendorlib
32e30700
GS		 116# undef getlogin
117# define getlogin g_getlogin
118#endif
119
ce1da67e 120static void get_shell(void);
dff6d3cd 121static long tokenize(const char *str, char **dest, char ***destv);
08039b81
SH		 122static int do_spawn2(pTHX_ const char *cmd, int exectype);
123static BOOL has_shell_metachars(const char *ptr);
2d7a9237 124static long filetime_to_clock(PFILETIME ft);
ad0751ec 125static BOOL filetime_from_time(PFILETIME ft, time_t t);
c5be433b 126static char * get_emd_part(SV **leading, char *trailing, ...);
0aaad0ff
GS		 127static void remove_dead_process(long deceased);
128static long find_pid(int pid);
129static char * qualified_path(const char *cmd);
4ea817c6
GS		 130static char * win32_get_xlib(const char *pl, const char *xlib,
131 const char *libname);
132
7766f137
GS		 133#ifdef USE_ITHREADS
134static void remove_dead_pseudo_process(long child);
135static long find_pseudo_pid(int pid);
136#endif
c69f6586 137
7766f137 138START_EXTERN_C
2d7a9237 139HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
8ac9c18d 140char w32_module_name[MAX_PATH+1];
7766f137
GS		 141END_EXTERN_C
142
aeecf691 143static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
50892819 144
542cb85f
JD		 145static HANDLE (WINAPI *pfnCreateToolhelp32Snapshot)(DWORD, DWORD) = NULL;
146static BOOL (WINAPI *pfnProcess32First)(HANDLE, PROCESSENTRY32*) = NULL;
147static BOOL (WINAPI *pfnProcess32Next)(HANDLE, PROCESSENTRY32*) = NULL;
148static LONG (WINAPI *pfnZwQuerySystemInformation)(UINT, PVOID, ULONG, PULONG);
149
3a00b83e
SH		 150#ifdef __BORLANDC__
151/* Silence STDERR grumblings from Borland's math library. */
152DllExport int
153_matherr(struct _exception *a)
154{
155 PERL_UNUSED_VAR(a);
156 return 1;
157}
158#endif
159
58d049f0
JD		 160/* VS2005 (MSC version 14) provides a mechanism to set an invalid
161 * parameter handler. This functionality is not available in the
162 * 64-bit compiler from the Platform SDK, which unfortunately also
163 * believes itself to be MSC version 14.
164 *
165 * There is no #define related to _set_invalid_parameter_handler(),
166 * but we can check for one of the constants defined for
167 * _set_abort_behavior(), which was introduced into stdlib.h at
168 * the same time.
169 */
170
171#if _MSC_VER >= 1400 && defined(_WRITE_ABORT_MSG)
172# define SET_INVALID_PARAMETER_HANDLER
173#endif
174
175#ifdef SET_INVALID_PARAMETER_HANDLER
0448a0bd
SH		 176void my_invalid_parameter_handler(const wchar_t* expression,
177 const wchar_t* function,
178 const wchar_t* file,
179 unsigned int line,
180 uintptr_t pReserved)
181{
182# ifdef _DEBUG
183 wprintf(L"Invalid parameter detected in function %s."
184 L" File: %s Line: %d\n", function, file, line);
185 wprintf(L"Expression: %s\n", expression);
186# endif
187}
188#endif
189
3fadfdf1 190int
ba106d47
GS		 191IsWin95(void)
192{
aeecf691 193 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
3fe9a6f1 194}
195
196int
ba106d47
GS		 197IsWinNT(void)
198{
aeecf691 199 return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
3fe9a6f1 200}
0a753a76 201
3839a0fa
JD		 202int
203IsWin2000(void)
204{
205 return (g_osver.dwMajorVersion > 4);
206}
207
2fa86c13
GS		 208EXTERN_C void
209set_w32_module_name(void)
210{
aa2b96ec 211 /* this function may be called at DLL_PROCESS_ATTACH time */
2fa86c13 212 char* ptr;
aa2b96ec
JD		 213 HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
214 ? GetModuleHandle(NULL)
215 : w32_perldll_handle);
2fa86c13 216
aa2b96ec
JD		 217 OSVERSIONINFO osver; /* g_osver may not yet be initialized */
218 osver.dwOSVersionInfoSize = sizeof(osver);
219 GetVersionEx(&osver);
be9da6a9 220
3839a0fa 221 if (osver.dwMajorVersion > 4) {
aa2b96ec
JD		 222 WCHAR modulename[MAX_PATH];
223 WCHAR fullname[MAX_PATH];
224 char *ansi;
225
226 GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
227
228 /* Make sure we get an absolute pathname in case the module was loaded
229 * explicitly by LoadLibrary() with a relative path. */
230 GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
231
232 /* remove \\?\ prefix */
233 if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
234 memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
235
236 ansi = win32_ansipath(fullname);
237 my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
238 win32_free(ansi);
239 }
240 else {
241 GetModuleFileName(module, w32_module_name, sizeof(w32_module_name));
242
243 /* remove \\?\ prefix */
244 if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
245 memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
246
247 /* try to get full path to binary (which may be mangled when perl is
248 * run from a 16-bit app) */
249 /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
250 win32_longpath(w32_module_name);
251 /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/
252 }
2fa86c13
GS		 253
254 /* normalize to forward slashes */
255 ptr = w32_module_name;
256 while (*ptr) {
257 if (*ptr == '\\')
258 *ptr = '/';
259 ++ptr;
260 }
261}
262
c5be433b 263/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 264static char*
c5be433b 265get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
349ad1fe
GS		 266{
267 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
00dc2f4f
GS		 268 HKEY handle;
269 DWORD type;
270 const char *subkey = "Software\\Perl";
349ad1fe 271 char *str = Nullch;
00dc2f4f
GS		 272 long retval;
273
274 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
349ad1fe 275 if (retval == ERROR_SUCCESS) {
51371543
GS		 276 DWORD datalen;
277 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
1c94caf4
GS		 278 if (retval == ERROR_SUCCESS
279 && (type == REG_SZ || type == REG_EXPAND_SZ))
280 {
acfe0abc 281 dTHX;
c5be433b
GS		 282 if (!*svp)
283 *svp = sv_2mortal(newSVpvn("",0));
284 SvGROW(*svp, datalen);
51371543 285 retval = RegQueryValueEx(handle, valuename, 0, NULL,
c5be433b 286 (PBYTE)SvPVX(*svp), &datalen);
51371543 287 if (retval == ERROR_SUCCESS) {
c5be433b
GS		 288 str = SvPVX(*svp);
289 SvCUR_set(*svp,datalen-1);
51371543 290 }
00dc2f4f
GS		 291 }
292 RegCloseKey(handle);
293 }
349ad1fe 294 return str;
00dc2f4f
GS		 295}
296
c5be433b 297/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
51371543 298static char*
c5be433b 299get_regstr(const char *valuename, SV **svp)
00dc2f4f 300{
c5be433b 301 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
349ad1fe 302 if (!str)
c5be433b 303 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
349ad1fe 304 return str;
00dc2f4f
GS		 305}
306
c5be433b 307/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
e5a95ffb 308static char *
c5be433b 309get_emd_part(SV **prev_pathp, char *trailing_path, ...)
00dc2f4f 310{
dc9e4912 311 char base[10];
e5a95ffb 312 va_list ap;
e24c7c18 313 char mod_name[MAX_PATH+1];
00dc2f4f 314 char *ptr;
e5a95ffb
GS		 315 char *optr;
316 char *strip;
273cf8d1 317 STRLEN baselen;
e5a95ffb
GS		 318
319 va_start(ap, trailing_path);
320 strip = va_arg(ap, char *);
321
273cf8d1
GS		 322 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
323 baselen = strlen(base);
dc9e4912 324
8ac9c18d 325 if (!*w32_module_name) {
2fa86c13 326 set_w32_module_name();
95140b98 327 }
8ac9c18d 328 strcpy(mod_name, w32_module_name);
95140b98 329 ptr = strrchr(mod_name, '/');
e5a95ffb
GS		 330 while (ptr && strip) {
331 /* look for directories to skip back */
332 optr = ptr;
00dc2f4f 333 *ptr = '\0';
95140b98 334 ptr = strrchr(mod_name, '/');
1c39adb2
GS		 335 /* avoid stripping component if there is no slash,
336 * or it doesn't match ... */
e5a95ffb 337 if (!ptr || stricmp(ptr+1, strip) != 0) {
273cf8d1 338 /* ... but not if component matches m|5\.$patchlevel.*| */
1c39adb2 339 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
273cf8d1
GS		 340 && strncmp(strip, base, baselen) == 0
341 && strncmp(ptr+1, base, baselen) == 0))
95140b98
GS		 342 {
343 *optr = '/';
80252599
GS		 344 ptr = optr;
345 }
00dc2f4f 346 }
e5a95ffb 347 strip = va_arg(ap, char *);
00dc2f4f 348 }
e5a95ffb
GS		 349 if (!ptr) {
350 ptr = mod_name;
351 *ptr++ = '.';
95140b98 352 *ptr = '/';
00dc2f4f 353 }
e5a95ffb
GS		 354 va_end(ap);
355 strcpy(++ptr, trailing_path);
356
dc9e4912 357 /* only add directory if it exists */
349ad1fe 358 if (GetFileAttributes(mod_name) != (DWORD) -1) {
dc9e4912 359 /* directory exists */
acfe0abc 360 dTHX;
c5be433b
GS		 361 if (!*prev_pathp)
362 *prev_pathp = sv_2mortal(newSVpvn("",0));
f0c8bec2
SH		 363 else if (SvPVX(*prev_pathp))
364 sv_catpvn(*prev_pathp, ";", 1);
c5be433b
GS		 365 sv_catpv(*prev_pathp, mod_name);
366 return SvPVX(*prev_pathp);
00dc2f4f 367 }
00dc2f4f 368
cf11f4bf 369 return Nullch;
00dc2f4f
GS		 370}
371
372char *
4ea817c6 373win32_get_privlib(const char *pl)
00dc2f4f 374{
acfe0abc 375 dTHX;
e5a95ffb
GS		 376 char *stdlib = "lib";
377 char buffer[MAX_PATH+1];
51371543 378 SV *sv = Nullsv;
00dc2f4f 379
e5a95ffb
GS		 380 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
381 sprintf(buffer, "%s-%s", stdlib, pl);
c5be433b
GS		 382 if (!get_regstr(buffer, &sv))
383 (void)get_regstr(stdlib, &sv);
00dc2f4f 384
e5a95ffb 385 /* $stdlib .= ";$EMD/../../lib" */
c5be433b 386 return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
00dc2f4f
GS		 387}
388
4ea817c6
GS		 389static char *
390win32_get_xlib(const char *pl, const char *xlib, const char *libname)
00dc2f4f 391{
acfe0abc 392 dTHX;
e5a95ffb 393 char regstr[40];
e24c7c18 394 char pathstr[MAX_PATH+1];
51371543
GS		 395 SV *sv1 = Nullsv;
396 SV *sv2 = Nullsv;
00dc2f4f 397
4ea817c6
GS		 398 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
399 sprintf(regstr, "%s-%s", xlib, pl);
c5be433b 400 (void)get_regstr(regstr, &sv1);
e5a95ffb 401
4ea817c6
GS		 402 /* $xlib .=
403 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
404 sprintf(pathstr, "%s/%s/lib", libname, pl);
c5be433b 405 (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
00dc2f4f 406
4ea817c6
GS		 407 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
408 (void)get_regstr(xlib, &sv2);
00dc2f4f 409
4ea817c6
GS		 410 /* $xlib .=
411 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
412 sprintf(pathstr, "%s/lib", libname);
413 (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
e5a95ffb 414
51371543
GS		 415 if (!sv1 && !sv2)
416 return Nullch;
417 if (!sv1)
418 return SvPVX(sv2);
419 if (!sv2)
420 return SvPVX(sv1);
e5a95ffb 421
349ad1fe
GS		 422 sv_catpvn(sv1, ";", 1);
423 sv_catsv(sv1, sv2);
e5a95ffb 424
349ad1fe 425 return SvPVX(sv1);
68dc0745 426}
0a753a76 427
4ea817c6
GS		 428char *
429win32_get_sitelib(const char *pl)
430{
431 return win32_get_xlib(pl, "sitelib", "site");
432}
433
434#ifndef PERL_VENDORLIB_NAME
435# define PERL_VENDORLIB_NAME "vendor"
436#endif
437
438char *
439win32_get_vendorlib(const char *pl)
440{
441 return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
442}
b4793f7f 443
2d7a9237 444static BOOL
08039b81 445has_shell_metachars(const char *ptr)
68dc0745 446{
447 int inquote = 0;
448 char quote = '\0';
449
450 /*
451 * Scan string looking for redirection (< or >) or pipe
e200fe59
JD		 452 * characters (|) that are not in a quoted string.
453 * Shell variable interpolation (%VAR%) can also happen inside strings.
68dc0745 454 */
9404a519 455 while (*ptr) {
68dc0745 456 switch(*ptr) {
e200fe59
JD		 457 case '%':
458 return TRUE;
68dc0745 459 case '\'':
460 case '\"':
9404a519
GS		 461 if (inquote) {
462 if (quote == *ptr) {
68dc0745 463 inquote = 0;
464 quote = '\0';
0a753a76 465 }
68dc0745 466 }
467 else {
468 quote = *ptr;
469 inquote++;
470 }
471 break;
472 case '>':
473 case '<':
474 case '|':
9404a519 475 if (!inquote)
68dc0745 476 return TRUE;
477 default:
478 break;
0a753a76 479 }
68dc0745 480 ++ptr;
481 }
482 return FALSE;
0a753a76 483}
484
32e30700 485#if !defined(PERL_IMPLICIT_SYS)
68dc0745 486/* since the current process environment is being updated in util.c
487 * the library functions will get the correct environment
488 */
489PerlIO *
79d39d80 490Perl_my_popen(pTHX_ const char *cmd, const char *mode)
0a753a76 491{
492#ifdef FIXCMD
7766f137
GS		 493#define fixcmd(x) { \
494 char *pspace = strchr((x),' '); \
495 if (pspace) { \
496 char *p = (x); \
497 while (p < pspace) { \
498 if (*p == '/') \
499 *p = '\\'; \
500 p++; \
501 } \
502 } \
503 }
0a753a76 504#else
505#define fixcmd(x)
506#endif
68dc0745 507 fixcmd(cmd);
45bc9206 508 PERL_FLUSHALL_FOR_CHILD;
0a753a76 509 return win32_popen(cmd, mode);
0a753a76 510}
511
68dc0745 512long
4f63d024 513Perl_my_pclose(pTHX_ PerlIO *fp)
0a753a76 514{
515 return win32_pclose(fp);
516}
c69f6586 517#endif
0a753a76 518
0cb96387
GS		 519DllExport unsigned long
520win32_os_id(void)
0a753a76 521{
aeecf691 522 return (unsigned long)g_osver.dwPlatformId;
0a753a76 523}
524
7766f137
GS		 525DllExport int
526win32_getpid(void)
527{
922b1888 528 int pid;
7766f137 529#ifdef USE_ITHREADS
acfe0abc 530 dTHX;
7766f137
GS		 531 if (w32_pseudo_id)
532 return -((int)w32_pseudo_id);
533#endif
922b1888
GS		 534 pid = _getpid();
535 /* Windows 9x appears to always reports a pid for threads and processes
536 * that has the high bit set. So we treat the lower 31 bits as the
537 * "real" PID for Perl's purposes. */
538 if (IsWin95() && pid < 0)
539 pid = -pid;
540 return pid;
7766f137
GS		 541}
542
ce1da67e
GS		 543/* Tokenize a string. Words are null-separated, and the list
544 * ends with a doubled null. Any character (except null and
545 * including backslash) may be escaped by preceding it with a
546 * backslash (the backslash will be stripped).
547 * Returns number of words in result buffer.
548 */
549static long
dff6d3cd 550tokenize(const char *str, char **dest, char ***destv)
ce1da67e
GS		 551{
552 char *retstart = Nullch;
553 char **retvstart = 0;
554 int items = -1;
555 if (str) {
acfe0abc 556 dTHX;
ce1da67e
GS		 557 int slen = strlen(str);
558 register char *ret;
559 register char **retv;
a02a5408
JC		 560 Newx(ret, slen+2, char);
561 Newx(retv, (slen+3)/2, char*);
ce1da67e
GS		 562
563 retstart = ret;
564 retvstart = retv;
565 *retv = ret;
566 items = 0;
567 while (*str) {
568 *ret = *str++;
569 if (*ret == '\\' && *str)
570 *ret = *str++;
571 else if (*ret == ' ') {
572 while (*str == ' ')
573 str++;
574 if (ret == retstart)
575 ret--;
576 else {
577 *ret = '\0';
578 ++items;
579 if (*str)
580 *++retv = ret+1;
581 }
582 }
583 else if (!*str)
584 ++items;
585 ret++;
586 }
587 retvstart[items] = Nullch;
588 *ret++ = '\0';
589 *ret = '\0';
590 }
591 *dest = retstart;
592 *destv = retvstart;
593 return items;
594}
595
596static void
2d7a9237 597get_shell(void)
0a753a76 598{
acfe0abc 599 dTHX;
ce1da67e 600 if (!w32_perlshell_tokens) {
174c211a
GS		 601 /* we don't use COMSPEC here for two reasons:
602 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
603 * uncontrolled unportability of the ensuing scripts.
604 * 2. PERL5SHELL could be set to a shell that may not be fit for
605 * interactive use (which is what most programs look in COMSPEC
606 * for).
607 */
dff6d3cd 608 const char* defaultshell = (IsWinNT()
11998fdb 609 ? "cmd.exe /x/d/c" : "command.com /c");
2fb9ab56 610 const char *usershell = PerlEnv_getenv("PERL5SHELL");
ce1da67e
GS		 611 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
612 &w32_perlshell_tokens,
613 &w32_perlshell_vec);
68dc0745 614 }
0a753a76 615}
616
68dc0745 617int
54725af6 618Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
0a753a76 619{
68dc0745 620 char **argv;
2d7a9237 621 char *str;
68dc0745 622 int status;
2d7a9237 623 int flag = P_WAIT;
68dc0745 624 int index = 0;
68dc0745 625
2d7a9237
GS		 626 if (sp <= mark)
627 return -1;
68dc0745 628
ce1da67e 629 get_shell();
a02a5408 630 Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS		 631
632 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
633 ++mark;
634 flag = SvIVx(*mark);
68dc0745 635 }
636
9404a519 637 while (++mark <= sp) {
bb897dfc 638 if (*mark && (str = SvPV_nolen(*mark)))
2d7a9237
GS		 639 argv[index++] = str;
640 else
641 argv[index++] = "";
68dc0745 642 }
643 argv[index++] = 0;
3fadfdf1 644
2d7a9237 645 status = win32_spawnvp(flag,
bb897dfc 646 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS		 647 (const char* const*)argv);
648
80252599 649 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
2d7a9237 650 /* possible shell-builtin, invoke with shell */
ce1da67e
GS		 651 int sh_items;
652 sh_items = w32_perlshell_items;
2d7a9237
GS		 653 while (--index >= 0)
654 argv[index+sh_items] = argv[index];
ce1da67e
GS		 655 while (--sh_items >= 0)
656 argv[sh_items] = w32_perlshell_vec[sh_items];
3fadfdf1 657
2d7a9237 658 status = win32_spawnvp(flag,
bb897dfc 659 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS		 660 (const char* const*)argv);
661 }
68dc0745 662
922b1888
GS		 663 if (flag == P_NOWAIT) {
664 if (IsWin95())
665 PL_statusvalue = -1; /* >16bits hint for pp_system() */
666 }
667 else {
50892819 668 if (status < 0) {
0453d815 669 if (ckWARN(WARN_EXEC))
f98bc0c6 670 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
50892819
GS		 671 status = 255 * 256;
672 }
673 else
674 status *= 256;
b28d0864 675 PL_statusvalue = status;
5aabfad6 676 }
ce1da67e 677 Safefree(argv);
50892819 678 return (status);
68dc0745 679}
680
dd7038b3
JH		 681/* returns pointer to the next unquoted space or the end of the string */
682static char*
683find_next_space(const char *s)
684{
685 bool in_quotes = FALSE;
686 while (*s) {
687 /* ignore doubled backslashes, or backslash+quote */
688 if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
689 s += 2;
690 }
691 /* keep track of when we're within quotes */
692 else if (*s == '"') {
693 s++;
694 in_quotes = !in_quotes;
695 }
696 /* break it up only at spaces that aren't in quotes */
697 else if (!in_quotes && isSPACE(*s))
698 return (char*)s;
699 else
700 s++;
701 }
702 return (char*)s;
703}
704
54725af6 705static int
08039b81 706do_spawn2(pTHX_ const char *cmd, int exectype)
68dc0745 707{
708 char **a;
709 char *s;
710 char **argv;
711 int status = -1;
712 BOOL needToTry = TRUE;
2d7a9237 713 char *cmd2;
68dc0745 714
2d7a9237
GS		 715 /* Save an extra exec if possible. See if there are shell
716 * metacharacters in it */
e200fe59 717 if (!has_shell_metachars(cmd)) {
a02a5408
JC		 718 Newx(argv, strlen(cmd) / 2 + 2, char*);
719 Newx(cmd2, strlen(cmd) + 1, char);
68dc0745 720 strcpy(cmd2, cmd);
721 a = argv;
722 for (s = cmd2; *s;) {
de030af3 723 while (*s && isSPACE(*s))
68dc0745 724 s++;
725 if (*s)
726 *(a++) = s;
dd7038b3 727 s = find_next_space(s);
9404a519 728 if (*s)
68dc0745 729 *s++ = '\0';
0a753a76 730 }
68dc0745 731 *a = Nullch;
ce1da67e 732 if (argv[0]) {
6890e559
GS		 733 switch (exectype) {
734 case EXECF_SPAWN:
735 status = win32_spawnvp(P_WAIT, argv[0],
736 (const char* const*)argv);
737 break;
738 case EXECF_SPAWN_NOWAIT:
739 status = win32_spawnvp(P_NOWAIT, argv[0],
740 (const char* const*)argv);
741 break;
742 case EXECF_EXEC:
743 status = win32_execvp(argv[0], (const char* const*)argv);
744 break;
745 }
2d7a9237 746 if (status != -1 || errno == 0)
68dc0745 747 needToTry = FALSE;
0a753a76 748 }
0a753a76 749 Safefree(argv);
68dc0745 750 Safefree(cmd2);
751 }
2d7a9237 752 if (needToTry) {
ce1da67e
GS		 753 char **argv;
754 int i = -1;
755 get_shell();
a02a5408 756 Newx(argv, w32_perlshell_items + 2, char*);
ce1da67e
GS		 757 while (++i < w32_perlshell_items)
758 argv[i] = w32_perlshell_vec[i];
08039b81 759 argv[i++] = (char *)cmd;
2d7a9237 760 argv[i] = Nullch;
6890e559
GS		 761 switch (exectype) {
762 case EXECF_SPAWN:
763 status = win32_spawnvp(P_WAIT, argv[0],
764 (const char* const*)argv);
765 break;
766 case EXECF_SPAWN_NOWAIT:
767 status = win32_spawnvp(P_NOWAIT, argv[0],
768 (const char* const*)argv);
769 break;
770 case EXECF_EXEC:
771 status = win32_execvp(argv[0], (const char* const*)argv);
772 break;
773 }
ce1da67e
GS		 774 cmd = argv[0];
775 Safefree(argv);
68dc0745 776 }
922b1888
GS		 777 if (exectype == EXECF_SPAWN_NOWAIT) {
778 if (IsWin95())
779 PL_statusvalue = -1; /* >16bits hint for pp_system() */
780 }
781 else {
50892819 782 if (status < 0) {
0453d815 783 if (ckWARN(WARN_EXEC))
f98bc0c6 784 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
50892819
GS		 785 (exectype == EXECF_EXEC ? "exec" : "spawn"),
786 cmd, strerror(errno));
787 status = 255 * 256;
788 }
789 else
790 status *= 256;
b28d0864 791 PL_statusvalue = status;
5aabfad6 792 }
50892819 793 return (status);
0a753a76 794}
795
6890e559 796int
54725af6 797Perl_do_spawn(pTHX_ char *cmd)
6890e559 798{
54725af6 799 return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
6890e559
GS		 800}
801
2d7a9237 802int
54725af6 803Perl_do_spawn_nowait(pTHX_ char *cmd)
2d7a9237 804{
54725af6 805 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
2d7a9237
GS		 806}
807
6890e559 808bool
79d39d80 809Perl_do_exec(pTHX_ const char *cmd)
6890e559 810{
08039b81 811 do_spawn2(aTHX_ cmd, EXECF_EXEC);
6890e559
GS		 812 return FALSE;
813}
814
68dc0745 815/* The idea here is to read all the directory names into a string table
816 * (separated by nulls) and when one of the other dir functions is called
817 * return the pointer to the current file name.
818 */
c5be433b 819DllExport DIR *
0e06f75d 820win32_opendir(const char *filename)
0a753a76 821{
acfe0abc 822 dTHX;
95136add 823 DIR *dirp;
9404a519
GS		 824 long len;
825 long idx;
826 char scanname[MAX_PATH+3];
c623ac67 827 Stat_t sbuf;
7fac1903 828 WIN32_FIND_DATAA aFindData;
35cf1ab6
JD		 829 WIN32_FIND_DATAW wFindData;
830 bool using_wide;
831 char buffer[MAX_PATH*2];
832 char *ptr;
9404a519
GS		 833
834 len = strlen(filename);
835 if (len > MAX_PATH)
836 return NULL;
68dc0745 837
838 /* check to see if filename is a directory */
69d3ab13 839 if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
24caa93f 840 return NULL;
68dc0745 841
68dc0745 842 /* Get us a DIR structure */
a02a5408 843 Newxz(dirp, 1, DIR);
68dc0745 844
845 /* Create the search pattern */
846 strcpy(scanname, filename);
23db2e2d
GS		 847
848 /* bare drive name means look in cwd for drive */
849 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
850 scanname[len++] = '.';
851 scanname[len++] = '/';
852 }
853 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
9404a519 854 scanname[len++] = '/';
23db2e2d 855 }
9404a519
GS		 856 scanname[len++] = '*';
857 scanname[len] = '\0';
68dc0745 858
859 /* do the FindFirstFile call */
3839a0fa 860 if (IsWin2000()) {
35cf1ab6
JD		 861 WCHAR wscanname[sizeof(scanname)];
862 MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
863 dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
864 using_wide = TRUE;
865 }
866 else {
867 dirp->handle = FindFirstFileA(PerlDir_mapA(scanname), &aFindData);
868 }
8c56068e 869 if (dirp->handle == INVALID_HANDLE_VALUE) {
95136add 870 DWORD err = GetLastError();
21e72512 871 /* FindFirstFile() fails on empty drives! */
95136add
GS		 872 switch (err) {
873 case ERROR_FILE_NOT_FOUND:
874 return dirp;
875 case ERROR_NO_MORE_FILES:
876 case ERROR_PATH_NOT_FOUND:
877 errno = ENOENT;
878 break;
879 case ERROR_NOT_ENOUGH_MEMORY:
880 errno = ENOMEM;
881 break;
882 default:
883 errno = EINVAL;
884 break;
885 }
886 Safefree(dirp);
68dc0745 887 return NULL;
888 }
889
35cf1ab6
JD		 890 if (using_wide) {
891 BOOL use_default = FALSE;
892 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
893 wFindData.cFileName, -1,
894 buffer, sizeof(buffer), NULL, &use_default);
895 if (use_default && *wFindData.cAlternateFileName) {
896 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
897 wFindData.cAlternateFileName, -1,
898 buffer, sizeof(buffer), NULL, NULL);
899 }
900 ptr = buffer;
901 }
902 else {
903 ptr = aFindData.cFileName;
904 }
68dc0745 905 /* now allocate the first part of the string table for
906 * the filenames that we find.
907 */
35cf1ab6 908 idx = strlen(ptr)+1;
95136add 909 if (idx < 256)
35cf1ab6 910 dirp->size = 256;
95136add
GS		 911 else
912 dirp->size = idx;
a02a5408 913 Newx(dirp->start, dirp->size, char);
35cf1ab6 914 strcpy(dirp->start, ptr);
95136add
GS		 915 dirp->nfiles++;
916 dirp->end = dirp->curr = dirp->start;
917 dirp->end += idx;
918 return dirp;
0a753a76 919}
920
921
68dc0745 922/* Readdir just returns the current string pointer and bumps the
923 * string pointer to the nDllExport entry.
924 */
c5be433b 925DllExport struct direct *
ce2e26e5 926win32_readdir(DIR *dirp)
0a753a76 927{
95136add 928 long len;
0a753a76 929
68dc0745 930 if (dirp->curr) {
931 /* first set up the structure to return */
932 len = strlen(dirp->curr);
0f38926b 933 strcpy(dirp->dirstr.d_name, dirp->curr);
68dc0745 934 dirp->dirstr.d_namlen = len;
0a753a76 935
68dc0745 936 /* Fake an inode */
0f38926b 937 dirp->dirstr.d_ino = dirp->curr - dirp->start;
0a753a76 938
95136add 939 /* Now set up for the next call to readdir */
68dc0745 940 dirp->curr += len + 1;
95136add 941 if (dirp->curr >= dirp->end) {
acfe0abc 942 dTHX;
35cf1ab6
JD		 943 BOOL res;
944 WIN32_FIND_DATAA aFindData;
945 char buffer[MAX_PATH*2];
946 char *ptr;
95136add
GS		 947
948 /* finding the next file that matches the wildcard
949 * (which should be all of them in this directory!).
95136add 950 */
3839a0fa 951 if (IsWin2000()) {
35cf1ab6
JD		 952 WIN32_FIND_DATAW wFindData;
953 res = FindNextFileW(dirp->handle, &wFindData);
954 if (res) {
955 BOOL use_default = FALSE;
956 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
957 wFindData.cFileName, -1,
958 buffer, sizeof(buffer), NULL, &use_default);
959 if (use_default && *wFindData.cAlternateFileName) {
960 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
961 wFindData.cAlternateFileName, -1,
962 buffer, sizeof(buffer), NULL, NULL);
963 }
964 ptr = buffer;
965 }
966 }
967 else {
968 res = FindNextFileA(dirp->handle, &aFindData);
969 ptr = aFindData.cFileName;
970 }
95136add 971 if (res) {
0f38926b 972 long endpos = dirp->end - dirp->start;
35cf1ab6 973 long newsize = endpos + strlen(ptr) + 1;
95136add 974 /* bump the string table size by enough for the
022735b4 975 * new name and its null terminator */
0f38926b
GS		 976 while (newsize > dirp->size) {
977 long curpos = dirp->curr - dirp->start;
95136add
GS		 978 dirp->size *= 2;
979 Renew(dirp->start, dirp->size, char);
0f38926b 980 dirp->curr = dirp->start + curpos;
95136add 981 }
35cf1ab6 982 strcpy(dirp->start + endpos, ptr);
0f38926b 983 dirp->end = dirp->start + newsize;
95136add
GS		 984 dirp->nfiles++;
985 }
986 else
987 dirp->curr = NULL;
68dc0745 988 }
68dc0745 989 return &(dirp->dirstr);
3fadfdf1 990 }
68dc0745 991 else
992 return NULL;
0a753a76 993}
994
68dc0745 995/* Telldir returns the current string pointer position */
c5be433b 996DllExport long
ce2e26e5 997win32_telldir(DIR *dirp)
0a753a76 998{
95136add 999 return (dirp->curr - dirp->start);
0a753a76 1000}
1001
1002
68dc0745 1003/* Seekdir moves the string pointer to a previously saved position
95136add 1004 * (returned by telldir).
68dc0745 1005 */
c5be433b 1006DllExport void
ce2e26e5 1007win32_seekdir(DIR *dirp, long loc)
0a753a76 1008{
95136add 1009 dirp->curr = dirp->start + loc;
0a753a76 1010}
1011
68dc0745 1012/* Rewinddir resets the string pointer to the start */
c5be433b 1013DllExport void
ce2e26e5 1014win32_rewinddir(DIR *dirp)
0a753a76 1015{
1016 dirp->curr = dirp->start;
1017}
1018
68dc0745 1019/* free the memory allocated by opendir */
c5be433b 1020DllExport int
ce2e26e5 1021win32_closedir(DIR *dirp)
0a753a76 1022{
acfe0abc 1023 dTHX;
95136add 1024 if (dirp->handle != INVALID_HANDLE_VALUE)
0f38926b 1025 FindClose(dirp->handle);
0a753a76 1026 Safefree(dirp->start);
1027 Safefree(dirp);
68dc0745 1028 return 1;
0a753a76 1029}
1030
1031
68dc0745 1032/*
1033 * various stubs
1034 */
0a753a76 1035
1036
68dc0745 1037/* Ownership
1038 *
1039 * Just pretend that everyone is a superuser. NT will let us know if
1040 * we don\'t really have permission to do something.
1041 */
0a753a76 1042
1043#define ROOT_UID ((uid_t)0)
1044#define ROOT_GID ((gid_t)0)
1045
68dc0745 1046uid_t
1047getuid(void)
0a753a76 1048{
68dc0745 1049 return ROOT_UID;
0a753a76 1050}
1051
68dc0745 1052uid_t
1053geteuid(void)
0a753a76 1054{
68dc0745 1055 return ROOT_UID;
0a753a76 1056}
1057
68dc0745 1058gid_t
1059getgid(void)
0a753a76 1060{
68dc0745 1061 return ROOT_GID;
0a753a76 1062}
1063
68dc0745 1064gid_t
1065getegid(void)
0a753a76 1066{
68dc0745 1067 return ROOT_GID;
0a753a76 1068}
1069
68dc0745 1070int
22239a37 1071setuid(uid_t auid)
3fadfdf1 1072{
22239a37 1073 return (auid == ROOT_UID ? 0 : -1);
0a753a76 1074}
1075
68dc0745 1076int
22239a37 1077setgid(gid_t agid)
0a753a76 1078{
22239a37 1079 return (agid == ROOT_GID ? 0 : -1);
0a753a76 1080}
1081
e34ffe5a
GS		 1082char *
1083getlogin(void)
1084{
acfe0abc 1085 dTHX;
3352bfcb
GS		 1086 char *buf = w32_getlogin_buffer;
1087 DWORD size = sizeof(w32_getlogin_buffer);
e34ffe5a
GS		 1088 if (GetUserName(buf,&size))
1089 return buf;
1090 return (char*)NULL;
1091}
1092
b990f8c8
GS		 1093int
1094chown(const char *path, uid_t owner, gid_t group)
1095{
1096 /* XXX noop */
1c1c7f20 1097 return 0;
b990f8c8
GS		 1098}
1099
00b02797
JH		 1100/*
1101 * XXX this needs strengthening (for PerlIO)
1102 * -- BKS, 11-11-200
1103*/
1104int mkstemp(const char *path)
1105{
1106 dTHX;
1107 char buf[MAX_PATH+1];
1108 int i = 0, fd = -1;
1109
1110retry:
1111 if (i++ > 10) { /* give up */
1112 errno = ENOENT;
1113 return -1;
1114 }
1115 if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1116 errno = ENOENT;
1117 return -1;
1118 }
1119 fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1120 if (fd == -1)
1121 goto retry;
1122 return fd;
1123}
1124
0aaad0ff
GS		 1125static long
1126find_pid(int pid)
0a753a76 1127{
acfe0abc 1128 dTHX;
7766f137
GS		 1129 long child = w32_num_children;
1130 while (--child >= 0) {
eb160463 1131 if ((int)w32_child_pids[child] == pid)
0aaad0ff
GS		 1132 return child;
1133 }
1134 return -1;
1135}
1136
1137static void
1138remove_dead_process(long child)
1139{
1140 if (child >= 0) {
acfe0abc 1141 dTHX;
0aaad0ff 1142 CloseHandle(w32_child_handles[child]);
c00206c8 1143 Move(&w32_child_handles[child+1], &w32_child_handles[child],
0aaad0ff 1144 (w32_num_children-child-1), HANDLE);
c00206c8 1145 Move(&w32_child_pids[child+1], &w32_child_pids[child],
0aaad0ff
GS		 1146 (w32_num_children-child-1), DWORD);
1147 w32_num_children--;
f55ee38a 1148 }
f55ee38a
GS		 1149}
1150
7766f137
GS		 1151#ifdef USE_ITHREADS
1152static long
1153find_pseudo_pid(int pid)
1154{
acfe0abc 1155 dTHX;
7766f137
GS		 1156 long child = w32_num_pseudo_children;
1157 while (--child >= 0) {
eb160463 1158 if ((int)w32_pseudo_child_pids[child] == pid)
7766f137
GS		 1159 return child;
1160 }
1161 return -1;
1162}
1163
1164static void
1165remove_dead_pseudo_process(long child)
1166{
1167 if (child >= 0) {
acfe0abc 1168 dTHX;
7766f137 1169 CloseHandle(w32_pseudo_child_handles[child]);
c00206c8 1170 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
7766f137 1171 (w32_num_pseudo_children-child-1), HANDLE);
c00206c8 1172 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
7766f137 1173 (w32_num_pseudo_children-child-1), DWORD);
aeecf691
JD		 1174 Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1175 (w32_num_pseudo_children-child-1), HWND);
7766f137
GS		 1176 w32_num_pseudo_children--;
1177 }
1178}
1179#endif
1180
542cb85f
JD		 1181static int
1182terminate_process(DWORD pid, HANDLE process_handle, int sig)
1183{
1184 switch(sig) {
1185 case 0:
1186 /* "Does process exist?" use of kill */
1187 return 1;
1188 case 2:
1189 if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1190 return 1;
1191 break;
1192 case SIGBREAK:
1193 case SIGTERM:
1194 if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1195 return 1;
1196 break;
1197 default: /* For now be backwards compatible with perl 5.6 */
1198 case 9:
1199 /* Note that we will only be able to kill processes owned by the
1200 * current process owner, even when we are running as an administrator.
1201 * To kill processes of other owners we would need to set the
1202 * 'SeDebugPrivilege' privilege before obtaining the process handle.
1203 */
1204 if (TerminateProcess(process_handle, sig))
1205 return 1;
1206 break;
1207 }
1208 return 0;
1209}
1210
1211/* Traverse process tree using ToolHelp functions */
1212static int
1213kill_process_tree_toolhelp(DWORD pid, int sig)
1214{
1215 HANDLE process_handle;
1216 HANDLE snapshot_handle;
1217 int killed = 0;
1218
1219 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1220 if (process_handle == NULL)
542cb85f
JD		 1221 return 0;
1222
1223 killed += terminate_process(pid, process_handle, sig);
1224
1225 snapshot_handle = pfnCreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
1226 if (snapshot_handle != INVALID_HANDLE_VALUE) {
1227 PROCESSENTRY32 entry;
1228
1229 entry.dwSize = sizeof(entry);
1230 if (pfnProcess32First(snapshot_handle, &entry)) {
1231 do {
1232 if (entry.th32ParentProcessID == pid)
1233 killed += kill_process_tree_toolhelp(entry.th32ProcessID, sig);
1234 entry.dwSize = sizeof(entry);
1235 }
1236 while (pfnProcess32Next(snapshot_handle, &entry));
1237 }
1238 CloseHandle(snapshot_handle);
1239 }
1240 CloseHandle(process_handle);
1241 return killed;
1242}
1243
1244/* Traverse process tree using undocumented system information structures.
1245 * This is only necessary on Windows NT, which lacks the ToolHelp functions.
1246 */
1247static int
1248kill_process_tree_sysinfo(SYSTEM_PROCESSES *process_info, DWORD pid, int sig)
1249{
1250 HANDLE process_handle;
1251 SYSTEM_PROCESSES *p = process_info;
1252 int killed = 0;
1253
1254 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af 1255 if (process_handle == NULL)
542cb85f
JD		 1256 return 0;
1257
1258 killed += terminate_process(pid, process_handle, sig);
1259
1260 while (1) {
1261 if (p->InheritedFromProcessId == (DWORD)pid)
1262 killed += kill_process_tree_sysinfo(process_info, p->ProcessId, sig);
1263
1264 if (p->NextEntryDelta == 0)
1265 break;
1266
1267 p = (SYSTEM_PROCESSES*)((char*)p + p->NextEntryDelta);
1268 }
1269
1270 CloseHandle(process_handle);
1271 return killed;
1272}
1273
1274int
1275killpg(int pid, int sig)
1276{
1277 /* Use "documented" method whenever available */
1278 if (pfnCreateToolhelp32Snapshot && pfnProcess32First && pfnProcess32Next) {
1279 return kill_process_tree_toolhelp((DWORD)pid, sig);
1280 }
1281
1282 /* Fall back to undocumented Windows internals on Windows NT */
1283 if (pfnZwQuerySystemInformation) {
1284 dTHX;
1285 char *buffer;
1286 DWORD size = 0;
1287
1288 pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, NULL, 0, &size);
1289 Newx(buffer, size, char);
1290
1291 if (pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, buffer, size, NULL) >= 0) {
1292 int killed = kill_process_tree_sysinfo((SYSTEM_PROCESSES*)buffer, (DWORD)pid, sig);
1293 Safefree(buffer);
1294 return killed;
1295 }
1296 }
1297 return 0;
1298}
1299
1300static int
1301my_kill(int pid, int sig)
1302{
1303 int retval = 0;
1304 HANDLE process_handle;
1305
1306 if (sig < 0)
1307 return killpg(pid, -sig);
1308
1309 process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
6a4d57af
JD		 1310 /* OpenProcess() returns NULL on error, *not* INVALID_HANDLE_VALUE */
1311 if (process_handle != NULL) {
542cb85f
JD		 1312 retval = terminate_process(pid, process_handle, sig);
1313 CloseHandle(process_handle);
1314 }
1315 return retval;
1316}
1317
f55ee38a
GS		 1318DllExport int
1319win32_kill(int pid, int sig)
1320{
acfe0abc 1321 dTHX;
c66b022d 1322 long child;
7766f137
GS		 1323#ifdef USE_ITHREADS
1324 if (pid < 0) {
1325 /* it is a pseudo-forked child */
c66b022d 1326 child = find_pseudo_pid(-pid);
7766f137 1327 if (child >= 0) {
aeecf691 1328 HWND hwnd = w32_pseudo_child_message_hwnds[child];
85c508c3 1329 HANDLE hProcess = w32_pseudo_child_handles[child];
7e5f34c0
NIS		 1330 switch (sig) {
1331 case 0:
c843839f 1332 /* "Does process exist?" use of kill */
7766f137 1333 return 0;
aeecf691 1334
7e5f34c0
NIS		 1335 case 9:
1336 /* kill -9 style un-graceful exit */
1337 if (TerminateThread(hProcess, sig)) {
1338 remove_dead_pseudo_process(child);
1339 return 0;
1340 }
1341 break;
aeecf691
JD		 1342
1343 default: {
1344 int count = 0;
1345 /* pseudo-process has not yet properly initialized if hwnd isn't set */
1346 while (hwnd == INVALID_HANDLE_VALUE && count < 5) {
1347 /* Yield and wait for the other thread to send us its message_hwnd */
1348 Sleep(0);
1349 win32_async_check(aTHX);
5e162c31 1350 hwnd = w32_pseudo_child_message_hwnds[child];
aeecf691
JD		 1351 ++count;
1352 }
1353 if (hwnd != INVALID_HANDLE_VALUE) {
1354 /* We fake signals to pseudo-processes using Win32
1355 * message queue. In Win9X the pids are negative already. */
1356 if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1357 PostThreadMessage(IsWin95() ? pid : -pid, WM_USER_KILL, sig, 0))
1358 {
1359 /* It might be us ... */
1360 PERL_ASYNC_CHECK();
1361 return 0;
1362 }
1363 }
7e5f34c0
NIS		 1364 break;
1365 }
aeecf691 1366 } /* switch */
7766f137 1367 }
922b1888
GS		 1368 else if (IsWin95()) {
1369 pid = -pid;
1370 goto alien_process;
1371 }
68dc0745 1372 }
7766f137
GS		 1373 else
1374#endif
1375 {
c66b022d 1376 child = find_pid(pid);
7766f137 1377 if (child >= 0) {
542cb85f
JD		 1378 if (my_kill(pid, sig)) {
1379 DWORD exitcode = 0;
1380 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1381 exitcode != STILL_ACTIVE)
1382 {
1383 remove_dead_process(child);
1384 }
1385 return 0;
7e5f34c0 1386 }
7766f137
GS		 1387 }
1388 else {
922b1888 1389alien_process:
542cb85f 1390 if (my_kill((IsWin95() ? -pid : pid), sig))
48db714f 1391 return 0;
7766f137
GS		 1392 }
1393 }
1394 errno = EINVAL;
1395 return -1;
0a753a76 1396}
fbbbcc48 1397
68dc0745 1398DllExport int
c623ac67 1399win32_stat(const char *path, Stat_t *sbuf)
0a753a76 1400{
acfe0abc 1401 dTHX;
3fadfdf1 1402 char buffer[MAX_PATH+1];
68dc0745 1403 int l = strlen(path);
67fbe06e 1404 int res;
6b980173 1405 int nlink = 1;
44221b20 1406 BOOL expect_dir = FALSE;
0a753a76 1407
cba61fe1
JD		 1408 GV *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT",
1409 GV_NOTQUAL, SVt_PV);
1410 BOOL sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy));
1411
68dc0745 1412 if (l > 1) {
1413 switch(path[l - 1]) {
e1dbac94 1414 /* FindFirstFile() and stat() are buggy with a trailing
44221b20 1415 * slashes, except for the root directory of a drive */
68dc0745 1416 case '\\':
44221b20
JD		 1417 case '/':
1418 if (l > sizeof(buffer)) {
0b96339f
JD		 1419 errno = ENAMETOOLONG;
1420 return -1;
1421 }
44221b20
JD		 1422 --l;
1423 strncpy(buffer, path, l);
1424 /* remove additional trailing slashes */
1425 while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
1426 --l;
1427 /* add back slash if we otherwise end up with just a drive letter */
1428 if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
1429 buffer[l++] = '\\';
1430 buffer[l] = '\0';
1431 path = buffer;
1432 expect_dir = TRUE;
e1dbac94 1433 break;
44221b20 1434
23db2e2d 1435 /* FindFirstFile() is buggy with "x:", so add a dot :-( */
e1dbac94
GS		 1436 case ':':
1437 if (l == 2 && isALPHA(path[0])) {
426c1a18
GS		 1438 buffer[0] = path[0];
1439 buffer[1] = ':';
1440 buffer[2] = '.';
1441 buffer[3] = '\0';
e1dbac94 1442 l = 3;
426c1a18 1443 path = buffer;
e1dbac94
GS		 1444 }
1445 break;
68dc0745 1446 }
1447 }
6b980173 1448
8c56068e
JD		 1449 path = PerlDir_mapA(path);
1450 l = strlen(path);
cba61fe1
JD		 1451
1452 if (!sloppy) {
1453 /* We must open & close the file once; otherwise file attribute changes */
1454 /* might not yet have propagated to "other" hard links of the same file. */
1455 /* This also gives us an opportunity to determine the number of links. */
1456 HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
1457 if (handle != INVALID_HANDLE_VALUE) {
1458 BY_HANDLE_FILE_INFORMATION bhi;
1459 if (GetFileInformationByHandle(handle, &bhi))
1460 nlink = bhi.nNumberOfLinks;
1461 CloseHandle(handle);
1462 }
7fac1903 1463 }
6b980173 1464
8c56068e 1465 /* path will be mapped correctly above */
c623ac67 1466#if defined(WIN64) || defined(USE_LARGE_FILES)
8c56068e 1467 res = _stati64(path, sbuf);
c623ac67 1468#else
8c56068e 1469 res = stat(path, sbuf);
c623ac67 1470#endif
426c1a18 1471 sbuf->st_nlink = nlink;
6b980173 1472
24caa93f
GS		 1473 if (res < 0) {
1474 /* CRT is buggy on sharenames, so make sure it really isn't.
1475 * XXX using GetFileAttributesEx() will enable us to set
426c1a18 1476 * sbuf->st_*time (but note that's not available on the
24caa93f 1477 * Windows of 1995) */
8c56068e 1478 DWORD r = GetFileAttributesA(path);
24caa93f 1479 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
426c1a18 1480 /* sbuf may still contain old garbage since stat() failed */
c623ac67 1481 Zero(sbuf, 1, Stat_t);
426c1a18 1482 sbuf->st_mode = S_IFDIR | S_IREAD;
24caa93f
GS		 1483 errno = 0;
1484 if (!(r & FILE_ATTRIBUTE_READONLY))
426c1a18 1485 sbuf->st_mode |= S_IWRITE | S_IEXEC;
24caa93f
GS		 1486 return 0;
1487 }
1488 }
24caa93f 1489 else {
e1dbac94
GS		 1490 if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1491 && (path[2] == '\\' || path[2] == '/'))
2293b0e9
AB		 1492 {
1493 /* The drive can be inaccessible, some _stat()s are buggy */
8c56068e 1494 if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
2293b0e9
AB		 1495 errno = ENOENT;
1496 return -1;
1497 }
1498 }
44221b20
JD		 1499 if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
1500 errno = ENOTDIR;
1501 return -1;
1502 }
2293b0e9 1503#ifdef __BORLANDC__
426c1a18
GS		 1504 if (S_ISDIR(sbuf->st_mode))
1505 sbuf->st_mode |= S_IWRITE | S_IEXEC;
1506 else if (S_ISREG(sbuf->st_mode)) {
d0650a05 1507 int perms;
67fbe06e
GS		 1508 if (l >= 4 && path[l-4] == '.') {
1509 const char *e = path + l - 3;
1510 if (strnicmp(e,"exe",3)
1511 && strnicmp(e,"bat",3)
1512 && strnicmp(e,"com",3)
1513 && (IsWin95() || strnicmp(e,"cmd",3)))
426c1a18 1514 sbuf->st_mode &= ~S_IEXEC;
67fbe06e 1515 else
426c1a18 1516 sbuf->st_mode |= S_IEXEC;
67fbe06e
GS		 1517 }
1518 else
426c1a18 1519 sbuf->st_mode &= ~S_IEXEC;
d0650a05
GS		 1520 /* Propagate permissions to _group_ and _others_ */
1521 perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC);
1522 sbuf->st_mode |= (perms>>3) | (perms>>6);
67fbe06e 1523 }
67fbe06e 1524#endif
2293b0e9 1525 }
67fbe06e 1526 return res;
0a753a76 1527}
1528
bb27e7b6
JH		 1529#define isSLASH(c) ((c) == '/' || (c) == '\\')
1530#define SKIP_SLASHES(s) \
1531 STMT_START { \
1532 while (*(s) && isSLASH(*(s))) \
1533 ++(s); \
1534 } STMT_END
1535#define COPY_NONSLASHES(d,s) \
1536 STMT_START { \
1537 while (*(s) && !isSLASH(*(s))) \
1538 *(d)++ = *(s)++; \
1539 } STMT_END
1540
8ac9c18d
GS		 1541/* Find the longname of a given path. path is destructively modified.
1542 * It should have space for at least MAX_PATH characters. */
1543DllExport char *
1544win32_longpath(char *path)
1545{
1546 WIN32_FIND_DATA fdata;
1547 HANDLE fhand;
1548 char tmpbuf[MAX_PATH+1];
1549 char *tmpstart = tmpbuf;
1550 char *start = path;
1551 char sep;
1552 if (!path)
1553 return Nullch;
1554
1555 /* drive prefix */
bb27e7b6 1556 if (isALPHA(path[0]) && path[1] == ':') {
8ac9c18d
GS		 1557 start = path + 2;
1558 *tmpstart++ = path[0];
1559 *tmpstart++ = ':';
1560 }
1561 /* UNC prefix */
bb27e7b6 1562 else if (isSLASH(path[0]) && isSLASH(path[1])) {
8ac9c18d 1563 start = path + 2;
52fcf7ee
GS		 1564 *tmpstart++ = path[0];
1565 *tmpstart++ = path[1];
bb27e7b6
JH		 1566 SKIP_SLASHES(start);
1567 COPY_NONSLASHES(tmpstart,start); /* copy machine name */
8ac9c18d 1568 if (*start) {
bb27e7b6
JH		 1569 *tmpstart++ = *start++;
1570 SKIP_SLASHES(start);
1571 COPY_NONSLASHES(tmpstart,start); /* copy share name */
8ac9c18d
GS		 1572 }
1573 }
8ac9c18d 1574 *tmpstart = '\0';
bb27e7b6
JH		 1575 while (*start) {
1576 /* copy initial slash, if any */
1577 if (isSLASH(*start)) {
1578 *tmpstart++ = *start++;
1579 *tmpstart = '\0';
1580 SKIP_SLASHES(start);
1581 }
1582
1583 /* FindFirstFile() expands "." and "..", so we need to pass
1584 * those through unmolested */
1585 if (*start == '.'
1586 && (!start[1] || isSLASH(start[1])
1587 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1588 {
1589 COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */
1590 *tmpstart = '\0';
1591 continue;
1592 }
1593
1594 /* if this is the end, bust outta here */
1595 if (!*start)
1596 break;
8ac9c18d 1597
bb27e7b6
JH		 1598 /* now we're at a non-slash; walk up to next slash */
1599 while (*start && !isSLASH(*start))
8ac9c18d 1600 ++start;
8ac9c18d
GS		 1601
1602 /* stop and find full name of component */
bb27e7b6 1603 sep = *start;
8ac9c18d
GS		 1604 *start = '\0';
1605 fhand = FindFirstFile(path,&fdata);
bb27e7b6 1606 *start = sep;
8ac9c18d 1607 if (fhand != INVALID_HANDLE_VALUE) {
bb27e7b6
JH		 1608 STRLEN len = strlen(fdata.cFileName);
1609 if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1610 strcpy(tmpstart, fdata.cFileName);
1611 tmpstart += len;
1612 FindClose(fhand);
1613 }
1614 else {
1615 FindClose(fhand);
1616 errno = ERANGE;
1617 return Nullch;
1618 }
8ac9c18d
GS		 1619 }
1620 else {
1621 /* failed a step, just return without side effects */
bf49b057 1622 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
bb27e7b6 1623 errno = EINVAL;
8ac9c18d
GS		 1624 return Nullch;
1625 }
1626 }
1627 strcpy(path,tmpbuf);
1628 return path;
1629}
1630
aa2b96ec
JD		 1631static void
1632out_of_memory()
1633{
ae6198af
JD		 1634 if (PL_curinterp) {
1635 dTHX;
1636 /* Can't use PerlIO to write as it allocates memory */
1637 PerlLIO_write(PerlIO_fileno(Perl_error_log),
1638 PL_no_mem, strlen(PL_no_mem));
1639 my_exit(1);
1640 }
1641 exit(1);
aa2b96ec
JD		 1642}
1643
1644/* The win32_ansipath() function takes a Unicode filename and converts it
1645 * into the current Windows codepage. If some characters cannot be mapped,
1646 * then it will convert the short name instead.
1647 *
1648 * The buffer to the ansi pathname must be freed with win32_free() when it
1649 * it no longer needed.
1650 *
1651 * The argument to win32_ansipath() must exist before this function is
1652 * called; otherwise there is no way to determine the short path name.
1653 *
1654 * Ideas for future refinement:
1655 * - Only convert those segments of the path that are not in the current
1656 * codepage, but leave the other segments in their long form.
1657 * - If the resulting name is longer than MAX_PATH, start converting
1658 * additional path segments into short names until the full name
1659 * is shorter than MAX_PATH. Shorten the filename part last!
1660 */
1661DllExport char *
1662win32_ansipath(const WCHAR *widename)
1663{
1664 char *name;
1665 BOOL use_default = FALSE;
1666 size_t widelen = wcslen(widename)+1;
1667 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1668 NULL, 0, NULL, NULL);
1669 name = win32_malloc(len);
1670 if (!name)
1671 out_of_memory();
1672
1673 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1674 name, len, NULL, &use_default);
1675 if (use_default) {
aa2b96ec 1676 DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
ae6198af
JD		 1677 if (shortlen) {
1678 WCHAR *shortname = win32_malloc(shortlen*sizeof(WCHAR));
1679 if (!shortname)
1680 out_of_memory();
1681 shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1682
1683 len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1684 NULL, 0, NULL, NULL);
1685 name = win32_realloc(name, len);
1686 if (!name)
1687 out_of_memory();
1688 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1689 name, len, NULL, NULL);
1690 win32_free(shortname);
1691 }
aa2b96ec
JD		 1692 }
1693 return name;
1694}
1695
0551aaa8
GS		 1696DllExport char *
1697win32_getenv(const char *name)
1698{
acfe0abc 1699 dTHX;
0551aaa8 1700 DWORD needlen;
51371543 1701 SV *curitem = Nullsv;
58a50f62 1702
8c56068e 1703 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 1704 if (needlen != 0) {
51371543 1705 curitem = sv_2mortal(newSVpvn("", 0));
8c56068e
JD		 1706 do {
1707 SvGROW(curitem, needlen+1);
1708 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
1709 needlen);
1710 } while (needlen >= SvLEN(curitem));
1711 SvCUR_set(curitem, needlen);
0551aaa8 1712 }
c934e9d4 1713 else {
7a5f8e82 1714 /* allow any environment variables that begin with 'PERL'
c934e9d4 1715 to be stored in the registry */
51371543 1716 if (strncmp(name, "PERL", 4) == 0)
c5be433b 1717 (void)get_regstr(name, &curitem);
c69f6586 1718 }
51371543
GS		 1719 if (curitem && SvCUR(curitem))
1720 return SvPVX(curitem);
58a50f62 1721
51371543 1722 return Nullch;
0551aaa8
GS		 1723}
1724
ac5c734f
GS		 1725DllExport int
1726win32_putenv(const char *name)
1727{
acfe0abc 1728 dTHX;
ac5c734f
GS		 1729 char* curitem;
1730 char* val;
b813a9c7 1731 int relval = -1;
51371543 1732
73c4f7a1 1733 if (name) {
8c56068e
JD		 1734 Newx(curitem,strlen(name)+1,char);
1735 strcpy(curitem, name);
1736 val = strchr(curitem, '=');
1737 if (val) {
1738 /* The sane way to deal with the environment.
1739 * Has these advantages over putenv() & co.:
1740 * * enables us to store a truly empty value in the
1741 * environment (like in UNIX).
1742 * * we don't have to deal with RTL globals, bugs and leaks.
1743 * * Much faster.
1744 * Why you may want to enable USE_WIN32_RTL_ENV:
1745 * * environ[] and RTL functions will not reflect changes,
1746 * which might be an issue if extensions want to access
1747 * the env. via RTL. This cuts both ways, since RTL will
1748 * not see changes made by extensions that call the Win32
1749 * functions directly, either.
1750 * GSAR 97-06-07
1751 */
1752 *val++ = '\0';
1753 if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
1754 relval = 0;
1755 }
1756 Safefree(curitem);
ac5c734f
GS		 1757 }
1758 return relval;
1759}
1760
d55594ae 1761static long
2d7a9237 1762filetime_to_clock(PFILETIME ft)
d55594ae 1763{
7766f137
GS		 1764 __int64 qw = ft->dwHighDateTime;
1765 qw <<= 32;
1766 qw |= ft->dwLowDateTime;
1767 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
1768 return (long) qw;
d55594ae
GS		 1769}
1770
f3986ebb
GS		 1771DllExport int
1772win32_times(struct tms *timebuf)
0a753a76 1773{
d55594ae
GS		 1774 FILETIME user;
1775 FILETIME kernel;
1776 FILETIME dummy;
50ee8e5e 1777 clock_t process_time_so_far = clock();
3fadfdf1 1778 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
d55594ae 1779 &kernel,&user)) {
2d7a9237
GS		 1780 timebuf->tms_utime = filetime_to_clock(&user);
1781 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS		 1782 timebuf->tms_cutime = 0;
1783 timebuf->tms_cstime = 0;
3fadfdf1 1784 } else {
d55594ae 1785 /* That failed - e.g. Win95 fallback to clock() */
50ee8e5e 1786 timebuf->tms_utime = process_time_so_far;
d55594ae
GS		 1787 timebuf->tms_stime = 0;
1788 timebuf->tms_cutime = 0;
1789 timebuf->tms_cstime = 0;
1790 }
50ee8e5e 1791 return process_time_so_far;
0a753a76 1792}
1793
9c51cf4c 1794/* fix utime() so it works on directories in NT */
ad0751ec
GS		 1795static BOOL
1796filetime_from_time(PFILETIME pFileTime, time_t Time)
1797{
9c51cf4c 1798 struct tm *pTM = localtime(&Time);
ad0751ec 1799 SYSTEMTIME SystemTime;
9c51cf4c 1800 FILETIME LocalTime;
ad0751ec
GS		 1801
1802 if (pTM == NULL)
1803 return FALSE;
1804
1805 SystemTime.wYear = pTM->tm_year + 1900;
1806 SystemTime.wMonth = pTM->tm_mon + 1;
1807 SystemTime.wDay = pTM->tm_mday;
1808 SystemTime.wHour = pTM->tm_hour;
1809 SystemTime.wMinute = pTM->tm_min;
1810 SystemTime.wSecond = pTM->tm_sec;
1811 SystemTime.wMilliseconds = 0;
1812
9c51cf4c
GS		 1813 return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
1814 LocalFileTimeToFileTime(&LocalTime, pFileTime);
ad0751ec
GS		 1815}
1816
1817DllExport int
7766f137
GS		 1818win32_unlink(const char *filename)
1819{
acfe0abc 1820 dTHX;
7766f137
GS		 1821 int ret;
1822 DWORD attrs;
1823
8c56068e
JD		 1824 filename = PerlDir_mapA(filename);
1825 attrs = GetFileAttributesA(filename);
1826 if (attrs == 0xFFFFFFFF) {
1827 errno = ENOENT;
1828 return -1;
7766f137 1829 }
8c56068e
JD		 1830 if (attrs & FILE_ATTRIBUTE_READONLY) {
1831 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
1832 ret = unlink(filename);
1833 if (ret == -1)
1834 (void)SetFileAttributesA(filename, attrs);
7766f137 1835 }
8c56068e
JD		 1836 else
1837 ret = unlink(filename);
7766f137
GS		 1838 return ret;
1839}
1840
1841DllExport int
3b405fc5 1842win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 1843{
acfe0abc 1844 dTHX;
ad0751ec
GS		 1845 HANDLE handle;
1846 FILETIME ftCreate;
1847 FILETIME ftAccess;
1848 FILETIME ftWrite;
1849 struct utimbuf TimeBuffer;
7fac1903 1850 int rc;
8c56068e
JD		 1851
1852 filename = PerlDir_mapA(filename);
1853 rc = utime(filename, times);
1854
ad0751ec
GS		 1855 /* EACCES: path specifies directory or readonly file */
1856 if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
1857 return rc;
1858
1859 if (times == NULL) {
1860 times = &TimeBuffer;
1861 time(&times->actime);
1862 times->modtime = times->actime;
1863 }
1864
1865 /* This will (and should) still fail on readonly files */
8c56068e
JD		 1866 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
1867 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1868 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
ad0751ec
GS		 1869 if (handle == INVALID_HANDLE_VALUE)
1870 return rc;
1871
1872 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
1873 filetime_from_time(&ftAccess, times->actime) &&
1874 filetime_from_time(&ftWrite, times->modtime) &&
1875 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
1876 {
1877 rc = 0;
1878 }
1879
1880 CloseHandle(handle);
1881 return rc;
1882}
1883
6e3b076d
JH		 1884typedef union {
1885 unsigned __int64 ft_i64;
1886 FILETIME ft_val;
1887} FT_t;
1888
1889#ifdef __GNUC__
1890#define Const64(x) x##LL
1891#else
1892#define Const64(x) x##i64
1893#endif
1894/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
1895#define EPOCH_BIAS Const64(116444736000000000)
1896
57ab3dfe
GS		 1897/* NOTE: This does not compute the timezone info (doing so can be expensive,
1898 * and appears to be unsupported even by glibc) */
1899DllExport int
1900win32_gettimeofday(struct timeval *tp, void *not_used)
1901{
6e3b076d
JH		 1902 FT_t ft;
1903
1904 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
1905 GetSystemTimeAsFileTime(&ft.ft_val);
1906
1907 /* seconds since epoch */
1908 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
1909
1910 /* microseconds remaining */
1911 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
1912
1913 return 0;
57ab3dfe
GS		 1914}
1915
2d7a9237 1916DllExport int
b2af26b1
GS		 1917win32_uname(struct utsname *name)
1918{
1919 struct hostent *hep;
1920 STRLEN nodemax = sizeof(name->nodename)-1;
b2af26b1 1921
aeecf691
JD		 1922 /* sysname */
1923 switch (g_osver.dwPlatformId) {
1924 case VER_PLATFORM_WIN32_WINDOWS:
1925 strcpy(name->sysname, "Windows");
1926 break;
1927 case VER_PLATFORM_WIN32_NT:
1928 strcpy(name->sysname, "Windows NT");
1929 break;
1930 case VER_PLATFORM_WIN32s:
1931 strcpy(name->sysname, "Win32s");
1932 break;
1933 default:
1934 strcpy(name->sysname, "Win32 Unknown");
1935 break;
b2af26b1 1936 }
aeecf691
JD		 1937
1938 /* release */
1939 sprintf(name->release, "%d.%d",
1940 g_osver.dwMajorVersion, g_osver.dwMinorVersion);
1941
1942 /* version */
1943 sprintf(name->version, "Build %d",
1944 g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
1945 ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
1946 if (g_osver.szCSDVersion[0]) {
1947 char *buf = name->version + strlen(name->version);
1948 sprintf(buf, " (%s)", g_osver.szCSDVersion);
b2af26b1
GS		 1949 }
1950
1951 /* nodename */
1952 hep = win32_gethostbyname("localhost");
1953 if (hep) {
1954 STRLEN len = strlen(hep->h_name);
1955 if (len <= nodemax) {
1956 strcpy(name->nodename, hep->h_name);
1957 }
1958 else {
1959 strncpy(name->nodename, hep->h_name, nodemax);
1960 name->nodename[nodemax] = '\0';
1961 }
1962 }
1963 else {
1964 DWORD sz = nodemax;
1965 if (!GetComputerName(name->nodename, &sz))
1966 *name->nodename = '\0';
1967 }
1968
1969 /* machine (architecture) */
1970 {
1971 SYSTEM_INFO info;
fe537c65 1972 DWORD procarch;
b2af26b1
GS		 1973 char *arch;
1974 GetSystemInfo(&info);
a6c40364 1975
6f24f39d
JK		 1976#if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) \
1977 || (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION))
fe537c65 1978 procarch = info.u.s.wProcessorArchitecture;
a6c40364 1979#else
fe537c65 1980 procarch = info.wProcessorArchitecture;
a6c40364 1981#endif
fe537c65 1982 switch (procarch) {
b2af26b1
GS		 1983 case PROCESSOR_ARCHITECTURE_INTEL:
1984 arch = "x86"; break;
1985 case PROCESSOR_ARCHITECTURE_MIPS:
1986 arch = "mips"; break;
1987 case PROCESSOR_ARCHITECTURE_ALPHA:
1988 arch = "alpha"; break;
1989 case PROCESSOR_ARCHITECTURE_PPC:
1990 arch = "ppc"; break;
fe537c65
GS		 1991#ifdef PROCESSOR_ARCHITECTURE_SHX
1992 case PROCESSOR_ARCHITECTURE_SHX:
1993 arch = "shx"; break;
1994#endif
1995#ifdef PROCESSOR_ARCHITECTURE_ARM
1996 case PROCESSOR_ARCHITECTURE_ARM:
1997 arch = "arm"; break;
1998#endif
1999#ifdef PROCESSOR_ARCHITECTURE_IA64
2000 case PROCESSOR_ARCHITECTURE_IA64:
2001 arch = "ia64"; break;
2002#endif
2003#ifdef PROCESSOR_ARCHITECTURE_ALPHA64
2004 case PROCESSOR_ARCHITECTURE_ALPHA64:
2005 arch = "alpha64"; break;
2006#endif
2007#ifdef PROCESSOR_ARCHITECTURE_MSIL
2008 case PROCESSOR_ARCHITECTURE_MSIL:
2009 arch = "msil"; break;
2010#endif
2011#ifdef PROCESSOR_ARCHITECTURE_AMD64
2012 case PROCESSOR_ARCHITECTURE_AMD64:
2013 arch = "amd64"; break;
2014#endif
2015#ifdef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
2016 case PROCESSOR_ARCHITECTURE_IA32_ON_WIN64:
2017 arch = "ia32-64"; break;
2018#endif
2019#ifdef PROCESSOR_ARCHITECTURE_UNKNOWN
2020 case PROCESSOR_ARCHITECTURE_UNKNOWN:
b2af26b1 2021 arch = "unknown"; break;
fe537c65
GS		 2022#endif
2023 default:
2024 sprintf(name->machine, "unknown(0x%x)", procarch);
2025 arch = name->machine;
2026 break;
b2af26b1 2027 }
fe537c65
GS		 2028 if (name->machine != arch)
2029 strcpy(name->machine, arch);
b2af26b1
GS		 2030 }
2031 return 0;
2032}
2033
8fb3fcfb
NIS		 2034/* Timing related stuff */
2035
3fadfdf1
NIS		 2036int
2037do_raise(pTHX_ int sig)
2038{
2039 if (sig < SIG_SIZE) {
2040 Sighandler_t handler = w32_sighandler[sig];
2041 if (handler == SIG_IGN) {
2042 return 0;
2043 }
2044 else if (handler != SIG_DFL) {
2045 (*handler)(sig);
2046 return 0;
2047 }
2048 else {
2049 /* Choose correct default behaviour */
2050 switch (sig) {
2051#ifdef SIGCLD
2052 case SIGCLD:
2053#endif
2054#ifdef SIGCHLD
2055 case SIGCHLD:
2056#endif
2057 case 0:
2058 return 0;
2059 case SIGTERM:
2060 default:
2061 break;
2062 }
2063 }
2064 }
2065 /* Tell caller to exit thread/process as approriate */
2066 return 1;
2067}
2068
2069void
2070sig_terminate(pTHX_ int sig)
2071{
2072 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2073 /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2074 thread
2075 */
2076 exit(sig);
2077}
2078
8fb3fcfb
NIS		 2079DllExport int
2080win32_async_check(pTHX)
2081{
2082 MSG msg;
aeecf691
JD		 2083 HWND hwnd = w32_message_hwnd;
2084
2085 w32_poll_count = 0;
2086
c71e9bcc
JD		 2087 if (hwnd == INVALID_HANDLE_VALUE) {
2088 /* Call PeekMessage() to mark all pending messages in the queue as "old".
2089 * This is necessary when we are being called by win32_msgwait() to
2090 * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2091 * message over and over. An example how this can happen is when
2092 * Perl is calling win32_waitpid() inside a GUI application and the GUI
2093 * is generating messages before the process terminated.
2094 */
2095 PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
41ee5757
JD		 2096 if (PL_sig_pending)
2097 despatch_signals();
aeecf691 2098 return 1;
c71e9bcc 2099 }
aeecf691 2100
7e5f34c0
NIS		 2101 /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
2102 * and ignores window messages - should co-exist better with windows apps e.g. Tk
3fadfdf1 2103 */
aeecf691
JD		 2104 if (hwnd == NULL)
2105 hwnd = (HWND)-1;
8fb3fcfb 2106
aeecf691
JD		 2107 while (PeekMessage(&msg, hwnd, WM_TIMER, WM_TIMER, PM_REMOVE|PM_NOYIELD) ||
2108 PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2109 {
2110 switch (msg.message) {
2111#ifdef USE_ITHREADS
2112 case WM_USER_MESSAGE: {
2113 int child = find_pseudo_pid(msg.wParam);
2114 if (child >= 0)
2115 w32_pseudo_child_message_hwnds[child] = (HWND)msg.lParam;
2116 break;
2117 }
7e5f34c0
NIS		 2118#endif
2119
aeecf691
JD		 2120 case WM_USER_KILL: {
2121 /* We use WM_USER to fake kill() with other signals */
2122 int sig = msg.wParam;
2123 if (do_raise(aTHX_ sig))
2124 sig_terminate(aTHX_ sig);
8fb3fcfb
NIS		 2125 break;
2126 }
3fadfdf1 2127
8fb3fcfb
NIS		 2128 case WM_TIMER: {
2129 /* alarm() is a one-shot but SetTimer() repeats so kill it */
26549e08 2130 if (w32_timerid && w32_timerid==msg.wParam) {
aeecf691 2131 KillTimer(w32_message_hwnd, w32_timerid);
3fadfdf1 2132 w32_timerid=0;
8fb3fcfb 2133
aeecf691
JD		 2134 /* Now fake a call to signal handler */
2135 if (do_raise(aTHX_ 14))
2136 sig_terminate(aTHX_ 14);
2137 }
8fb3fcfb
NIS		 2138 break;
2139 }
aeecf691 2140 } /* switch */
8fb3fcfb
NIS		 2141 }
2142
7e5f34c0 2143 /* Above or other stuff may have set a signal flag */
8fb3fcfb
NIS		 2144 if (PL_sig_pending) {
2145 despatch_signals();
2146 }
aeecf691 2147 return 1;
8fb3fcfb
NIS		 2148}
2149
089197fa
GS		 2150/* This function will not return until the timeout has elapsed, or until
2151 * one of the handles is ready. */
8fb3fcfb
NIS		 2152DllExport DWORD
2153win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2154{
2155 /* We may need several goes at this - so compute when we stop */
2156 DWORD ticks = 0;
2157 if (timeout != INFINITE) {
2158 ticks = GetTickCount();
2159 timeout += ticks;
2160 }
2161 while (1) {
29e13651 2162 DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_POSTMESSAGE|QS_TIMER);
8fb3fcfb
NIS		 2163 if (resultp)
2164 *resultp = result;
2165 if (result == WAIT_TIMEOUT) {
3fadfdf1
NIS		 2166 /* Ran out of time - explicit return of zero to avoid -ve if we
2167 have scheduling issues
2168 */
8fb3fcfb
NIS		 2169 return 0;
2170 }
2171 if (timeout != INFINITE) {
2172 ticks = GetTickCount();
2173 }
2174 if (result == WAIT_OBJECT_0 + count) {
2175 /* Message has arrived - check it */
089197fa 2176 (void)win32_async_check(aTHX);
8fb3fcfb
NIS		 2177 }
2178 else {
2179 /* Not timeout or message - one of handles is ready */
2180 break;
2181 }
2182 }
2183 /* compute time left to wait */
2184 ticks = timeout - ticks;
2185 /* If we are past the end say zero */
2186 return (ticks > 0) ? ticks : 0;
2187}
2188
932b7487
RC		 2189int
2190win32_internal_wait(int *status, DWORD timeout)
2191{
2192 /* XXX this wait emulation only knows about processes
2193 * spawned via win32_spawnvp(P_NOWAIT, ...).
2194 */
2195 dTHX;
2196 int i, retval;
2197 DWORD exitcode, waitcode;
2198
2199#ifdef USE_ITHREADS
2200 if (w32_num_pseudo_children) {
8fb3fcfb
NIS		 2201 win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2202 timeout, &waitcode);
932b7487
RC		 2203 /* Time out here if there are no other children to wait for. */
2204 if (waitcode == WAIT_TIMEOUT) {
2205 if (!w32_num_children) {
2206 return 0;
2207 }
2208 }
2209 else if (waitcode != WAIT_FAILED) {
2210 if (waitcode >= WAIT_ABANDONED_0
2211 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2212 i = waitcode - WAIT_ABANDONED_0;
2213 else
2214 i = waitcode - WAIT_OBJECT_0;
2215 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2216 *status = (int)((exitcode & 0xff) << 8);
2217 retval = (int)w32_pseudo_child_pids[i];
2218 remove_dead_pseudo_process(i);
2219 return -retval;
2220 }
2221 }
2222 }
2223#endif
2224
2225 if (!w32_num_children) {
2226 errno = ECHILD;
2227 return -1;
2228 }
2229
2230 /* if a child exists, wait for it to die */
8fb3fcfb 2231 win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
932b7487
RC		 2232 if (waitcode == WAIT_TIMEOUT) {
2233 return 0;
2234 }
2235 if (waitcode != WAIT_FAILED) {
2236 if (waitcode >= WAIT_ABANDONED_0
2237 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2238 i = waitcode - WAIT_ABANDONED_0;
2239 else
2240 i = waitcode - WAIT_OBJECT_0;
2241 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2242 *status = (int)((exitcode & 0xff) << 8);
2243 retval = (int)w32_child_pids[i];
2244 remove_dead_process(i);
2245 return retval;
2246 }
2247 }
2248
932b7487
RC		 2249 errno = GetLastError();
2250 return -1;
2251}
2252
b2af26b1 2253DllExport int
f55ee38a
GS		 2254win32_waitpid(int pid, int *status, int flags)
2255{
acfe0abc 2256 dTHX;
922b1888 2257 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
0aaad0ff 2258 int retval = -1;
c66b022d 2259 long child;
7766f137 2260 if (pid == -1) /* XXX threadid == 1 ? */
932b7487 2261 return win32_internal_wait(status, timeout);
7766f137
GS		 2262#ifdef USE_ITHREADS
2263 else if (pid < 0) {
c66b022d 2264 child = find_pseudo_pid(-pid);
7766f137
GS		 2265 if (child >= 0) {
2266 HANDLE hThread = w32_pseudo_child_handles[child];
8fb3fcfb
NIS		 2267 DWORD waitcode;
2268 win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2f67576d
BC		 2269 if (waitcode == WAIT_TIMEOUT) {
2270 return 0;
2271 }
8fb3fcfb 2272 else if (waitcode == WAIT_OBJECT_0) {
7766f137
GS		 2273 if (GetExitCodeThread(hThread, &waitcode)) {
2274 *status = (int)((waitcode & 0xff) << 8);
2275 retval = (int)w32_pseudo_child_pids[child];
2276 remove_dead_pseudo_process(child);
68a29c53 2277 return -retval;
7766f137
GS		 2278 }
2279 }
2280 else
2281 errno = ECHILD;
2282 }
922b1888
GS		 2283 else if (IsWin95()) {
2284 pid = -pid;
2285 goto alien_process;
2286 }
7766f137
GS		 2287 }
2288#endif
f55ee38a 2289 else {
922b1888
GS		 2290 HANDLE hProcess;
2291 DWORD waitcode;
c66b022d 2292 child = find_pid(pid);
0aaad0ff 2293 if (child >= 0) {
922b1888 2294 hProcess = w32_child_handles[child];
8fb3fcfb 2295 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
a7867d0a
GS		 2296 if (waitcode == WAIT_TIMEOUT) {
2297 return 0;
2298 }
8fb3fcfb 2299 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS		 2300 if (GetExitCodeProcess(hProcess, &waitcode)) {
2301 *status = (int)((waitcode & 0xff) << 8);
2302 retval = (int)w32_child_pids[child];
2303 remove_dead_process(child);
2304 return retval;
2305 }
a7867d0a 2306 }
0aaad0ff
GS		 2307 else
2308 errno = ECHILD;
2309 }
2310 else {
922b1888
GS		 2311alien_process:
2312 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
2313 (IsWin95() ? -pid : pid));
2314 if (hProcess) {
8fb3fcfb 2315 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
922b1888 2316 if (waitcode == WAIT_TIMEOUT) {
48db714f 2317 CloseHandle(hProcess);
922b1888
GS		 2318 return 0;
2319 }
8fb3fcfb 2320 else if (waitcode == WAIT_OBJECT_0) {
922b1888
GS		 2321 if (GetExitCodeProcess(hProcess, &waitcode)) {
2322 *status = (int)((waitcode & 0xff) << 8);
2323 CloseHandle(hProcess);
2324 return pid;
2325 }
2326 }
2327 CloseHandle(hProcess);
2328 }
2329 else
2330 errno = ECHILD;
0aaad0ff 2331 }
f55ee38a 2332 }
3fadfdf1 2333 return retval >= 0 ? pid : retval;
f55ee38a
GS		 2334}
2335
2336DllExport int
2d7a9237
GS		 2337win32_wait(int *status)
2338{
932b7487 2339 return win32_internal_wait(status, INFINITE);
2d7a9237 2340}
d55594ae 2341
8fb3fcfb
NIS		 2342DllExport unsigned int
2343win32_sleep(unsigned int t)
d55594ae 2344{
acfe0abc 2345 dTHX;
8fb3fcfb
NIS		 2346 /* Win32 times are in ms so *1000 in and /1000 out */
2347 return win32_msgwait(aTHX_ 0, NULL, t*1000, NULL)/1000;
d55594ae
GS		 2348}
2349
f3986ebb
GS		 2350DllExport unsigned int
2351win32_alarm(unsigned int sec)
0a753a76 2352{
3fadfdf1 2353 /*
d55594ae 2354 * the 'obvious' implentation is SetTimer() with a callback
3fadfdf1
NIS		 2355 * which does whatever receiving SIGALRM would do
2356 * we cannot use SIGALRM even via raise() as it is not
d55594ae 2357 * one of the supported codes in <signal.h>
3fadfdf1 2358 */
acfe0abc 2359 dTHX;
aeecf691
JD		 2360
2361 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2362 w32_message_hwnd = win32_create_message_window();
2363
8fb3fcfb 2364 if (sec) {
aeecf691
JD		 2365 if (w32_message_hwnd == NULL)
2366 w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2367 else {
2368 w32_timerid = 1;
2369 SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2370 }
8fb3fcfb
NIS		 2371 }
2372 else {
2373 if (w32_timerid) {
aeecf691
JD		 2374 KillTimer(w32_message_hwnd, w32_timerid);
2375 w32_timerid = 0;
8fb3fcfb 2376 }
3fadfdf1 2377 }
afe91769 2378 return 0;
0a753a76 2379}
2380
26618a56 2381#ifdef HAVE_DES_FCRYPT
2d77217b 2382extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
ff95b63e 2383#endif
26618a56
GS		 2384
2385DllExport char *
2386win32_crypt(const char *txt, const char *salt)
2387{
acfe0abc 2388 dTHX;
ff95b63e 2389#ifdef HAVE_DES_FCRYPT
3352bfcb 2390 return des_fcrypt(txt, salt, w32_crypt_buffer);
ff95b63e 2391#else
25dbdbbc 2392 Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
b8957cf1 2393 return Nullch;
ff95b63e 2394#endif
26618a56 2395}
26618a56 2396
9e5f57de 2397#ifdef USE_FIXED_OSFHANDLE
390b85e7
GS		 2398
2399#define FOPEN 0x01 /* file handle open */
b181b6fb 2400#define FNOINHERIT 0x10 /* file handle opened O_NOINHERIT */
390b85e7
GS		 2401#define FAPPEND 0x20 /* file handle opened O_APPEND */
2402#define FDEV 0x40 /* file handle refers to device */
2403#define FTEXT 0x80 /* file handle is in text mode */
2404
390b85e7 2405/***
c623ac67 2406*int my_open_osfhandle(intptr_t osfhandle, int flags) - open C Runtime file handle
390b85e7
GS		 2407*
2408*Purpose:
2409* This function allocates a free C Runtime file handle and associates
2410* it with the Win32 HANDLE specified by the first parameter. This is a
9e5f57de
GS		 2411* temperary fix for WIN95's brain damage GetFileType() error on socket
2412* we just bypass that call for socket
2413*
2414* This works with MSVC++ 4.0+ or GCC/Mingw32
390b85e7
GS		 2415*
2416*Entry:
c623ac67 2417* intptr_t osfhandle - Win32 HANDLE to associate with C Runtime file handle.
390b85e7
GS		 2418* int flags - flags to associate with C Runtime file handle.
2419*
2420*Exit:
2421* returns index of entry in fh, if successful
2422* return -1, if no free entry is found
2423*
2424*Exceptions:
2425*
2426*******************************************************************************/
2427
9e5f57de
GS		 2428/*
2429 * we fake up some parts of the CRT that aren't exported by MSVCRT.dll
2430 * this lets sockets work on Win9X with GCC and should fix the problems
2431 * with perl95.exe
2432 * -- BKS, 1-23-2000
2433*/
2434
9e5f57de
GS		 2435/* create an ioinfo entry, kill its handle, and steal the entry */
2436
b181b6fb
GS		 2437static int
2438_alloc_osfhnd(void)
9e5f57de
GS		 2439{
2440 HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL);
c623ac67 2441 int fh = _open_osfhandle((intptr_t)hF, 0);
9e5f57de
GS		 2442 CloseHandle(hF);
2443 if (fh == -1)
2444 return fh;
2445 EnterCriticalSection(&(_pioinfo(fh)->lock));
2446 return fh;
2447}
2448
390b85e7 2449static int
c623ac67 2450my_open_osfhandle(intptr_t osfhandle, int flags)
390b85e7
GS		 2451{
2452 int fh;
2453 char fileflags; /* _osfile flags */
2454
2455 /* copy relevant flags from second parameter */
2456 fileflags = FDEV;
2457
9404a519 2458 if (flags & O_APPEND)
390b85e7
GS		 2459 fileflags |= FAPPEND;
2460
9404a519 2461 if (flags & O_TEXT)
390b85e7
GS		 2462 fileflags |= FTEXT;
2463
b181b6fb
GS		 2464 if (flags & O_NOINHERIT)
2465 fileflags |= FNOINHERIT;
2466
390b85e7 2467 /* attempt to allocate a C Runtime file handle */
9404a519 2468 if ((fh = _alloc_osfhnd()) == -1) {
390b85e7
GS		 2469 errno = EMFILE; /* too many open files */
2470 _doserrno = 0L; /* not an OS error */
2471 return -1; /* return error to caller */
2472 }
2473
2474 /* the file is open. now, set the info in _osfhnd array */
2475 _set_osfhnd(fh, osfhandle);
2476
2477 fileflags |= FOPEN; /* mark as open */
2478
390b85e7 2479 _osfile(fh) = fileflags; /* set osfile entry */
dd8f4818 2480 LeaveCriticalSection(&_pioinfo(fh)->lock);
390b85e7
GS		 2481
2482 return fh; /* return handle */
2483}
2484
f3986ebb 2485#endif /* USE_FIXED_OSFHANDLE */
390b85e7
GS		 2486
2487/* simulate flock by locking a range on the file */
2488
2489#define LK_ERR(f,i) ((f) ? (i = 0) : (errno = GetLastError()))
2490#define LK_LEN 0xffff0000
2491
f3986ebb
GS		 2492DllExport int
2493win32_flock(int fd, int oper)
390b85e7
GS		 2494{
2495 OVERLAPPED o;
2496 int i = -1;
2497 HANDLE fh;
2498
f3986ebb 2499 if (!IsWinNT()) {
acfe0abc 2500 dTHX;
4f63d024 2501 Perl_croak_nocontext("flock() unimplemented on this platform");
f3986ebb
GS		 2502 return -1;
2503 }
390b85e7
GS		 2504 fh = (HANDLE)_get_osfhandle(fd);
2505 memset(&o, 0, sizeof(o));
2506
2507 switch(oper) {
2508 case LOCK_SH: /* shared lock */
2509 LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
2510 break;
2511 case LOCK_EX: /* exclusive lock */
2512 LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
2513 break;
2514 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
2515 LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
2516 break;
2517 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
2518 LK_ERR(LockFileEx(fh,
2519 LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2520 0, LK_LEN, 0, &o),i);
2521 break;
2522 case LOCK_UN: /* unlock lock */
2523 LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
2524 break;
2525 default: /* unknown */
2526 errno = EINVAL;
2527 break;
2528 }
2529 return i;
2530}
2531
2532#undef LK_ERR
2533#undef LK_LEN
2534
68dc0745 2535/*
2536 * redirected io subsystem for all XS modules
2537 *
2538 */
0a753a76 2539
68dc0745 2540DllExport int *
2541win32_errno(void)
0a753a76 2542{
390b85e7 2543 return (&errno);
0a753a76 2544}
2545
dcb2879a
GS		 2546DllExport char ***
2547win32_environ(void)
2548{
390b85e7 2549 return (&(_environ));
dcb2879a
GS		 2550}
2551
68dc0745 2552/* the rest are the remapped stdio routines */
2553DllExport FILE *
2554win32_stderr(void)
0a753a76 2555{
390b85e7 2556 return (stderr);
0a753a76 2557}
2558
68dc0745 2559DllExport FILE *
2560win32_stdin(void)
0a753a76 2561{
390b85e7 2562 return (stdin);
0a753a76 2563}
2564
68dc0745 2565DllExport FILE *
2566win32_stdout()
0a753a76 2567{
390b85e7 2568 return (stdout);
0a753a76 2569}
2570
68dc0745 2571DllExport int
2572win32_ferror(FILE *fp)
0a753a76 2573{
390b85e7 2574 return (ferror(fp));
0a753a76 2575}
2576
2577
68dc0745 2578DllExport int
2579win32_feof(FILE *fp)
0a753a76 2580{
390b85e7 2581 return (feof(fp));
0a753a76 2582}
2583
68dc0745 2584/*
3fadfdf1 2585 * Since the errors returned by the socket error function
68dc0745 2586 * WSAGetLastError() are not known by the library routine strerror
2587 * we have to roll our own.
2588 */
0a753a76 2589
68dc0745 2590DllExport char *
3fadfdf1 2591win32_strerror(int e)
0a753a76 2592{
6f24f39d 2593#if !defined __BORLANDC__ && !defined __MINGW32__ /* compiler intolerance */
68dc0745 2594 extern int sys_nerr;
3e3baf6d 2595#endif
68dc0745 2596 DWORD source = 0;
0a753a76 2597
9404a519 2598 if (e < 0 || e > sys_nerr) {
acfe0abc 2599 dTHX;
9404a519 2600 if (e < 0)
68dc0745 2601 e = GetLastError();
0a753a76 2602
9404a519 2603 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
3352bfcb 2604 w32_strerror_buffer,
3fadfdf1 2605 sizeof(w32_strerror_buffer), NULL) == 0)
3352bfcb 2606 strcpy(w32_strerror_buffer, "Unknown Error");
0a753a76 2607
3352bfcb 2608 return w32_strerror_buffer;
68dc0745 2609 }
390b85e7 2610 return strerror(e);
0a753a76 2611}
2612
22fae026 2613DllExport void
c5be433b 2614win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM		 2615{
2616 DWORD dwLen;
2617 char *sMsg;
2618 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
2619 |FORMAT_MESSAGE_IGNORE_INSERTS
2620 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2621 dwErr, 0, (char *)&sMsg, 1, NULL);
2ce77adf 2622 /* strip trailing whitespace and period */
22fae026 2623 if (0 < dwLen) {
2ce77adf
GS		 2624 do {
2625 --dwLen; /* dwLen doesn't include trailing null */
2626 } while (0 < dwLen && isSPACE(sMsg[dwLen]));
22fae026
TM		 2627 if ('.' != sMsg[dwLen])
2628 dwLen++;
2ce77adf 2629 sMsg[dwLen] = '\0';
22fae026
TM		 2630 }
2631 if (0 == dwLen) {
c69f6586 2632 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
db7c17d7
GS		 2633 if (sMsg)
2634 dwLen = sprintf(sMsg,
2635 "Unknown error #0x%lX (lookup 0x%lX)",
2636 dwErr, GetLastError());
2637 }
2638 if (sMsg) {
acfe0abc 2639 dTHX;
db7c17d7
GS		 2640 sv_setpvn((SV*)sv, sMsg, dwLen);
2641 LocalFree(sMsg);
22fae026 2642 }
22fae026
TM		 2643}
2644
68dc0745 2645DllExport int
2646win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 2647{
68dc0745 2648 va_list marker;
2649 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2650
390b85e7 2651 return (vfprintf(fp, format, marker));
0a753a76 2652}
2653
68dc0745 2654DllExport int
2655win32_printf(const char *format, ...)
0a753a76 2656{
68dc0745 2657 va_list marker;
2658 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 2659
390b85e7 2660 return (vprintf(format, marker));
0a753a76 2661}
2662
68dc0745 2663DllExport int
2664win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 2665{
390b85e7 2666 return (vfprintf(fp, format, args));
0a753a76 2667}
2668
96e4d5b1 2669DllExport int
2670win32_vprintf(const char *format, va_list args)
2671{
390b85e7 2672 return (vprintf(format, args));
96e4d5b1 2673}
2674
68dc0745 2675DllExport size_t
2676win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2677{
390b85e7 2678 return fread(buf, size, count, fp);
0a753a76 2679}
2680
68dc0745 2681DllExport size_t
2682win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 2683{
390b85e7 2684 return fwrite(buf, size, count, fp);
0a753a76 2685}
2686
7fac1903
GS		 2687#define MODE_SIZE 10
2688
68dc0745 2689DllExport FILE *
2690win32_fopen(const char *filename, const char *mode)
0a753a76 2691{
acfe0abc 2692 dTHX;
1c5905c2 2693 FILE *f;
3fadfdf1 2694
c5be433b
GS		 2695 if (!*filename)
2696 return NULL;
2697
68dc0745 2698 if (stricmp(filename, "/dev/null")==0)
7fac1903
GS		 2699 filename = "NUL";
2700
8c56068e 2701 f = fopen(PerlDir_mapA(filename), mode);
1c5905c2
GS		 2702 /* avoid buffering headaches for child processes */
2703 if (f && *mode == 'a')
2704 win32_fseek(f, 0, SEEK_END);
2705 return f;
0a753a76 2706}
2707
f3986ebb
GS		 2708#ifndef USE_SOCKETS_AS_HANDLES
2709#undef fdopen
2710#define fdopen my_fdopen
2711#endif
2712
68dc0745 2713DllExport FILE *
7fac1903 2714win32_fdopen(int handle, const char *mode)
0a753a76 2715{
acfe0abc 2716 dTHX;
1c5905c2 2717 FILE *f;
8c56068e 2718 f = fdopen(handle, (char *) mode);
1c5905c2
GS		 2719 /* avoid buffering headaches for child processes */
2720 if (f && *mode == 'a')
2721 win32_fseek(f, 0, SEEK_END);
2722 return f;
0a753a76 2723}
2724
68dc0745 2725DllExport FILE *
7fac1903 2726win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 2727{
acfe0abc 2728 dTHX;
68dc0745 2729 if (stricmp(path, "/dev/null")==0)
7fac1903
GS		 2730 path = "NUL";
2731
7766f137 2732 return freopen(PerlDir_mapA(path), mode, stream);
0a753a76 2733}
2734
68dc0745 2735DllExport int
2736win32_fclose(FILE *pf)
0a753a76 2737{
f3986ebb 2738 return my_fclose(pf); /* defined in win32sck.c */
0a753a76 2739}
2740
68dc0745 2741DllExport int
2742win32_fputs(const char *s,FILE *pf)
0a753a76 2743{
390b85e7 2744 return fputs(s, pf);
0a753a76 2745}
2746
68dc0745 2747DllExport int
2748win32_fputc(int c,FILE *pf)
0a753a76 2749{
390b85e7 2750 return fputc(c,pf);
0a753a76 2751}
2752
68dc0745 2753DllExport int
2754win32_ungetc(int c,FILE *pf)
0a753a76 2755{
390b85e7 2756 return ungetc(c,pf);
0a753a76 2757}
2758
68dc0745 2759DllExport int
2760win32_getc(FILE *pf)
0a753a76 2761{
390b85e7 2762 return getc(pf);
0a753a76 2763}
2764
68dc0745 2765DllExport int
2766win32_fileno(FILE *pf)
0a753a76 2767{
390b85e7 2768 return fileno(pf);
0a753a76 2769}
2770
68dc0745 2771DllExport void
2772win32_clearerr(FILE *pf)
0a753a76 2773{
390b85e7 2774 clearerr(pf);
68dc0745 2775 return;
0a753a76 2776}
2777
68dc0745 2778DllExport int
2779win32_fflush(FILE *pf)
0a753a76 2780{
390b85e7 2781 return fflush(pf);
0a753a76 2782}
2783
c623ac67 2784DllExport Off_t
68dc0745 2785win32_ftell(FILE *pf)
0a753a76 2786{
c623ac67 2787#if defined(WIN64) || defined(USE_LARGE_FILES)
56460430 2788#if defined(__BORLANDC__) /* buk */
a810272a
NS		 2789 return win32_tell( fileno( pf ) );
2790#else
c623ac67
GS		 2791 fpos_t pos;
2792 if (fgetpos(pf, &pos))
2793 return -1;
2794 return (Off_t)pos;
a810272a 2795#endif
c623ac67 2796#else
390b85e7 2797 return ftell(pf);
c623ac67 2798#endif
0a753a76 2799}
2800
68dc0745 2801DllExport int
c623ac67 2802win32_fseek(FILE *pf, Off_t offset,int origin)
0a753a76 2803{
c623ac67 2804#if defined(WIN64) || defined(USE_LARGE_FILES)
a810272a
NS		 2805#if defined(__BORLANDC__) /* buk */
2806 return win32_lseek(
2807 fileno(pf),
2808 offset,
2809 origin
2810 );
2811#else
c623ac67
GS		 2812 fpos_t pos;
2813 switch (origin) {
2814 case SEEK_CUR:
2815 if (fgetpos(pf, &pos))
2816 return -1;
2817 offset += pos;
2818 break;
2819 case SEEK_END:
2820 fseek(pf, 0, SEEK_END);
2821 pos = _telli64(fileno(pf));
2822 offset += pos;
2823 break;
2824 case SEEK_SET:
2825 break;
2826 default:
2827 errno = EINVAL;
2828 return -1;
2829 }
2830 return fsetpos(pf, &offset);
a810272a 2831#endif
c623ac67 2832#else
8859a7a0 2833 return fseek(pf, (long)offset, origin);
c623ac67 2834#endif
0a753a76 2835}
2836
68dc0745 2837DllExport int
2838win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 2839{
a810272a
NS		 2840#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
2841 if( win32_tell(fileno(pf)) == -1L ) {
2842 errno = EBADF;
2843 return -1;
2844 }
2845 return 0;
2846#else
390b85e7 2847 return fgetpos(pf, p);
a810272a 2848#endif
0a753a76 2849}
2850
68dc0745 2851DllExport int
2852win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 2853{
a810272a
NS		 2854#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
2855 return win32_lseek(fileno(pf), *p, SEEK_CUR);
2856#else
390b85e7 2857 return fsetpos(pf, p);
a810272a 2858#endif
0a753a76 2859}
2860
68dc0745 2861DllExport void
2862win32_rewind(FILE *pf)
0a753a76 2863{
390b85e7 2864 rewind(pf);
68dc0745 2865 return;
0a753a76 2866}
2867
2941a2e1
JH		 2868DllExport int
2869win32_tmpfd(void)
0a753a76 2870{
b3122bc4
JH		 2871 dTHX;
2872 char prefix[MAX_PATH+1];
2873 char filename[MAX_PATH+1];
2874 DWORD len = GetTempPath(MAX_PATH, prefix);
2875 if (len && len < MAX_PATH) {
2876 if (GetTempFileName(prefix, "plx", 0, filename)) {
2877 HANDLE fh = CreateFile(filename,
2878 DELETE | GENERIC_READ | GENERIC_WRITE,
2879 0,
2880 NULL,
2881 CREATE_ALWAYS,
2882 FILE_ATTRIBUTE_NORMAL
2883 | FILE_FLAG_DELETE_ON_CLOSE,
2884 NULL);
2885 if (fh != INVALID_HANDLE_VALUE) {
c623ac67 2886 int fd = win32_open_osfhandle((intptr_t)fh, 0);
b3122bc4 2887 if (fd >= 0) {
a051bdb4
VK		 2888#if defined(__BORLANDC__)
2889 setmode(fd,O_BINARY);
2890#endif
b3122bc4
JH		 2891 DEBUG_p(PerlIO_printf(Perl_debug_log,
2892 "Created tmpfile=%s\n",filename));
2941a2e1 2893 return fd;
b3122bc4
JH		 2894 }
2895 }
2896 }
2897 }
2941a2e1
JH		 2898 return -1;
2899}
2900
2901DllExport FILE*
2902win32_tmpfile(void)
2903{
2904 int fd = win32_tmpfd();
2905 if (fd >= 0)
2906 return win32_fdopen(fd, "w+b");
b3122bc4 2907 return NULL;
0a753a76 2908}
2909
68dc0745 2910DllExport void
2911win32_abort(void)
0a753a76 2912{
390b85e7 2913 abort();
68dc0745 2914 return;
0a753a76 2915}
2916
68dc0745 2917DllExport int
c623ac67 2918win32_fstat(int fd, Stat_t *sbufptr)
0a753a76 2919{
2a07f407
VK		 2920#ifdef __BORLANDC__
2921 /* A file designated by filehandle is not shown as accessible
2922 * for write operations, probably because it is opened for reading.
2923 * --Vadim Konovalov
3fadfdf1 2924 */
2a07f407 2925 BY_HANDLE_FILE_INFORMATION bhfi;
bda6ed21
PM		 2926#if defined(WIN64) || defined(USE_LARGE_FILES)
2927 /* Borland 5.5.1 has a 64-bit stat, but only a 32-bit fstat */
2928 struct stat tmp;
2929 int rc = fstat(fd,&tmp);
2930
2931 sbufptr->st_dev = tmp.st_dev;
2932 sbufptr->st_ino = tmp.st_ino;
2933 sbufptr->st_mode = tmp.st_mode;
2934 sbufptr->st_nlink = tmp.st_nlink;
2935 sbufptr->st_uid = tmp.st_uid;
2936 sbufptr->st_gid = tmp.st_gid;
2937 sbufptr->st_rdev = tmp.st_rdev;
2938 sbufptr->st_size = tmp.st_size;
2939 sbufptr->st_atime = tmp.st_atime;
2940 sbufptr->st_mtime = tmp.st_mtime;
2941 sbufptr->st_ctime = tmp.st_ctime;
2942#else
2943 int rc = fstat(fd,sbufptr);
2944#endif
2945
2a07f407 2946 if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) {
bda6ed21
PM		 2947#if defined(WIN64) || defined(USE_LARGE_FILES)
2948 sbufptr->st_size = (bhfi.nFileSizeHigh << 32) + bhfi.nFileSizeLow ;
2949#endif
2a07f407
VK		 2950 sbufptr->st_mode &= 0xFE00;
2951 if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
2952 sbufptr->st_mode |= (S_IREAD + (S_IREAD >> 3) + (S_IREAD >> 6));
2953 else
2954 sbufptr->st_mode |= ((S_IREAD|S_IWRITE) + ((S_IREAD|S_IWRITE) >> 3)
2955 + ((S_IREAD|S_IWRITE) >> 6));
2956 }
2957 return rc;
2958#else
ed59ec62 2959 return my_fstat(fd,sbufptr);
2a07f407 2960#endif
0a753a76 2961}
2962
68dc0745 2963DllExport int
2964win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 2965{
390b85e7 2966 return _pipe(pfd, size, mode);
0a753a76 2967}
2968
8c0134a8
NIS		 2969DllExport PerlIO*
2970win32_popenlist(const char *mode, IV narg, SV **args)
2971{
2972 dTHX;
2973 Perl_croak(aTHX_ "List form of pipe open not implemented");
2974 return NULL;
2975}
2976
50892819
GS		 2977/*
2978 * a popen() clone that respects PERL5SHELL
00b02797
JH		 2979 *
2980 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
50892819
GS		 2981 */
2982
00b02797 2983DllExport PerlIO*
68dc0745 2984win32_popen(const char *command, const char *mode)
0a753a76 2985{
4b556e6c 2986#ifdef USE_RTL_POPEN
390b85e7 2987 return _popen(command, mode);
50892819 2988#else
2cbbe5a1 2989 dTHX;
50892819
GS		 2990 int p[2];
2991 int parent, child;
2992 int stdfd, oldfd;
2993 int ourmode;
2994 int childpid;
1095be37
GS		 2995 DWORD nhandle;
2996 HANDLE old_h;
2997 int lock_held = 0;
50892819
GS		 2998
2999 /* establish which ends read and write */
3000 if (strchr(mode,'w')) {
3001 stdfd = 0; /* stdin */
3002 parent = 1;
3003 child = 0;
1095be37 3004 nhandle = STD_INPUT_HANDLE;
50892819
GS		 3005 }
3006 else if (strchr(mode,'r')) {
3007 stdfd = 1; /* stdout */
3008 parent = 0;
3009 child = 1;
1095be37 3010 nhandle = STD_OUTPUT_HANDLE;
50892819
GS		 3011 }
3012 else
3013 return NULL;
3014
3015 /* set the correct mode */
3016 if (strchr(mode,'b'))
3017 ourmode = O_BINARY;
3018 else if (strchr(mode,'t'))
3019 ourmode = O_TEXT;
3020 else
3021 ourmode = _fmode & (O_TEXT | O_BINARY);
3022
3023 /* the child doesn't inherit handles */
3024 ourmode |= O_NOINHERIT;
3025
1095be37 3026 if (win32_pipe(p, 512, ourmode) == -1)
50892819
GS		 3027 return NULL;
3028
498d7dc4
GS		 3029 /* save the old std handle (this needs to happen before the
3030 * dup2(), since that might call SetStdHandle() too) */
3031 OP_REFCNT_LOCK;
3032 lock_held = 1;
3033 old_h = GetStdHandle(nhandle);
3034
564914cd
AS		 3035 /* save current stdfd */
3036 if ((oldfd = win32_dup(stdfd)) == -1)
3037 goto cleanup;
3038
50892819
GS		 3039 /* make stdfd go to child end of pipe (implicitly closes stdfd) */
3040 /* stdfd will be inherited by the child */
3041 if (win32_dup2(p[child], stdfd) == -1)
3042 goto cleanup;
3043
3044 /* close the child end in parent */
3045 win32_close(p[child]);
3046
498d7dc4 3047 /* set the new std handle (in case dup2() above didn't) */
1095be37
GS		 3048 SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
3049
50892819 3050 /* start the child */
4f63d024 3051 {
acfe0abc 3052 dTHX;
c5be433b 3053 if ((childpid = do_spawn_nowait((char*)command)) == -1)
4f63d024 3054 goto cleanup;
50892819 3055
498d7dc4
GS		 3056 /* revert stdfd to whatever it was before */
3057 if (win32_dup2(oldfd, stdfd) == -1)
3058 goto cleanup;
3059
564914cd
AS		 3060 /* close saved handle */
3061 win32_close(oldfd);
3062
498d7dc4
GS		 3063 /* restore the old std handle (this needs to happen after the
3064 * dup2(), since that might call SetStdHandle() too */
1095be37
GS		 3065 if (lock_held) {
3066 SetStdHandle(nhandle, old_h);
3067 OP_REFCNT_UNLOCK;
3068 lock_held = 0;
3069 }
3070
4755096e 3071 LOCK_FDPID_MUTEX;
4f63d024 3072 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
4755096e 3073 UNLOCK_FDPID_MUTEX;
d91d68c1
RS		 3074
3075 /* set process id so that it can be returned by perl's open() */
3076 PL_forkprocess = childpid;
4f63d024 3077 }
50892819
GS		 3078
3079 /* we have an fd, return a file stream */
00b02797 3080 return (PerlIO_fdopen(p[parent], (char *)mode));
50892819
GS		 3081
3082cleanup:
3083 /* we don't need to check for errors here */
3084 win32_close(p[0]);
3085 win32_close(p[1]);
564914cd
AS		 3086 if (oldfd != -1) {
3087 win32_dup2(oldfd, stdfd);
3088 win32_close(oldfd);
3089 }
1095be37
GS		 3090 if (lock_held) {
3091 SetStdHandle(nhandle, old_h);
3092 OP_REFCNT_UNLOCK;
3093 lock_held = 0;
3094 }
50892819
GS		 3095 return (NULL);
3096
4b556e6c 3097#endif /* USE_RTL_POPEN */
0a753a76 3098}
3099
50892819
GS		 3100/*
3101 * pclose() clone
3102 */
3103
68dc0745 3104DllExport int
00b02797 3105win32_pclose(PerlIO *pf)
0a753a76 3106{
4b556e6c 3107#ifdef USE_RTL_POPEN
390b85e7 3108 return _pclose(pf);
50892819 3109#else
acfe0abc 3110 dTHX;
e17cb2a9
JD		 3111 int childpid, status;
3112 SV *sv;
3113
4755096e 3114 LOCK_FDPID_MUTEX;
00b02797 3115 sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
4755096e 3116
e17cb2a9
JD		 3117 if (SvIOK(sv))
3118 childpid = SvIVX(sv);
3119 else
3120 childpid = 0;
50892819
GS		 3121
3122 if (!childpid) {
db2fab48 3123 UNLOCK_FDPID_MUTEX;
50892819
GS		 3124 errno = EBADF;
3125 return -1;
3126 }
3127
00b02797
JH		 3128#ifdef USE_PERLIO
3129 PerlIO_close(pf);
3130#else
3131 fclose(pf);
3132#endif
e17cb2a9 3133 SvIVX(sv) = 0;
4755096e 3134 UNLOCK_FDPID_MUTEX;
e17cb2a9 3135
0aaad0ff
GS		 3136 if (win32_waitpid(childpid, &status, 0) == -1)
3137 return -1;
50892819 3138
0aaad0ff 3139 return status;
50892819 3140
4b556e6c 3141#endif /* USE_RTL_POPEN */
0a753a76 3142}
6b980173
JD		 3143
3144static BOOL WINAPI
3145Nt4CreateHardLinkW(
3146 LPCWSTR lpFileName,
3147 LPCWSTR lpExistingFileName,
3148 LPSECURITY_ATTRIBUTES lpSecurityAttributes)
3149{
3150 HANDLE handle;
3151 WCHAR wFullName[MAX_PATH+1];
3152 LPVOID lpContext = NULL;
3153 WIN32_STREAM_ID StreamId;
3154 DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId;
3155 DWORD dwWritten;
3156 DWORD dwLen;
3157 BOOL bSuccess;
3158
3159 BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD,
3160 BOOL, BOOL, LPVOID*) =
3161 (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD,
3162 BOOL, BOOL, LPVOID*))
3163 GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite");
3164 if (pfnBackupWrite == NULL)
3165 return 0;
3166
3167 dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL);
3168 if (dwLen == 0)
3169 return 0;
3170 dwLen = (dwLen+1)*sizeof(WCHAR);
3171
3172 handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES,
3173 FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
3174 NULL, OPEN_EXISTING, 0, NULL);
3175 if (handle == INVALID_HANDLE_VALUE)
3176 return 0;
3177
3178 StreamId.dwStreamId = BACKUP_LINK;
3179 StreamId.dwStreamAttributes = 0;
3180 StreamId.dwStreamNameSize = 0;
6f24f39d
JK		 3181#if defined(__BORLANDC__) \
3182 ||(defined(__MINGW32__) && !defined(_ANONYMOUS_UNION))
4ce4f76e
GS		 3183 StreamId.Size.u.HighPart = 0;
3184 StreamId.Size.u.LowPart = dwLen;
3185#else
6b980173
JD		 3186 StreamId.Size.HighPart = 0;
3187 StreamId.Size.LowPart = dwLen;
4ce4f76e 3188#endif
6b980173
JD		 3189
3190 bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
3191 FALSE, FALSE, &lpContext);
3192 if (bSuccess) {
3193 bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten,
3194 FALSE, FALSE, &lpContext);
3195 pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext);
3196 }
3197
3198 CloseHandle(handle);
3199 return bSuccess;
3200}
3201
3202DllExport int
3203win32_link(const char *oldname, const char *newname)
3204{
acfe0abc 3205 dTHX;
6b980173 3206 BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
82867ecf
GS		 3207 WCHAR wOldName[MAX_PATH+1];
3208 WCHAR wNewName[MAX_PATH+1];
6b980173
JD		 3209
3210 if (IsWin95())
1be9d9c6 3211 Perl_croak(aTHX_ PL_no_func, "link");
6b980173
JD		 3212
3213 pfnCreateHardLinkW =
3214 (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES))
3215 GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW");
3216 if (pfnCreateHardLinkW == NULL)
3217 pfnCreateHardLinkW = Nt4CreateHardLinkW;
3218
8c56068e
JD		 3219 if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3220 MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
7766f137 3221 (wcscpy(wOldName, PerlDir_mapW(wOldName)),
8c56068e 3222 pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
6b980173
JD		 3223 {
3224 return 0;
3225 }
3226 errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
3227 return -1;
3228}
0a753a76 3229
68dc0745 3230DllExport int
8d9b2e3c 3231win32_rename(const char *oname, const char *newname)
e24c7c18 3232{
65cb15a1
GS		 3233 char szOldName[MAX_PATH+1];
3234 char szNewName[MAX_PATH+1];
7fac1903 3235 BOOL bResult;
acfe0abc 3236 dTHX;
65cb15a1 3237
80252599
GS		 3238 /* XXX despite what the documentation says about MoveFileEx(),
3239 * it doesn't work under Windows95!
3240 */
3241 if (IsWinNT()) {
65cb15a1 3242 DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
8c56068e
JD		 3243 if (stricmp(newname, oname))
3244 dwFlags |= MOVEFILE_REPLACE_EXISTING;
3245 strcpy(szOldName, PerlDir_mapA(oname));
3246 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
7fac1903 3247 if (!bResult) {
80252599
GS		 3248 DWORD err = GetLastError();
3249 switch (err) {
3250 case ERROR_BAD_NET_NAME:
3251 case ERROR_BAD_NETPATH:
3252 case ERROR_BAD_PATHNAME:
3253 case ERROR_FILE_NOT_FOUND:
3254 case ERROR_FILENAME_EXCED_RANGE:
3255 case ERROR_INVALID_DRIVE:
3256 case ERROR_NO_MORE_FILES:
3257 case ERROR_PATH_NOT_FOUND:
3258 errno = ENOENT;
3259 break;
3260 default:
3261 errno = EACCES;
3262 break;
3263 }
3264 return -1;
3265 }
3266 return 0;
e24c7c18 3267 }
80252599
GS		 3268 else {
3269 int retval = 0;
65cb15a1 3270 char szTmpName[MAX_PATH+1];
80252599
GS		 3271 char dname[MAX_PATH+1];
3272 char *endname = Nullch;
3273 STRLEN tmplen = 0;
3274 DWORD from_attr, to_attr;
3275
65cb15a1
GS		 3276 strcpy(szOldName, PerlDir_mapA(oname));
3277 strcpy(szNewName, PerlDir_mapA(newname));
3278
80252599 3279 /* if oname doesn't exist, do nothing */
65cb15a1 3280 from_attr = GetFileAttributes(szOldName);
80252599
GS		 3281 if (from_attr == 0xFFFFFFFF) {
3282 errno = ENOENT;
3283 return -1;
3284 }
3285
3286 /* if newname exists, rename it to a temporary name so that we
3287 * don't delete it in case oname happens to be the same file
3288 * (but perhaps accessed via a different path)
3289 */
65cb15a1 3290 to_attr = GetFileAttributes(szNewName);
80252599
GS		 3291 if (to_attr != 0xFFFFFFFF) {
3292 /* if newname is a directory, we fail
3293 * XXX could overcome this with yet more convoluted logic */
3294 if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
3295 errno = EACCES;
3296 return -1;
3297 }
65cb15a1
GS		 3298 tmplen = strlen(szNewName);
3299 strcpy(szTmpName,szNewName);
3300 endname = szTmpName+tmplen;
3301 for (; endname > szTmpName ; --endname) {
80252599
GS		 3302 if (*endname == '/' || *endname == '\\') {
3303 *endname = '\0';
3304 break;
3305 }
3306 }
65cb15a1
GS		 3307 if (endname > szTmpName)
3308 endname = strcpy(dname,szTmpName);
e24c7c18 3309 else
80252599
GS		 3310 endname = ".";
3311
3312 /* get a temporary filename in same directory
3313 * XXX is this really the best we can do? */
65cb15a1 3314 if (!GetTempFileName((LPCTSTR)endname, "plr", 0, szTmpName)) {
80252599
GS		 3315 errno = ENOENT;
3316 return -1;
3317 }
65cb15a1 3318 DeleteFile(szTmpName);
80252599 3319
65cb15a1 3320 retval = rename(szNewName, szTmpName);
80252599
GS		 3321 if (retval != 0) {
3322 errno = EACCES;
3323 return retval;
e24c7c18
GS		 3324 }
3325 }
80252599
GS		 3326
3327 /* rename oname to newname */
65cb15a1 3328 retval = rename(szOldName, szNewName);
80252599
GS		 3329
3330 /* if we created a temporary file before ... */
3331 if (endname != Nullch) {
3332 /* ...and rename succeeded, delete temporary file/directory */
3333 if (retval == 0)
65cb15a1 3334 DeleteFile(szTmpName);
80252599
GS		 3335 /* else restore it to what it was */
3336 else
65cb15a1 3337 (void)rename(szTmpName, szNewName);
80252599
GS		 3338 }
3339 return retval;
e24c7c18 3340 }
e24c7c18
GS		 3341}
3342
3343DllExport int
68dc0745 3344win32_setmode(int fd, int mode)
0a753a76 3345{
390b85e7 3346 return setmode(fd, mode);
0a753a76 3347}
3348
4a9d6100
GS		 3349DllExport int
3350win32_chsize(int fd, Off_t size)
3351{
3352#if defined(WIN64) || defined(USE_LARGE_FILES)
3353 int retval = 0;
3354 Off_t cur, end, extend;
3355
3356 cur = win32_tell(fd);
3357 if (cur < 0)
3358 return -1;
3359 end = win32_lseek(fd, 0, SEEK_END);
3360 if (end < 0)
3361 return -1;
3362 extend = size - end;
3363 if (extend == 0) {
3364 /* do nothing */
3365 }
3366 else if (extend > 0) {
3367 /* must grow the file, padding with nulls */
3368 char b[4096];
3369 int oldmode = win32_setmode(fd, O_BINARY);
3370 size_t count;
3371 memset(b, '\0', sizeof(b));
3372 do {
3373 count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3374 count = win32_write(fd, b, count);
21424390 3375 if ((int)count < 0) {
4a9d6100
GS		 3376 retval = -1;
3377 break;
3378 }
3379 } while ((extend -= count) > 0);
3380 win32_setmode(fd, oldmode);
3381 }
3382 else {
3383 /* shrink the file */
3384 win32_lseek(fd, size, SEEK_SET);
3385 if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3386 errno = EACCES;
3387 retval = -1;
3388 }
3389 }
3390finish:
3391 win32_lseek(fd, cur, SEEK_SET);
3392 return retval;
3393#else
8859a7a0 3394 return chsize(fd, (long)size);
4a9d6100
GS		 3395#endif
3396}
3397
c623ac67
GS		 3398DllExport Off_t
3399win32_lseek(int fd, Off_t offset, int origin)
96e4d5b1 3400{
c623ac67 3401#if defined(WIN64) || defined(USE_LARGE_FILES)
a810272a
NS		 3402#if defined(__BORLANDC__) /* buk */
3403 LARGE_INTEGER pos;
3404 pos.QuadPart = offset;
3405 pos.LowPart = SetFilePointer(
3406 (HANDLE)_get_osfhandle(fd),
3407 pos.LowPart,
3408 &pos.HighPart,
3409 origin
3410 );
3411 if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
3412 pos.QuadPart = -1;
3413 }
3414
3415 return pos.QuadPart;
3416#else
c623ac67 3417 return _lseeki64(fd, offset, origin);
a810272a 3418#endif
c623ac67 3419#else
8859a7a0 3420 return lseek(fd, (long)offset, origin);
c623ac67 3421#endif
96e4d5b1 3422}
3423
c623ac67 3424DllExport Off_t
96e4d5b1 3425win32_tell(int fd)
3426{
c623ac67 3427#if defined(WIN64) || defined(USE_LARGE_FILES)
05e23382 3428#if defined(__BORLANDC__) /* buk */
a810272a
NS		 3429 LARGE_INTEGER pos;
3430 pos.QuadPart = 0;
3431 pos.LowPart = SetFilePointer(
3432 (HANDLE)_get_osfhandle(fd),
3433 pos.LowPart,
3434 &pos.HighPart,
3435 FILE_CURRENT
3436 );
3437 if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
3438 pos.QuadPart = -1;
3439 }
3440
3441 return pos.QuadPart;
3442 /* return tell(fd); */
3443#else
c623ac67 3444 return _telli64(fd);
a810272a 3445#endif
c623ac67 3446#else
390b85e7 3447 return tell(fd);
c623ac67 3448#endif
96e4d5b1 3449}
3450
68dc0745 3451DllExport int
3452win32_open(const char *path, int flag, ...)
0a753a76 3453{
acfe0abc 3454 dTHX;
68dc0745 3455 va_list ap;
3456 int pmode;
0a753a76 3457
3458 va_start(ap, flag);
3459 pmode = va_arg(ap, int);
3460 va_end(ap);
3461
68dc0745 3462 if (stricmp(path, "/dev/null")==0)
7fac1903
GS		 3463 path = "NUL";
3464
7766f137 3465 return open(PerlDir_mapA(path), flag, pmode);
0a753a76 3466}
3467
00b02797
JH		 3468/* close() that understands socket */
3469extern int my_close(int); /* in win32sck.c */
3470
68dc0745 3471DllExport int
3472win32_close(int fd)
0a753a76 3473{
00b02797 3474 return my_close(fd);
0a753a76 3475}
3476
68dc0745 3477DllExport int
96e4d5b1 3478win32_eof(int fd)
3479{
390b85e7 3480 return eof(fd);
96e4d5b1 3481}
3482
3483DllExport int
68dc0745 3484win32_dup(int fd)
0a753a76 3485{
390b85e7 3486 return dup(fd);
0a753a76 3487}
3488
68dc0745 3489DllExport int
3490win32_dup2(int fd1,int fd2)
0a753a76 3491{
390b85e7 3492 return dup2(fd1,fd2);
0a753a76 3493}
3494
f7aeb604
GS		 3495#ifdef PERL_MSVCRT_READFIX
3496
3497#define LF 10 /* line feed */
3498#define CR 13 /* carriage return */
3499#define CTRLZ 26 /* ctrl-z means eof for text */
3500#define FOPEN 0x01 /* file handle open */
3501#define FEOFLAG 0x02 /* end of file has been encountered */
3502#define FCRLF 0x04 /* CR-LF across read buffer (in text mode) */
3503#define FPIPE 0x08 /* file handle refers to a pipe */
3504#define FAPPEND 0x20 /* file handle opened O_APPEND */
3505#define FDEV 0x40 /* file handle refers to device */
3506#define FTEXT 0x80 /* file handle is in text mode */
3507#define MAX_DESCRIPTOR_COUNT (64*32) /* this is the maximun that MSVCRT can handle */
3508
b181b6fb
GS		 3509int __cdecl
3510_fixed_read(int fh, void *buf, unsigned cnt)
f7aeb604
GS		 3511{
3512 int bytes_read; /* number of bytes read */
3513 char *buffer; /* buffer to read to */
3514 int os_read; /* bytes read on OS call */
3515 char *p, *q; /* pointers into buffer */
3516 char peekchr; /* peek-ahead character */
3517 ULONG filepos; /* file position after seek */
3518 ULONG dosretval; /* o.s. return value */
3519
3520 /* validate handle */
3521 if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) ||
3522 !(_osfile(fh) & FOPEN))
3523 {
3524 /* out of range -- return error */
3525 errno = EBADF;
3526 _doserrno = 0; /* not o.s. error */
3527 return -1;
3528 }
3529
635bbe87
GS		 3530 /*
3531 * If lockinitflag is FALSE, assume fd is device
3532 * lockinitflag is set to TRUE by open.
3533 */
3534 if (_pioinfo(fh)->lockinitflag)
3535 EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */
f7aeb604
GS		 3536
3537 bytes_read = 0; /* nothing read yet */
3538 buffer = (char*)buf;
3539
3540 if (cnt == 0 || (_osfile(fh) & FEOFLAG)) {
3541 /* nothing to read or at EOF, so return 0 read */
3542 goto functionexit;
3543 }
3544
3545 if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) {
3546 /* a pipe/device and pipe lookahead non-empty: read the lookahead
3547 * char */
3548 *buffer++ = _pipech(fh);
3549 ++bytes_read;
3550 --cnt;
3551 _pipech(fh) = LF; /* mark as empty */
3552 }
3553
3554 /* read the data */
3555
3556 if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL))
3557 {
3558 /* ReadFile has reported an error. recognize two special cases.
3559 *
3560 * 1. map ERROR_ACCESS_DENIED to EBADF
3561 *
3562 * 2. just return 0 if ERROR_BROKEN_PIPE has occurred. it
3563 * means the handle is a read-handle on a pipe for which
3564 * all write-handles have been closed and all data has been
3565 * read. */
3566
3567 if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) {
3568 /* wrong read/write mode should return EBADF, not EACCES */
3569 errno = EBADF;
3570 _doserrno = dosretval;
3571 bytes_read = -1;
3572 goto functionexit;
3573 }
3574 else if (dosretval == ERROR_BROKEN_PIPE) {
3575 bytes_read = 0;
3576 goto functionexit;
3577 }
3578 else {
3579 bytes_read = -1;
3580 goto functionexit;
3581 }
3582 }
3583
3584 bytes_read += os_read; /* update bytes read */
3585
3586 if (_osfile(fh) & FTEXT) {
3587 /* now must translate CR-LFs to LFs in the buffer */
3588
3589 /* set CRLF flag to indicate LF at beginning of buffer */
3590 /* if ((os_read != 0) && (*(char *)buf == LF)) */
3591 /* _osfile(fh) |= FCRLF; */
3592 /* else */
3593 /* _osfile(fh) &= ~FCRLF; */
3594
3595 _osfile(fh) &= ~FCRLF;
3596
3597 /* convert chars in the buffer: p is src, q is dest */
3598 p = q = (char*)buf;
3599 while (p < (char *)buf + bytes_read) {
3600 if (*p == CTRLZ) {
3601 /* if fh is not a device, set ctrl-z flag */
3602 if (!(_osfile(fh) & FDEV))
3603 _osfile(fh) |= FEOFLAG;
3604 break; /* stop translating */
3605 }
3606 else if (*p != CR)
3607 *q++ = *p++;
3608 else {
3609 /* *p is CR, so must check next char for LF */
3610 if (p < (char *)buf + bytes_read - 1) {
3611 if (*(p+1) == LF) {
3612 p += 2;
3613 *q++ = LF; /* convert CR-LF to LF */
3614 }
3615 else
3616 *q++ = *p++; /* store char normally */
3617 }
3618 else {
3619 /* This is the hard part. We found a CR at end of
3620 buffer. We must peek ahead to see if next char
3621 is an LF. */
3622 ++p;
3623
3624 dosretval = 0;
3625 if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1,
3626 (LPDWORD)&os_read, NULL))
3627 dosretval = GetLastError();
3628
3629 if (dosretval != 0 || os_read == 0) {
3630 /* couldn't read ahead, store CR */
3631 *q++ = CR;
3632 }
3633 else {
3634 /* peekchr now has the extra character -- we now
3635 have several possibilities:
3636 1. disk file and char is not LF; just seek back
3637 and copy CR
3638 2. disk file and char is LF; store LF, don't seek back
3639 3. pipe/device and char is LF; store LF.
3640 4. pipe/device and char isn't LF, store CR and
3641 put char in pipe lookahead buffer. */
3642 if (_osfile(fh) & (FDEV|FPIPE)) {
3643 /* non-seekable device */
3644 if (peekchr == LF)
3645 *q++ = LF;
3646 else {
3647 *q++ = CR;
3648 _pipech(fh) = peekchr;
3649 }
3650 }
3651 else {
3652 /* disk file */
3653 if (peekchr == LF) {
3654 /* nothing read yet; must make some
3655 progress */
3656 *q++ = LF;
3657 /* turn on this flag for tell routine */
3658 _osfile(fh) |= FCRLF;
3659 }
3660 else {
3661 HANDLE osHandle; /* o.s. handle value */
3662 /* seek back */
3663 if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1)
3664 {
3665 if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1)
3666 dosretval = GetLastError();
3667 }
3668 if (peekchr != LF)
3669 *q++ = CR;
3670 }
3671 }
3672 }
3673 }
3674 }
3675 }
3676
3677 /* we now change bytes_read to reflect the true number of chars
3678 in the buffer */
3679 bytes_read = q - (char *)buf;
3680 }
3681
3fadfdf1 3682functionexit:
635bbe87
GS		 3683 if (_pioinfo(fh)->lockinitflag)
3684 LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */
f7aeb604
GS		 3685
3686 return bytes_read;
3687}
3688
3689#endif /* PERL_MSVCRT_READFIX */
3690
68dc0745 3691DllExport int
3e3baf6d 3692win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 3693{
f7aeb604
GS		 3694#ifdef PERL_MSVCRT_READFIX
3695 return _fixed_read(fd, buf, cnt);
3696#else
390b85e7 3697 return read(fd, buf, cnt);
f7aeb604 3698#endif
0a753a76 3699}
3700
68dc0745 3701DllExport int
3e3baf6d 3702win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 3703{
390b85e7 3704 return write(fd, buf, cnt);
0a753a76 3705}
3706
68dc0745 3707DllExport int
5aabfad6 3708win32_mkdir(const char *dir, int mode)
3709{
acfe0abc 3710 dTHX;
7766f137 3711 return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
5aabfad6 3712}
96e4d5b1 3713
5aabfad6 3714DllExport int
3715win32_rmdir(const char *dir)
3716{
acfe0abc 3717 dTHX;
7766f137 3718 return rmdir(PerlDir_mapA(dir));
5aabfad6 3719}
96e4d5b1 3720
5aabfad6 3721DllExport int
3722win32_chdir(const char *dir)
3723{
4ae93879 3724 dTHX;
9ec3348a
JH		 3725 if (!dir) {
3726 errno = ENOENT;
3727 return -1;
3728 }
390b85e7 3729 return chdir(dir);
5aabfad6 3730}
96e4d5b1 3731
7766f137
GS		 3732DllExport int
3733win32_access(const char *path, int mode)
3734{
acfe0abc 3735 dTHX;
7766f137
GS		 3736 return access(PerlDir_mapA(path), mode);
3737}
3738
3739DllExport int
3740win32_chmod(const char *path, int mode)
3741{
acfe0abc 3742 dTHX;
7766f137
GS		 3743 return chmod(PerlDir_mapA(path), mode);
3744}
3745
3746
0aaad0ff 3747static char *
dd7038b3 3748create_command_line(char *cname, STRLEN clen, const char * const *args)
0aaad0ff 3749{
acfe0abc 3750 dTHX;
b309b8ae
JH		 3751 int index, argc;
3752 char *cmd, *ptr;
3753 const char *arg;
3754 STRLEN len = 0;
81bc1258 3755 bool bat_file = FALSE;
b309b8ae 3756 bool cmd_shell = FALSE;
7b11e424 3757 bool dumb_shell = FALSE;
b309b8ae 3758 bool extra_quotes = FALSE;
dd7038b3 3759 bool quote_next = FALSE;
81bc1258
JH		 3760
3761 if (!cname)
3762 cname = (char*)args[0];
b309b8ae
JH		 3763
3764 /* The NT cmd.exe shell has the following peculiarity that needs to be
3765 * worked around. It strips a leading and trailing dquote when any
3766 * of the following is true:
3767 * 1. the /S switch was used
3768 * 2. there are more than two dquotes
3769 * 3. there is a special character from this set: &<>()@^|
3770 * 4. no whitespace characters within the two dquotes
3771 * 5. string between two dquotes isn't an executable file
3772 * To work around this, we always add a leading and trailing dquote
3773 * to the string, if the first argument is either "cmd.exe" or "cmd",
3774 * and there were at least two or more arguments passed to cmd.exe
3775 * (not including switches).
dd7038b3
JH		 3776 * XXX the above rules (from "cmd /?") don't seem to be applied
3777 * always, making for the convolutions below :-(
b309b8ae 3778 */
81bc1258 3779 if (cname) {
dd7038b3
JH		 3780 if (!clen)
3781 clen = strlen(cname);
3782
81bc1258
JH		 3783 if (clen > 4
3784 && (stricmp(&cname[clen-4], ".bat") == 0
3785 || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
3786 {
3787 bat_file = TRUE;
96090bfd
B		 3788 if (!IsWin95())
3789 len += 3;
81bc1258 3790 }
dd7038b3
JH		 3791 else {
3792 char *exe = strrchr(cname, '/');
3793 char *exe2 = strrchr(cname, '\\');
3794 if (exe2 > exe)
3795 exe = exe2;
3796 if (exe)
3797 ++exe;
3798 else
3799 exe = cname;
3800 if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
3801 cmd_shell = TRUE;
3802 len += 3;
3803 }
7b11e424
JH		 3804 else if (stricmp(exe, "command.com") == 0
3805 || stricmp(exe, "command") == 0)
3806 {
3807 dumb_shell = TRUE;
3808 }
81bc1258 3809 }
b309b8ae 3810 }
0aaad0ff 3811
b309b8ae
JH		 3812 DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
3813 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3814 STRLEN curlen = strlen(arg);
3815 if (!(arg[0] == '"' && arg[curlen-1] == '"'))
3816 len += 2; /* assume quoting needed (worst case) */
3817 len += curlen + 1;
3818 DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
3819 }
3820 DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
0aaad0ff 3821
b309b8ae 3822 argc = index;
a02a5408 3823 Newx(cmd, len, char);
0aaad0ff 3824 ptr = cmd;
0aaad0ff 3825
96090bfd 3826 if (bat_file && !IsWin95()) {
81bc1258
JH		 3827 *ptr++ = '"';
3828 extra_quotes = TRUE;
3829 }
3830
0aaad0ff 3831 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
b309b8ae
JH		 3832 bool do_quote = 0;
3833 STRLEN curlen = strlen(arg);
3834
81bc1258
JH		 3835 /* we want to protect empty arguments and ones with spaces with
3836 * dquotes, but only if they aren't already there */
7b11e424
JH		 3837 if (!dumb_shell) {
3838 if (!curlen) {
3839 do_quote = 1;
3840 }
02ef22d5
JH		 3841 else if (quote_next) {
3842 /* see if it really is multiple arguments pretending to
3843 * be one and force a set of quotes around it */
3844 if (*find_next_space(arg))
3845 do_quote = 1;
3846 }
7b11e424
JH		 3847 else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
3848 STRLEN i = 0;
3849 while (i < curlen) {
3850 if (isSPACE(arg[i])) {
3851 do_quote = 1;
02ef22d5
JH		 3852 }
3853 else if (arg[i] == '"') {
3854 do_quote = 0;
7b11e424
JH		 3855 break;
3856 }
3857 i++;
b309b8ae 3858 }
b309b8ae 3859 }
dd7038b3 3860 }
b309b8ae
JH		 3861
3862 if (do_quote)
3863 *ptr++ = '"';
3864
18a945d4 3865 strcpy(ptr, arg);
b309b8ae
JH		 3866 ptr += curlen;
3867
3868 if (do_quote)
3869 *ptr++ = '"';
3870
3871 if (args[index+1])
3872 *ptr++ = ' ';
3873
81bc1258
JH		 3874 if (!extra_quotes
3875 && cmd_shell
11998fdb
GS		 3876 && curlen >= 2
3877 && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
3878 && stricmp(arg+curlen-2, "/c") == 0)
b309b8ae 3879 {
dd7038b3
JH		 3880 /* is there a next argument? */
3881 if (args[index+1]) {
3882 /* are there two or more next arguments? */
3883 if (args[index+2]) {
3884 *ptr++ = '"';
3885 extra_quotes = TRUE;
3886 }
3887 else {
02ef22d5 3888 /* single argument, force quoting if it has spaces */
dd7038b3
JH		 3889 quote_next = TRUE;
3890 }
3891 }
b309b8ae 3892 }
0aaad0ff
GS		 3893 }
3894
b309b8ae
JH		 3895 if (extra_quotes)
3896 *ptr++ = '"';
3897
3898 *ptr = '\0';
3899
0aaad0ff
GS		 3900 return cmd;
3901}
3902
3903static char *
3904qualified_path(const char *cmd)
3905{
acfe0abc 3906 dTHX;
0aaad0ff
GS		 3907 char *pathstr;
3908 char *fullcmd, *curfullcmd;
3909 STRLEN cmdlen = 0;
3910 int has_slash = 0;
3911
3912 if (!cmd)
3913 return Nullch;
3914 fullcmd = (char*)cmd;
3915 while (*fullcmd) {
3916 if (*fullcmd == '/' || *fullcmd == '\\')
3917 has_slash++;
3918 fullcmd++;
3919 cmdlen++;
3920 }
3921
3922 /* look in PATH */
2fb9ab56 3923 pathstr = PerlEnv_getenv("PATH");
1928965c
JD		 3924
3925 /* worst case: PATH is a single directory; we need additional space
3926 * to append "/", ".exe" and trailing "\0" */
a02a5408 3927 Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
0aaad0ff
GS		 3928 curfullcmd = fullcmd;
3929
3930 while (1) {
3931 DWORD res;
3932
3933 /* start by appending the name to the current prefix */
3934 strcpy(curfullcmd, cmd);
3935 curfullcmd += cmdlen;
3936
3937 /* if it doesn't end with '.', or has no extension, try adding
3938 * a trailing .exe first */
3939 if (cmd[cmdlen-1] != '.'
3940 && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
3941 {
3942 strcpy(curfullcmd, ".exe");
3943 res = GetFileAttributes(fullcmd);
3944 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3945 return fullcmd;
3946 *curfullcmd = '\0';
3947 }
3948
3949 /* that failed, try the bare name */
3950 res = GetFileAttributes(fullcmd);
3951 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3952 return fullcmd;
3953
3954 /* quit if no other path exists, or if cmd already has path */
3955 if (!pathstr || !*pathstr || has_slash)
3956 break;
3957
3958 /* skip leading semis */
3959 while (*pathstr == ';')
3960 pathstr++;
3961
3962 /* build a new prefix from scratch */
3963 curfullcmd = fullcmd;
3964 while (*pathstr && *pathstr != ';') {
3965 if (*pathstr == '"') { /* foo;"baz;etc";bar */
3966 pathstr++; /* skip initial '"' */
3967 while (*pathstr && *pathstr != '"') {
1928965c 3968 *curfullcmd++ = *pathstr++;
0aaad0ff
GS		 3969 }
3970 if (*pathstr)
3971 pathstr++; /* skip trailing '"' */
3972 }
3973 else {
1928965c 3974 *curfullcmd++ = *pathstr++;
0aaad0ff
GS		 3975 }
3976 }
3977 if (*pathstr)
3978 pathstr++; /* skip trailing semi */
3979 if (curfullcmd > fullcmd /* append a dir separator */
3980 && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
3981 {
3982 *curfullcmd++ = '\\';
3983 }
3984 }
eb160463 3985
0aaad0ff
GS		 3986 Safefree(fullcmd);
3987 return Nullch;
3988}
3989
3075ddba
GS		 3990/* The following are just place holders.
3991 * Some hosts may provide and environment that the OS is
3992 * not tracking, therefore, these host must provide that
3993 * environment and the current directory to CreateProcess
3994 */
3995
df3728a2
JH		 3996DllExport void*
3997win32_get_childenv(void)
3075ddba
GS		 3998{
3999 return NULL;
4000}
4001
df3728a2
JH		 4002DllExport void
4003win32_free_childenv(void* d)
3075ddba
GS		 4004{
4005}
4006
df3728a2
JH		 4007DllExport void
4008win32_clearenv(void)
4009{
4010 char *envv = GetEnvironmentStrings();
4011 char *cur = envv;
4012 STRLEN len;
4013 while (*cur) {
4014 char *end = strchr(cur,'=');
4015 if (end && end != cur) {
4016 *end = '\0';
4017 SetEnvironmentVariable(cur, NULL);
4018 *end = '=';
4019 cur = end + strlen(end+1)+2;
4020 }
4021 else if ((len = strlen(cur)))
4022 cur += len+1;
4023 }
4024 FreeEnvironmentStrings(envv);
4025}
4026
4027DllExport char*
4028win32_get_childdir(void)
3075ddba 4029{
acfe0abc 4030 dTHX;
7766f137 4031 char* ptr;
8c56068e 4032 char szfilename[MAX_PATH+1];
7766f137 4033
8c56068e 4034 GetCurrentDirectoryA(MAX_PATH+1, szfilename);
a02a5408 4035 Newx(ptr, strlen(szfilename)+1, char);
7766f137
GS		 4036 strcpy(ptr, szfilename);
4037 return ptr;
3075ddba
GS		 4038}
4039
df3728a2
JH		 4040DllExport void
4041win32_free_childdir(char* d)
3075ddba 4042{
acfe0abc 4043 dTHX;
7766f137 4044 Safefree(d);
3075ddba
GS		 4045}
4046
4047
0aaad0ff
GS		 4048/* XXX this needs to be made more compatible with the spawnvp()
4049 * provided by the various RTLs. In particular, searching for
4050 * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
4051 * This doesn't significantly affect perl itself, because we
4052 * always invoke things using PERL5SHELL if a direct attempt to
4053 * spawn the executable fails.
3fadfdf1 4054 *
0aaad0ff
GS		 4055 * XXX splitting and rejoining the commandline between do_aspawn()
4056 * and win32_spawnvp() could also be avoided.
4057 */
4058
5aabfad6 4059DllExport int
3e3baf6d 4060win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
0a753a76 4061{
0aaad0ff
GS		 4062#ifdef USE_RTL_SPAWNVP
4063 return spawnvp(mode, cmdname, (char * const *)argv);
4064#else
acfe0abc 4065 dTHX;
2b260de0 4066 int ret;
3075ddba
GS		 4067 void* env;
4068 char* dir;
635bbe87 4069 child_IO_table tbl;
0aaad0ff
GS		 4070 STARTUPINFO StartupInfo;
4071 PROCESS_INFORMATION ProcessInformation;
4072 DWORD create = 0;
dd7038b3 4073 char *cmd;
0aaad0ff 4074 char *fullcmd = Nullch;
dd7038b3
JH		 4075 char *cname = (char *)cmdname;
4076 STRLEN clen = 0;
4077
4078 if (cname) {
4079 clen = strlen(cname);
4080 /* if command name contains dquotes, must remove them */
4081 if (strchr(cname, '"')) {
4082 cmd = cname;
a02a5408 4083 Newx(cname,clen+1,char);
dd7038b3
JH		 4084 clen = 0;
4085 while (*cmd) {
4086 if (*cmd != '"') {
4087 cname[clen] = *cmd;
4088 ++clen;
4089 }
4090 ++cmd;
4091 }
4092 cname[clen] = '\0';
4093 }
4094 }
4095
4096 cmd = create_command_line(cname, clen, argv);
0aaad0ff 4097
3075ddba
GS		 4098 env = PerlEnv_get_childenv();
4099 dir = PerlEnv_get_childdir();
4100
0aaad0ff
GS		 4101 switch(mode) {
4102 case P_NOWAIT: /* asynch + remember result */
4103 if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
4104 errno = EAGAIN;
4105 ret = -1;
4106 goto RETVAL;
4107 }
3fadfdf1 4108 /* Create a new process group so we can use GenerateConsoleCtrlEvent()
7e5f34c0
NIS		 4109 * in win32_kill()
4110 */
3fadfdf1 4111 create |= CREATE_NEW_PROCESS_GROUP;
0aaad0ff 4112 /* FALL THROUGH */
7e5f34c0 4113
0aaad0ff
GS		 4114 case P_WAIT: /* synchronous execution */
4115 break;
4116 default: /* invalid mode */
4117 errno = EINVAL;
4118 ret = -1;
4119 goto RETVAL;
4120 }
4121 memset(&StartupInfo,0,sizeof(StartupInfo));
4122 StartupInfo.cb = sizeof(StartupInfo);
f83751a7 4123 memset(&tbl,0,sizeof(tbl));
635bbe87 4124 PerlEnv_get_child_IO(&tbl);
f83751a7 4125 StartupInfo.dwFlags = tbl.dwFlags;
3fadfdf1
NIS		 4126 StartupInfo.dwX = tbl.dwX;
4127 StartupInfo.dwY = tbl.dwY;
4128 StartupInfo.dwXSize = tbl.dwXSize;
4129 StartupInfo.dwYSize = tbl.dwYSize;
4130 StartupInfo.dwXCountChars = tbl.dwXCountChars;
4131 StartupInfo.dwYCountChars = tbl.dwYCountChars;
4132 StartupInfo.dwFillAttribute = tbl.dwFillAttribute;
4133 StartupInfo.wShowWindow = tbl.wShowWindow;
f83751a7
GS		 4134 StartupInfo.hStdInput = tbl.childStdIn;
4135 StartupInfo.hStdOutput = tbl.childStdOut;
4136 StartupInfo.hStdError = tbl.childStdErr;
139cf11b
GS		 4137 if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE &&
4138 StartupInfo.hStdOutput == INVALID_HANDLE_VALUE &&
4139 StartupInfo.hStdError == INVALID_HANDLE_VALUE)
3ffaa937 4140 {
139cf11b 4141 create |= CREATE_NEW_CONSOLE;
3ffaa937
GS		 4142 }
4143 else {
139cf11b 4144 StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
3ffaa937 4145 }
02637f4c
JD		 4146 if (w32_use_showwindow) {
4147 StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
4148 StartupInfo.wShowWindow = w32_showwindow;
4149 }
3ffaa937 4150
b309b8ae 4151 DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
dd7038b3 4152 cname,cmd));
0aaad0ff 4153RETRY:
dd7038b3 4154 if (!CreateProcess(cname, /* search PATH to find executable */
0aaad0ff
GS		 4155 cmd, /* executable, and its arguments */
4156 NULL, /* process attributes */
4157 NULL, /* thread attributes */
4158 TRUE, /* inherit handles */
4159 create, /* creation flags */
3075ddba
GS		 4160 (LPVOID)env, /* inherit environment */
4161 dir, /* inherit cwd */
0aaad0ff
GS		 4162 &StartupInfo,
4163 &ProcessInformation))
4164 {
4165 /* initial NULL argument to CreateProcess() does a PATH
4166 * search, but it always first looks in the directory
4167 * where the current process was started, which behavior
4168 * is undesirable for backward compatibility. So we
4169 * jump through our own hoops by picking out the path
4170 * we really want it to use. */
4171 if (!fullcmd) {
dd7038b3 4172 fullcmd = qualified_path(cname);
0aaad0ff 4173 if (fullcmd) {
dd7038b3
JH		 4174 if (cname != cmdname)
4175 Safefree(cname);
4176 cname = fullcmd;
b309b8ae
JH		 4177 DEBUG_p(PerlIO_printf(Perl_debug_log,
4178 "Retrying [%s] with same args\n",
dd7038b3 4179 cname));
0aaad0ff
GS		 4180 goto RETRY;
4181 }
4182 }
4183 errno = ENOENT;
4184 ret = -1;
4185 goto RETVAL;
4186 }
2d7a9237 4187
0aaad0ff
GS		 4188 if (mode == P_NOWAIT) {
4189 /* asynchronous spawn -- store handle, return PID */
2b260de0 4190 ret = (int)ProcessInformation.dwProcessId;
922b1888
GS		 4191 if (IsWin95() && ret < 0)
4192 ret = -ret;
4193
4194 w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
4195 w32_child_pids[w32_num_children] = (DWORD)ret;
0aaad0ff
GS		 4196 ++w32_num_children;
4197 }
4198 else {
2b260de0 4199 DWORD status;
8fb3fcfb 4200 win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
7e5f34c0
NIS		 4201 /* FIXME: if msgwait returned due to message perhaps forward the
4202 "signal" to the process
4203 */
2b260de0
GS		 4204 GetExitCodeProcess(ProcessInformation.hProcess, &status);
4205 ret = (int)status;
0aaad0ff
GS		 4206 CloseHandle(ProcessInformation.hProcess);
4207 }
e17cb2a9 4208
0aaad0ff 4209 CloseHandle(ProcessInformation.hThread);
3075ddba 4210
0aaad0ff 4211RETVAL:
3075ddba
GS		 4212 PerlEnv_free_childenv(env);
4213 PerlEnv_free_childdir(dir);
0aaad0ff 4214 Safefree(cmd);
dd7038b3
JH		 4215 if (cname != cmdname)
4216 Safefree(cname);
2b260de0 4217 return ret;
2d7a9237 4218#endif
0a753a76 4219}
4220
6890e559 4221DllExport int
eb62e965
JD		 4222win32_execv(const char *cmdname, const char *const *argv)
4223{
7766f137 4224#ifdef USE_ITHREADS
acfe0abc 4225 dTHX;
7766f137
GS		 4226 /* if this is a pseudo-forked child, we just want to spawn
4227 * the new program, and return */
4228 if (w32_pseudo_id)
a51a97d8 4229# ifdef __BORLANDC__
7766f137 4230 return spawnv(P_WAIT, cmdname, (char *const *)argv);
a51a97d8
SH		 4231# else
4232 return spawnv(P_WAIT, cmdname, argv);
4233# endif
7766f137 4234#endif
a51a97d8 4235#ifdef __BORLANDC__
eb62e965 4236 return execv(cmdname, (char *const *)argv);
a51a97d8
SH		 4237#else
4238 return execv(cmdname, argv);
4239#endif
eb62e965
JD		 4240}
4241
4242DllExport int
6890e559
GS		 4243win32_execvp(const char *cmdname, const char *const *argv)
4244{
7766f137 4245#ifdef USE_ITHREADS
acfe0abc 4246 dTHX;
7766f137
GS		 4247 /* if this is a pseudo-forked child, we just want to spawn
4248 * the new program, and return */
190e4ad0 4249 if (w32_pseudo_id) {
f026e7c6 4250 int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv);
ba6ce41c
GS		 4251 if (status != -1) {
4252 my_exit(status);
4253 return 0;
4254 }
4255 else
4256 return status;
190e4ad0 4257 }
7766f137 4258#endif
a51a97d8 4259#ifdef __BORLANDC__
390b85e7 4260 return execvp(cmdname, (char *const *)argv);
a51a97d8
SH		 4261#else
4262 return execvp(cmdname, argv);
4263#endif
6890e559
GS		 4264}
4265
84902520
TB		 4266DllExport void
4267win32_perror(const char *str)
4268{
390b85e7 4269 perror(str);
84902520
TB		 4270}
4271
4272DllExport void
4273win32_setbuf(FILE *pf, char *buf)
4274{
390b85e7 4275 setbuf(pf, buf);
84902520
TB		 4276}
4277
4278DllExport int
4279win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
4280{
390b85e7 4281 return setvbuf(pf, buf, type, size);
84902520
TB		 4282}
4283
4284DllExport int
4285win32_flushall(void)
4286{
390b85e7 4287 return flushall();
84902520
TB		 4288}
4289
4290DllExport int
4291win32_fcloseall(void)
4292{
390b85e7 4293 return fcloseall();
84902520
TB		 4294}
4295
4296DllExport char*
4297win32_fgets(char *s, int n, FILE *pf)
4298{
390b85e7 4299 return fgets(s, n, pf);
84902520
TB		 4300}
4301
4302DllExport char*
4303win32_gets(char *s)
4304{
390b85e7 4305 return gets(s);
84902520
TB		 4306}
4307
4308DllExport int
4309win32_fgetc(FILE *pf)
4310{
390b85e7 4311 return fgetc(pf);
84902520
TB		 4312}
4313
4314DllExport int
4315win32_putc(int c, FILE *pf)
4316{
390b85e7 4317 return putc(c,pf);
84902520
TB		 4318}
4319
4320DllExport int
4321win32_puts(const char *s)
4322{
390b85e7 4323 return puts(s);
84902520
TB		 4324}
4325
4326DllExport int
4327win32_getchar(void)
4328{
390b85e7 4329 return getchar();
84902520
TB		 4330}
4331
4332DllExport int
4333win32_putchar(int c)
4334{
390b85e7 4335 return putchar(c);
84902520
TB		 4336}
4337
bbc8f9de
NIS		 4338#ifdef MYMALLOC
4339
4340#ifndef USE_PERL_SBRK
4341
df3728a2
JH		 4342static char *committed = NULL; /* XXX threadead */
4343static char *base = NULL; /* XXX threadead */
4344static char *reserved = NULL; /* XXX threadead */
4345static char *brk = NULL; /* XXX threadead */
4346static DWORD pagesize = 0; /* XXX threadead */
bbc8f9de
NIS		 4347
4348void *
c623ac67 4349sbrk(ptrdiff_t need)
bbc8f9de
NIS		 4350{
4351 void *result;
4352 if (!pagesize)
4353 {SYSTEM_INFO info;
4354 GetSystemInfo(&info);
4355 /* Pretend page size is larger so we don't perpetually
4356 * call the OS to commit just one page ...
4357 */
4358 pagesize = info.dwPageSize << 3;
bbc8f9de 4359 }
bbc8f9de
NIS		 4360 if (brk+need >= reserved)
4361 {
b2d41e21 4362 DWORD size = brk+need-reserved;
bbc8f9de 4363 char *addr;
b2d41e21 4364 char *prev_committed = NULL;
bbc8f9de
NIS		 4365 if (committed && reserved && committed < reserved)
4366 {
4367 /* Commit last of previous chunk cannot span allocations */
161b471a 4368 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de 4369 if (addr)
b2d41e21
SH		 4370 {
4371 /* Remember where we committed from in case we want to decommit later */
4372 prev_committed = committed;
bbc8f9de 4373 committed = reserved;
b2d41e21 4374 }
bbc8f9de 4375 }
3fadfdf1 4376 /* Reserve some (more) space
b2d41e21
SH		 4377 * Contiguous blocks give us greater efficiency, so reserve big blocks -
4378 * this is only address space not memory...
bbc8f9de
NIS		 4379 * Note this is a little sneaky, 1st call passes NULL as reserved
4380 * so lets system choose where we start, subsequent calls pass
4381 * the old end address so ask for a contiguous block
4382 */
b2d41e21
SH		 4383sbrk_reserve:
4384 if (size < 64*1024*1024)
4385 size = 64*1024*1024;
4386 size = ((size + pagesize - 1) / pagesize) * pagesize;
161b471a 4387 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
bbc8f9de
NIS		 4388 if (addr)
4389 {
4390 reserved = addr+size;
4391 if (!base)
4392 base = addr;
4393 if (!committed)
4394 committed = base;
4395 if (!brk)
4396 brk = committed;
4397 }
b2d41e21
SH		 4398 else if (reserved)
4399 {
4400 /* The existing block could not be extended far enough, so decommit
4401 * anything that was just committed above and start anew */
4402 if (prev_committed)
4403 {
4404 if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT))
4405 return (void *) -1;
4406 }
4407 reserved = base = committed = brk = NULL;
4408 size = need;
4409 goto sbrk_reserve;
4410 }
bbc8f9de
NIS		 4411 else
4412 {
4413 return (void *) -1;
4414 }
4415 }
4416 result = brk;
4417 brk += need;
4418 if (brk > committed)
4419 {
4420 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
b2d41e21
SH		 4421 char *addr;
4422 if (committed+size > reserved)
4423 size = reserved-committed;
4424 addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de 4425 if (addr)
b2d41e21 4426 committed += size;
bbc8f9de
NIS		 4427 else
4428 return (void *) -1;
4429 }
4430 return result;
4431}
4432
4433#endif
4434#endif
4435
84902520
TB		 4436DllExport void*
4437win32_malloc(size_t size)
4438{
390b85e7 4439 return malloc(size);
84902520
TB		 4440}
4441
4442DllExport void*
4443win32_calloc(size_t numitems, size_t size)
4444{
390b85e7 4445 return calloc(numitems,size);
84902520
TB		 4446}
4447
4448DllExport void*
4449win32_realloc(void *block, size_t size)
4450{
390b85e7 4451 return realloc(block,size);
84902520
TB		 4452}
4453
4454DllExport void
4455win32_free(void *block)
4456{
390b85e7 4457 free(block);
84902520
TB		 4458}
4459
bbc8f9de 4460
6e21dc91 4461DllExport int
c623ac67 4462win32_open_osfhandle(intptr_t handle, int flags)
0a753a76 4463{
9e5f57de
GS		 4464#ifdef USE_FIXED_OSFHANDLE
4465 if (IsWin95())
4466 return my_open_osfhandle(handle, flags);
4467#endif
390b85e7 4468 return _open_osfhandle(handle, flags);
0a753a76 4469}
4470
6e21dc91 4471DllExport intptr_t
65e48ea9 4472win32_get_osfhandle(int fd)
0a753a76 4473{
c623ac67 4474 return (intptr_t)_get_osfhandle(fd);
0a753a76 4475}
7bac28a0 4476
6e21dc91 4477DllExport FILE *
30753f56
NIS		 4478win32_fdupopen(FILE *pf)
4479{
4480 FILE* pfdup;
4481 fpos_t pos;
4482 char mode[3];
4483 int fileno = win32_dup(win32_fileno(pf));
4484
4485 /* open the file in the same mode */
4486#ifdef __BORLANDC__
4487 if((pf)->flags & _F_READ) {
4488 mode[0] = 'r';
4489 mode[1] = 0;
4490 }
4491 else if((pf)->flags & _F_WRIT) {
4492 mode[0] = 'a';
4493 mode[1] = 0;
4494 }
4495 else if((pf)->flags & _F_RDWR) {
4496 mode[0] = 'r';
4497 mode[1] = '+';
4498 mode[2] = 0;
4499 }
4500#else
4501 if((pf)->_flag & _IOREAD) {
4502 mode[0] = 'r';
4503 mode[1] = 0;
4504 }
4505 else if((pf)->_flag & _IOWRT) {
4506 mode[0] = 'a';
4507 mode[1] = 0;
4508 }
4509 else if((pf)->_flag & _IORW) {
4510 mode[0] = 'r';
4511 mode[1] = '+';
4512 mode[2] = 0;
4513 }
4514#endif
4515
4516 /* it appears that the binmode is attached to the
4517 * file descriptor so binmode files will be handled
4518 * correctly
4519 */
4520 pfdup = win32_fdopen(fileno, mode);
4521
4522 /* move the file pointer to the same position */
4523 if (!fgetpos(pf, &pos)) {
4524 fsetpos(pfdup, &pos);
4525 }
4526 return pfdup;
4527}
4528
0cb96387 4529DllExport void*
c5be433b 4530win32_dynaload(const char* filename)
0cb96387 4531{
acfe0abc 4532 dTHX;
32f99636
GS		 4533 char buf[MAX_PATH+1];
4534 char *first;
4535
4536 /* LoadLibrary() doesn't recognize forward slashes correctly,
4537 * so turn 'em back. */
4538 first = strchr(filename, '/');
4539 if (first) {
4540 STRLEN len = strlen(filename);
4541 if (len <= MAX_PATH) {
4542 strcpy(buf, filename);
4543 filename = &buf[first - filename];
4544 while (*filename) {
4545 if (*filename == '/')
4546 *(char*)filename = '\\';
4547 ++filename;
4548 }
4549 filename = buf;
4550 }
4551 }
8c56068e 4552 return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
0cb96387
GS		 4553}
4554
5bd7e777
JD		 4555XS(w32_SetChildShowWindow)
4556{
4557 dXSARGS;
4558 BOOL use_showwindow = w32_use_showwindow;
4559 /* use "unsigned short" because Perl has redefined "WORD" */
4560 unsigned short showwindow = w32_showwindow;
4561
4562 if (items > 1)
4563 Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
4564
4565 if (items == 0 || !SvOK(ST(0)))
4566 w32_use_showwindow = FALSE;
4567 else {
4568 w32_use_showwindow = TRUE;
4569 w32_showwindow = (unsigned short)SvIV(ST(0));
4570 }
4571
4572 EXTEND(SP, 1);
4573 if (use_showwindow)
4574 ST(0) = sv_2mortal(newSViv(showwindow));
4575 else
4576 ST(0) = &PL_sv_undef;
4577 XSRETURN(1);
4578}
4579
ad2e33dc 4580void
c5be433b 4581Perl_init_os_extras(void)
ad2e33dc 4582{
acfe0abc 4583 dTHX;
ad2e33dc 4584 char *file = __FILE__;
ad2e33dc 4585
9fb265f7
JD		 4586 /* Initialize Win32CORE if it has been statically linked. */
4587 void (*pfn_init)(pTHX);
4588#if defined(__BORLANDC__)
4589 /* makedef.pl seems to have given up on fixing this issue in the .def file */
4590 pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "_init_Win32CORE");
4591#else
4592 pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "init_Win32CORE");
4593#endif
4594 if (pfn_init)
4595 pfn_init(aTHX);
78ff2d7b 4596
02637f4c 4597 newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
ad2e33dc
GS		 4598}
4599
f4958739 4600void *
1018e26f 4601win32_signal_context(void)
c843839f
NIS		 4602{
4603 dTHX;
f4958739 4604#ifdef MULTIPLICITY
c843839f 4605 if (!my_perl) {
1018e26f 4606 my_perl = PL_curinterp;
c843839f 4607 PERL_SET_THX(my_perl);
3fadfdf1 4608 }
1018e26f 4609 return my_perl;
f4958739 4610#else
d9a047f6
GS		 4611 return PL_curinterp;
4612#endif
1018e26f
NIS		 4613}
4614
96116d93 4615
3fadfdf1 4616BOOL WINAPI
1018e26f
NIS		 4617win32_ctrlhandler(DWORD dwCtrlType)
4618{
96116d93 4619#ifdef MULTIPLICITY
1018e26f
NIS		 4620 dTHXa(PERL_GET_SIG_CONTEXT);
4621
4622 if (!my_perl)
4623 return FALSE;
96116d93 4624#endif
c843839f
NIS		 4625
4626 switch(dwCtrlType) {
4627 case CTRL_CLOSE_EVENT:
3fadfdf1
NIS		 4628 /* A signal that the system sends to all processes attached to a console when
4629 the user closes the console (either by choosing the Close command from the
4630 console window's System menu, or by choosing the End Task command from the
c843839f
NIS		 4631 Task List
4632 */
3fadfdf1
NIS		 4633 if (do_raise(aTHX_ 1)) /* SIGHUP */
4634 sig_terminate(aTHX_ 1);
4635 return TRUE;
c843839f
NIS		 4636
4637 case CTRL_C_EVENT:
4638 /* A CTRL+c signal was received */
3fadfdf1
NIS		 4639 if (do_raise(aTHX_ SIGINT))
4640 sig_terminate(aTHX_ SIGINT);
4641 return TRUE;
c843839f
NIS		 4642
4643 case CTRL_BREAK_EVENT:
4644 /* A CTRL+BREAK signal was received */
3fadfdf1
NIS		 4645 if (do_raise(aTHX_ SIGBREAK))
4646 sig_terminate(aTHX_ SIGBREAK);
4647 return TRUE;
c843839f
NIS		 4648
4649 case CTRL_LOGOFF_EVENT:
3fadfdf1
NIS		 4650 /* A signal that the system sends to all console processes when a user is logging
4651 off. This signal does not indicate which user is logging off, so no
4652 assumptions can be made.
c843839f 4653 */
3fadfdf1 4654 break;
c843839f 4655 case CTRL_SHUTDOWN_EVENT:
3fadfdf1
NIS		 4656 /* A signal that the system sends to all console processes when the system is
4657 shutting down.
c843839f 4658 */
3fadfdf1
NIS		 4659 if (do_raise(aTHX_ SIGTERM))
4660 sig_terminate(aTHX_ SIGTERM);
4661 return TRUE;
c843839f 4662 default:
3fadfdf1 4663 break;
c843839f
NIS		 4664 }
4665 return FALSE;
4666}
c843839f
NIS		 4667
4668
58d049f0 4669#ifdef SET_INVALID_PARAMETER_HANDLER
0448a0bd
SH		 4670# include <crtdbg.h>
4671#endif
4672
dc0472e9
JD		 4673static void
4674ansify_path(void)
4675{
dc0472e9
JD		 4676 size_t len;
4677 char *ansi_path;
4678 WCHAR *wide_path;
4679 WCHAR *wide_dir;
4680
3839a0fa
JD		 4681 /* win32_ansipath() requires Windows 2000 or later */
4682 if (!IsWin2000())
dc0472e9
JD		 4683 return;
4684
4685 /* fetch Unicode version of PATH */
4686 len = 2000;
4687 wide_path = win32_malloc(len*sizeof(WCHAR));
4688 while (wide_path) {
4689 size_t newlen = GetEnvironmentVariableW(L"PATH", wide_path, len);
4690 if (newlen < len)
4691 break;
4692 len = newlen;
4693 wide_path = win32_realloc(wide_path, len*sizeof(WCHAR));
4694 }
4695 if (!wide_path)
4696 return;
4697
4698 /* convert to ANSI pathnames */
4699 wide_dir = wide_path;
4700 ansi_path = NULL;
4701 while (wide_dir) {
4702 WCHAR *sep = wcschr(wide_dir, ';');
4703 char *ansi_dir;
4704 size_t ansi_len;
4705 size_t wide_len;
4706
4707 if (sep)
4708 *sep++ = '\0';
4709
4710 /* remove quotes around pathname */
4711 if (*wide_dir == '"')
4712 ++wide_dir;
4713 wide_len = wcslen(wide_dir);
4714 if (wide_len && wide_dir[wide_len-1] == '"')
4715 wide_dir[wide_len-1] = '\0';
4716
4717 /* append ansi_dir to ansi_path */
4718 ansi_dir = win32_ansipath(wide_dir);
4719 ansi_len = strlen(ansi_dir);
4720 if (ansi_path) {
4721 size_t newlen = len + 1 + ansi_len;
4722 ansi_path = win32_realloc(ansi_path, newlen+1);
4723 if (!ansi_path)
4724 break;
4725 ansi_path[len] = ';';
4726 memcpy(ansi_path+len+1, ansi_dir, ansi_len+1);
4727 len = newlen;
4728 }
4729 else {
4730 len = ansi_len;
4731 ansi_path = win32_malloc(5+len+1);
4732 if (!ansi_path)
4733 break;
4734 memcpy(ansi_path, "PATH=", 5);
4735 memcpy(ansi_path+5, ansi_dir, len+1);
4736 len += 5;
4737 }
4738 win32_free(ansi_dir);
4739 wide_dir = sep;
4740 }
4741
4742 if (ansi_path) {
4743 /* Update C RTL environ array. This will only have full effect if
4744 * perl_parse() is later called with `environ` as the `env` argument.
4745 * Otherwise S_init_postdump_symbols() will overwrite PATH again.
4746 *
4747 * We do have to ansify() the PATH before Perl has been fully
4748 * initialized because S_find_script() uses the PATH when perl
4749 * is being invoked with the -S option. This happens before %ENV
4750 * is initialized in S_init_postdump_symbols().
4751 *
4752 * XXX Is this a bug? Should S_find_script() use the environment
4753 * XXX passed in the `env` arg to parse_perl()?
4754 */
4755 putenv(ansi_path);
4756 /* Keep system environment in sync because S_init_postdump_symbols()
4757 * will not call mg_set() if it initializes %ENV from `environ`.
4758 */
4759 SetEnvironmentVariableA("PATH", ansi_path+5);
3e5d884e
JD		 4760 /* We are intentionally leaking the ansi_path string here because
4761 * the Borland runtime library puts it directly into the environ
4762 * array. The Microsoft runtime library seems to make a copy,
4763 * but will leak the copy should it be replaced again later.
4764 * Since this code is only called once during PERL_SYS_INIT this
4765 * shouldn't really matter.
4766 */
dc0472e9
JD		 4767 }
4768 win32_free(wide_path);
4769}
c843839f 4770
3e5d884e
JD		 4771void
4772Perl_win32_init(int *argcp, char ***argvp)
4773{
4774 HMODULE module;
4775
58d049f0 4776#ifdef SET_INVALID_PARAMETER_HANDLER
3e5d884e
JD		 4777 _invalid_parameter_handler oldHandler, newHandler;
4778 newHandler = my_invalid_parameter_handler;
4779 oldHandler = _set_invalid_parameter_handler(newHandler);
4780 _CrtSetReportMode(_CRT_ASSERT, 0);
4781#endif
4782 /* Disable floating point errors, Perl will trap the ones we
4783 * care about. VC++ RTL defaults to switching these off
4784 * already, but the Borland RTL doesn't. Since we don't
4785 * want to be at the vendor's whim on the default, we set
4786 * it explicitly here.
4787 */
4788#if !defined(_ALPHA_) && !defined(__GNUC__)
4789 _control87(MCW_EM, MCW_EM);
4790#endif
4791 MALLOC_INIT;
4792
4793 module = GetModuleHandle("ntdll.dll");
4794 if (module) {
4795 *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation");
4796 }
4797
4798 module = GetModuleHandle("kernel32.dll");
4799 if (module) {
4800 *(FARPROC*)&pfnCreateToolhelp32Snapshot = GetProcAddress(module, "CreateToolhelp32Snapshot");
4801 *(FARPROC*)&pfnProcess32First = GetProcAddress(module, "Process32First");
4802 *(FARPROC*)&pfnProcess32Next = GetProcAddress(module, "Process32Next");
4803 }
4804
4805 g_osver.dwOSVersionInfoSize = sizeof(g_osver);
4806 GetVersionEx(&g_osver);
4807
4808 ansify_path();
4809}
4810
4811void
4812Perl_win32_term(void)
4813{
4814 dTHX;
4815 HINTS_REFCNT_TERM;
4816 OP_REFCNT_TERM;
4817 PERLIO_TERM;
4818 MALLOC_TERM;
4819}
4820
4821void
4822win32_get_child_IO(child_IO_table* ptbl)
4823{
4824 ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
4825 ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
4826 ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE);
4827}
4828
4829Sighandler_t
4830win32_signal(int sig, Sighandler_t subcode)
4831{
4832 dTHX;
4833 if (sig < SIG_SIZE) {
4834 int save_errno = errno;
4835 Sighandler_t result = signal(sig, subcode);
4836 if (result == SIG_ERR) {
4837 result = w32_sighandler[sig];
4838 errno = save_errno;
4839 }
4840 w32_sighandler[sig] = subcode;
4841 return result;
4842 }
4843 else {
4844 errno = EINVAL;
4845 return SIG_ERR;
4846 }
4847}
4848
aeecf691
JD		 4849HWND
4850win32_create_message_window()
4851{
4852 /* "message-only" windows have been implemented in Windows 2000 and later.
4853 * On earlier versions we'll continue to post messages to a specific
4854 * thread and use hwnd==NULL. This is brittle when either an embedding
4855 * application or an XS module is also posting messages to hwnd=NULL
4856 * because once removed from the queue they cannot be delivered to the
4857 * "right" place with DispatchMessage() anymore, as there is no WindowProc
4858 * if there is no window handle.
4859 */
3839a0fa 4860 if (!IsWin2000())
aeecf691
JD		 4861 return NULL;
4862
4863 return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
4864}
4865
a33ef3f0
SH		 4866#ifdef HAVE_INTERP_INTERN
4867
4868static void
4869win32_csighandler(int sig)
4870{
4871#if 0
4872 dTHXa(PERL_GET_SIG_CONTEXT);
4873 Perl_warn(aTHX_ "Got signal %d",sig);
4874#endif
4875 /* Does nothing */
4876}
4877
edb113cf 4878#if defined(__MINGW32__) && defined(__cplusplus)
beeded0b
YO		 4879#define CAST_HWND__(x) (HWND__*)(x)
4880#else
4881#define CAST_HWND__(x) x
4882#endif
4883
7766f137 4884void
52853b95
GS		 4885Perl_sys_intern_init(pTHX)
4886{
3fadfdf1 4887 int i;
aeecf691 4888
52853b95
GS		 4889 w32_perlshell_tokens = Nullch;
4890 w32_perlshell_vec = (char**)NULL;
4891 w32_perlshell_items = 0;
4892 w32_fdpid = newAV();
a02a5408 4893 Newx(w32_children, 1, child_tab);
52853b95
GS		 4894 w32_num_children = 0;
4895# ifdef USE_ITHREADS
4896 w32_pseudo_id = 0;
aeecf691 4897 Newx(w32_pseudo_children, 1, pseudo_child_tab);
52853b95
GS		 4898 w32_num_pseudo_children = 0;
4899# endif
222c300a 4900 w32_timerid = 0;
beeded0b 4901 w32_message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);
05ec9bb3 4902 w32_poll_count = 0;
3fadfdf1
NIS		 4903 for (i=0; i < SIG_SIZE; i++) {
4904 w32_sighandler[i] = SIG_DFL;
4905 }
00967642 4906# ifdef MULTIPLICITY
1018e26f 4907 if (my_perl == PL_curinterp) {
96116d93
MB		 4908# else
4909 {
4910# endif
3fadfdf1 4911 /* Force C runtime signal stuff to set its console handler */
1c127fab
SH		 4912 signal(SIGINT,win32_csighandler);
4913 signal(SIGBREAK,win32_csighandler);
0a311364
JD		 4914
4915 /* We spawn asynchronous processes with the CREATE_NEW_PROCESS_GROUP
4916 * flag. This has the side-effect of disabling Ctrl-C events in all
4917 * processes in this group. At least on Windows NT and later we
4918 * can re-enable Ctrl-C handling by calling SetConsoleCtrlHandler()
4919 * with a NULL handler. This is not valid on Windows 9X.
4920 */
4921 if (IsWinNT())
4922 SetConsoleCtrlHandler(NULL,FALSE);
4923
3fadfdf1 4924 /* Push our handler on top */
c843839f
NIS		 4925 SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
4926 }
52853b95
GS		 4927}
4928
3dbbd0f5
GS		 4929void
4930Perl_sys_intern_clear(pTHX)
4931{
4932 Safefree(w32_perlshell_tokens);
4933 Safefree(w32_perlshell_vec);
4934 /* NOTE: w32_fdpid is freed by sv_clean_all() */
4935 Safefree(w32_children);
222c300a 4936 if (w32_timerid) {
aeecf691
JD		 4937 KillTimer(w32_message_hwnd, w32_timerid);
4938 w32_timerid = 0;
222c300a 4939 }
aeecf691
JD		 4940 if (w32_message_hwnd != NULL && w32_message_hwnd != INVALID_HANDLE_VALUE)
4941 DestroyWindow(w32_message_hwnd);
96116d93 4942# ifdef MULTIPLICITY
1018e26f 4943 if (my_perl == PL_curinterp) {
96116d93
MB		 4944# else
4945 {
4946# endif
c843839f 4947 SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
c843839f 4948 }
3dbbd0f5
GS		 4949# ifdef USE_ITHREADS
4950 Safefree(w32_pseudo_children);
4951# endif
4952}
4953
52853b95
GS		 4954# ifdef USE_ITHREADS
4955
4956void
7766f137
GS		 4957Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
4958{
4959 dst->perlshell_tokens = Nullch;
4960 dst->perlshell_vec = (char**)NULL;
4961 dst->perlshell_items = 0;
4962 dst->fdpid = newAV();
a02a5408 4963 Newxz(dst->children, 1, child_tab);
7766f137 4964 dst->pseudo_id = 0;
aeecf691
JD		 4965 Newxz(dst->pseudo_children, 1, pseudo_child_tab);
4966 dst->timerid = 0;
beeded0b 4967 dst->message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);
aeecf691 4968 dst->poll_count = 0;
3fadfdf1 4969 Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
7766f137 4970}
52853b95
GS		 4971# endif /* USE_ITHREADS */
4972#endif /* HAVE_INTERP_INTERN */
Unnamed repository; edit this file 'description' to name the repository.