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