This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
change#3612 was buggy and failed to build Tk; applied Ilya's
[perl5.git] / win32 / win32.c
CommitLineData
68dc0745
PP
1/* WIN32.C
2 *
3 * (c) 1995 Microsoft Corporation. All rights reserved.
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 */
0a753a76
PP
10
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
PP
17#include <windows.h>
18
e56670dd 19#ifndef __MINGW32__
9404a519
GS
20#include <lmcons.h>
21#include <lmerr.h>
22/* ugliness to work around a buggy struct definition in lmwksta.h */
23#undef LPTSTR
24#define LPTSTR LPWSTR
25#include <lmwksta.h>
26#undef LPTSTR
27#define LPTSTR LPSTR
e56670dd
GS
28#include <lmapibuf.h>
29#endif /* __MINGW32__ */
9404a519 30
68dc0745 31/* #include "config.h" */
0a753a76
PP
32
33#define PERLIO_NOT_STDIO 0
34#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
35#define PerlIO FILE
36#endif
37
7a9ec5a3 38#include <sys/stat.h>
0a753a76
PP
39#include "EXTERN.h"
40#include "perl.h"
c69f6586
GS
41
42#define NO_XSLOCKS
ad2e33dc 43#include "XSUB.h"
c69f6586
GS
44
45#include "Win32iop.h"
0a753a76 46#include <fcntl.h>
5b0d9cbe
NIS
47#ifndef __GNUC__
48/* assert.h conflicts with #define of assert in perl.h */
0a753a76 49#include <assert.h>
5b0d9cbe 50#endif
0a753a76
PP
51#include <string.h>
52#include <stdarg.h>
ad2e33dc 53#include <float.h>
ad0751ec 54#include <time.h>
3730b96e 55#if defined(_MSC_VER) || defined(__MINGW32__)
ad0751ec
GS
56#include <sys/utime.h>
57#else
58#include <utime.h>
59#endif
0a753a76 60
5b0d9cbe
NIS
61#ifdef __GNUC__
62/* Mingw32 defaults to globing command line
63 * So we turn it off like this:
64 */
65int _CRT_glob = 0;
66#endif
67
6890e559
GS
68#define EXECF_EXEC 1
69#define EXECF_SPAWN 2
70#define EXECF_SPAWN_NOWAIT 3
71
c69f6586 72#if defined(PERL_OBJECT)
e5a95ffb
GS
73#undef win32_get_privlib
74#define win32_get_privlib g_win32_get_privlib
00dc2f4f
GS
75#undef win32_get_sitelib
76#define win32_get_sitelib g_win32_get_sitelib
c69f6586
GS
77#undef do_aspawn
78#define do_aspawn g_do_aspawn
79#undef do_spawn
80#define do_spawn g_do_spawn
0cb96387
GS
81#undef Perl_do_exec
82#define Perl_do_exec g_do_exec
c69f6586
GS
83#undef getlogin
84#define getlogin g_getlogin
85#endif
86
ce1da67e
GS
87static void get_shell(void);
88static long tokenize(char *str, char **dest, char ***destv);
4f63d024 89 int do_spawn2(pTHX_ char *cmd, int exectype);
e200fe59 90static BOOL has_shell_metachars(char *ptr);
2d7a9237 91static long filetime_to_clock(PFILETIME ft);
ad0751ec 92static BOOL filetime_from_time(PFILETIME ft, time_t t);
51371543 93static char * get_emd_part(SV *leading, char *trailing, ...);
0aaad0ff
GS
94static void remove_dead_process(long deceased);
95static long find_pid(int pid);
96static char * qualified_path(const char *cmd);
c69f6586 97
2d7a9237 98HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
8ac9c18d 99char w32_module_name[MAX_PATH+1];
4b556e6c 100static DWORD w32_platform = (DWORD)-1;
50892819 101
26618a56
GS
102#ifdef USE_THREADS
103# ifdef USE_DECLSPEC_THREAD
104__declspec(thread) char strerror_buffer[512];
e34ffe5a 105__declspec(thread) char getlogin_buffer[128];
4b556e6c 106__declspec(thread) char w32_perllib_root[MAX_PATH+1];
26618a56
GS
107# ifdef HAVE_DES_FCRYPT
108__declspec(thread) char crypt_buffer[30];
109# endif
110# else
111# define strerror_buffer (thr->i.Wstrerror_buffer)
e34ffe5a 112# define getlogin_buffer (thr->i.Wgetlogin_buffer)
4b556e6c 113# define w32_perllib_root (thr->i.Ww32_perllib_root)
26618a56
GS
114# define crypt_buffer (thr->i.Wcrypt_buffer)
115# endif
116#else
4b556e6c
JD
117static char strerror_buffer[512];
118static char getlogin_buffer[128];
119static char w32_perllib_root[MAX_PATH+1];
26618a56 120# ifdef HAVE_DES_FCRYPT
4b556e6c 121static char crypt_buffer[30];
26618a56
GS
122# endif
123#endif
124
3fe9a6f1 125int
ba106d47
GS
126IsWin95(void)
127{
0cb96387 128 return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS);
3fe9a6f1
PP
129}
130
131int
ba106d47
GS
132IsWinNT(void)
133{
0cb96387 134 return (win32_os_id() == VER_PLATFORM_WIN32_NT);
3fe9a6f1 135}
0a753a76 136
51371543
GS
137/* sv (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
138static char*
139get_regstr_from(HKEY hkey, const char *valuename, SV *sv)
349ad1fe
GS
140{
141 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
00dc2f4f
GS
142 HKEY handle;
143 DWORD type;
144 const char *subkey = "Software\\Perl";
349ad1fe 145 char *str = Nullch;
00dc2f4f
GS
146 long retval;
147
148 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
349ad1fe 149 if (retval == ERROR_SUCCESS) {
51371543
GS
150 DWORD datalen;
151 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
ba3eb2af 152 if (retval == ERROR_SUCCESS && type == REG_SZ) {
0cb96387 153 dPERLOBJ;
51371543
GS
154 if (!sv)
155 sv = sv_2mortal(newSVpvn("",0));
156 SvGROW(sv, datalen);
157 retval = RegQueryValueEx(handle, valuename, 0, NULL,
158 (PBYTE)SvPVX(sv), &datalen);
159 if (retval == ERROR_SUCCESS) {
160 str = SvPVX(sv);
161 SvCUR_set(sv,datalen-1);
162 }
00dc2f4f
GS
163 }
164 RegCloseKey(handle);
165 }
349ad1fe 166 return str;
00dc2f4f
GS
167}
168
51371543
GS
169/* sv (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
170static char*
171get_regstr(const char *valuename, SV *sv)
00dc2f4f 172{
51371543 173 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, sv);
349ad1fe 174 if (!str)
51371543 175 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, sv);
349ad1fe 176 return str;
00dc2f4f
GS
177}
178
51371543 179/* prev_path (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
e5a95ffb 180static char *
51371543 181get_emd_part(SV *prev_path, char *trailing_path, ...)
00dc2f4f 182{
dc9e4912 183 char base[10];
e5a95ffb 184 va_list ap;
e24c7c18 185 char mod_name[MAX_PATH+1];
00dc2f4f 186 char *ptr;
e5a95ffb
GS
187 char *optr;
188 char *strip;
189 int oldsize, newsize;
190
191 va_start(ap, trailing_path);
192 strip = va_arg(ap, char *);
193
cceca5ed
GS
194 sprintf(base, "%5.3f",
195 (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000));
dc9e4912 196
8ac9c18d
GS
197 if (!*w32_module_name) {
198 GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
199 ? GetModuleHandle(NULL)
200 : w32_perldll_handle),
201 w32_module_name, sizeof(w32_module_name));
202
203 /* try to get full path to binary (which may be mangled when perl is
204 * run from a 16-bit app) */
205 /*PerlIO_printf(PerlIO_stderr(), "Before %s\n", w32_module_name);*/
206 (void)win32_longpath(w32_module_name);
207 /*PerlIO_printf(PerlIO_stderr(), "After %s\n", w32_module_name);*/
208
209 /* normalize to forward slashes */
210 ptr = w32_module_name;
211 while (*ptr) {
212 if (*ptr == '\\')
213 *ptr = '/';
214 ++ptr;
215 }
95140b98 216 }
8ac9c18d 217 strcpy(mod_name, w32_module_name);
95140b98 218 ptr = strrchr(mod_name, '/');
e5a95ffb
GS
219 while (ptr && strip) {
220 /* look for directories to skip back */
221 optr = ptr;
00dc2f4f 222 *ptr = '\0';
95140b98 223 ptr = strrchr(mod_name, '/');
1c39adb2
GS
224 /* avoid stripping component if there is no slash,
225 * or it doesn't match ... */
e5a95ffb 226 if (!ptr || stricmp(ptr+1, strip) != 0) {
1c39adb2
GS
227 /* ... but not if component matches 5.00X* */
228 if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
229 && strncmp(strip, base, 5) == 0
230 && strncmp(ptr+1, base, 5) == 0))
95140b98
GS
231 {
232 *optr = '/';
80252599
GS
233 ptr = optr;
234 }
00dc2f4f 235 }
e5a95ffb 236 strip = va_arg(ap, char *);
00dc2f4f 237 }
e5a95ffb
GS
238 if (!ptr) {
239 ptr = mod_name;
240 *ptr++ = '.';
95140b98 241 *ptr = '/';
00dc2f4f 242 }
e5a95ffb
GS
243 va_end(ap);
244 strcpy(++ptr, trailing_path);
245
dc9e4912 246 /* only add directory if it exists */
349ad1fe 247 if (GetFileAttributes(mod_name) != (DWORD) -1) {
dc9e4912 248 /* directory exists */
0cb96387 249 dPERLOBJ;
51371543
GS
250 if (!prev_path)
251 prev_path = sv_2mortal(newSVpvn("",0));
252 sv_catpvn(prev_path, ";", 1);
253 sv_catpv(prev_path, mod_name);
254 return SvPVX(prev_path);
00dc2f4f 255 }
00dc2f4f 256
cf11f4bf 257 return Nullch;
00dc2f4f
GS
258}
259
260char *
4f63d024 261win32_get_privlib(pTHX_ char *pl)
00dc2f4f 262{
51371543 263 dPERLOBJ;
e5a95ffb
GS
264 char *stdlib = "lib";
265 char buffer[MAX_PATH+1];
51371543 266 SV *sv = Nullsv;
00dc2f4f 267
e5a95ffb
GS
268 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
269 sprintf(buffer, "%s-%s", stdlib, pl);
51371543
GS
270 if (!get_regstr(buffer, sv))
271 (void)get_regstr(stdlib, sv);
00dc2f4f 272
e5a95ffb 273 /* $stdlib .= ";$EMD/../../lib" */
51371543 274 return get_emd_part(sv, stdlib, ARCHNAME, "bin", Nullch);
00dc2f4f
GS
275}
276
68dc0745 277char *
4f63d024 278win32_get_sitelib(pTHX_ char *pl)
00dc2f4f 279{
51371543 280 dPERLOBJ;
e5a95ffb
GS
281 char *sitelib = "sitelib";
282 char regstr[40];
e24c7c18 283 char pathstr[MAX_PATH+1];
e5a95ffb 284 DWORD datalen;
e5a95ffb 285 int len, newsize;
51371543
GS
286 SV *sv1 = Nullsv;
287 SV *sv2 = Nullsv;
00dc2f4f
GS
288
289 /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
e5a95ffb 290 sprintf(regstr, "%s-%s", sitelib, pl);
51371543 291 (void)get_regstr(regstr, sv1);
e5a95ffb
GS
292
293 /* $sitelib .=
294 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
95140b98 295 sprintf(pathstr, "site/%s/lib", pl);
51371543
GS
296 (void)get_emd_part(sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
297 if (!sv1 && strlen(pl) == 7) {
cf11f4bf
GS
298 /* pl may have been SUBVERSION-specific; try again without
299 * SUBVERSION */
300 sprintf(pathstr, "site/%.5s/lib", pl);
51371543 301 (void)get_emd_part(sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
cf11f4bf 302 }
00dc2f4f
GS
303
304 /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
51371543 305 (void)get_regstr(sitelib, sv2);
00dc2f4f 306
e5a95ffb
GS
307 /* $sitelib .=
308 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */
51371543 309 (void)get_emd_part(sv2, "site/lib", ARCHNAME, "bin", pl, Nullch);
e5a95ffb 310
51371543
GS
311 if (!sv1 && !sv2)
312 return Nullch;
313 if (!sv1)
314 return SvPVX(sv2);
315 if (!sv2)
316 return SvPVX(sv1);
e5a95ffb 317
349ad1fe
GS
318 sv_catpvn(sv1, ";", 1);
319 sv_catsv(sv1, sv2);
e5a95ffb 320
349ad1fe 321 return SvPVX(sv1);
68dc0745 322}
0a753a76 323
b4793f7f 324
2d7a9237 325static BOOL
e200fe59 326has_shell_metachars(char *ptr)
68dc0745
PP
327{
328 int inquote = 0;
329 char quote = '\0';
330
331 /*
332 * Scan string looking for redirection (< or >) or pipe
e200fe59
JD
333 * characters (|) that are not in a quoted string.
334 * Shell variable interpolation (%VAR%) can also happen inside strings.
68dc0745 335 */
9404a519 336 while (*ptr) {
68dc0745 337 switch(*ptr) {
e200fe59
JD
338 case '%':
339 return TRUE;
68dc0745
PP
340 case '\'':
341 case '\"':
9404a519
GS
342 if (inquote) {
343 if (quote == *ptr) {
68dc0745
PP
344 inquote = 0;
345 quote = '\0';
0a753a76 346 }
68dc0745
PP
347 }
348 else {
349 quote = *ptr;
350 inquote++;
351 }
352 break;
353 case '>':
354 case '<':
355 case '|':
9404a519 356 if (!inquote)
68dc0745
PP
357 return TRUE;
358 default:
359 break;
0a753a76 360 }
68dc0745
PP
361 ++ptr;
362 }
363 return FALSE;
0a753a76
PP
364}
365
c69f6586 366#if !defined(PERL_OBJECT)
68dc0745
PP
367/* since the current process environment is being updated in util.c
368 * the library functions will get the correct environment
369 */
370PerlIO *
4f63d024 371Perl_my_popen(pTHX_ char *cmd, char *mode)
0a753a76
PP
372{
373#ifdef FIXCMD
68dc0745
PP
374#define fixcmd(x) { \
375 char *pspace = strchr((x),' '); \
376 if (pspace) { \
377 char *p = (x); \
378 while (p < pspace) { \
379 if (*p == '/') \
380 *p = '\\'; \
381 p++; \
382 } \
383 } \
384 }
0a753a76
PP
385#else
386#define fixcmd(x)
387#endif
68dc0745 388 fixcmd(cmd);
45bc9206 389 PERL_FLUSHALL_FOR_CHILD;
0a753a76 390 return win32_popen(cmd, mode);
0a753a76
PP
391}
392
68dc0745 393long
4f63d024 394Perl_my_pclose(pTHX_ PerlIO *fp)
0a753a76
PP
395{
396 return win32_pclose(fp);
397}
c69f6586 398#endif
0a753a76 399
0cb96387
GS
400DllExport unsigned long
401win32_os_id(void)
0a753a76 402{
8b10511d 403 static OSVERSIONINFO osver;
0a753a76 404
2d7a9237 405 if (osver.dwPlatformId != w32_platform) {
8b10511d
GS
406 memset(&osver, 0, sizeof(OSVERSIONINFO));
407 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
408 GetVersionEx(&osver);
2d7a9237 409 w32_platform = osver.dwPlatformId;
8b10511d 410 }
0cb96387 411 return (unsigned long)w32_platform;
0a753a76
PP
412}
413
ce1da67e
GS
414/* Tokenize a string. Words are null-separated, and the list
415 * ends with a doubled null. Any character (except null and
416 * including backslash) may be escaped by preceding it with a
417 * backslash (the backslash will be stripped).
418 * Returns number of words in result buffer.
419 */
420static long
421tokenize(char *str, char **dest, char ***destv)
422{
423 char *retstart = Nullch;
424 char **retvstart = 0;
425 int items = -1;
426 if (str) {
0cb96387 427 dPERLOBJ;
ce1da67e
GS
428 int slen = strlen(str);
429 register char *ret;
430 register char **retv;
431 New(1307, ret, slen+2, char);
432 New(1308, retv, (slen+3)/2, char*);
433
434 retstart = ret;
435 retvstart = retv;
436 *retv = ret;
437 items = 0;
438 while (*str) {
439 *ret = *str++;
440 if (*ret == '\\' && *str)
441 *ret = *str++;
442 else if (*ret == ' ') {
443 while (*str == ' ')
444 str++;
445 if (ret == retstart)
446 ret--;
447 else {
448 *ret = '\0';
449 ++items;
450 if (*str)
451 *++retv = ret+1;
452 }
453 }
454 else if (!*str)
455 ++items;
456 ret++;
457 }
458 retvstart[items] = Nullch;
459 *ret++ = '\0';
460 *ret = '\0';
461 }
462 *dest = retstart;
463 *destv = retvstart;
464 return items;
465}
466
467static void
2d7a9237 468get_shell(void)
0a753a76 469{
0cb96387 470 dPERLOBJ;
ce1da67e 471 if (!w32_perlshell_tokens) {
174c211a
GS
472 /* we don't use COMSPEC here for two reasons:
473 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
474 * uncontrolled unportability of the ensuing scripts.
475 * 2. PERL5SHELL could be set to a shell that may not be fit for
476 * interactive use (which is what most programs look in COMSPEC
477 * for).
478 */
ce1da67e
GS
479 char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
480 char *usershell = getenv("PERL5SHELL");
481 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
482 &w32_perlshell_tokens,
483 &w32_perlshell_vec);
68dc0745 484 }
0a753a76
PP
485}
486
68dc0745 487int
4f63d024 488do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp)
0a753a76 489{
51371543 490 dPERLOBJ;
2d7a9237
GS
491 SV *really = (SV*)vreally;
492 SV **mark = (SV**)vmark;
493 SV **sp = (SV**)vsp;
68dc0745 494 char **argv;
2d7a9237 495 char *str;
68dc0745 496 int status;
2d7a9237 497 int flag = P_WAIT;
68dc0745 498 int index = 0;
68dc0745 499
2d7a9237
GS
500 if (sp <= mark)
501 return -1;
68dc0745 502
ce1da67e
GS
503 get_shell();
504 New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS
505
506 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
507 ++mark;
508 flag = SvIVx(*mark);
68dc0745
PP
509 }
510
9404a519 511 while (++mark <= sp) {
bb897dfc 512 if (*mark && (str = SvPV_nolen(*mark)))
2d7a9237
GS
513 argv[index++] = str;
514 else
515 argv[index++] = "";
68dc0745
PP
516 }
517 argv[index++] = 0;
518
2d7a9237 519 status = win32_spawnvp(flag,
bb897dfc 520 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
521 (const char* const*)argv);
522
80252599 523 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
2d7a9237 524 /* possible shell-builtin, invoke with shell */
ce1da67e
GS
525 int sh_items;
526 sh_items = w32_perlshell_items;
2d7a9237
GS
527 while (--index >= 0)
528 argv[index+sh_items] = argv[index];
ce1da67e
GS
529 while (--sh_items >= 0)
530 argv[sh_items] = w32_perlshell_vec[sh_items];
2d7a9237
GS
531
532 status = win32_spawnvp(flag,
bb897dfc 533 (const char*)(really ? SvPV_nolen(really) : argv[0]),
2d7a9237
GS
534 (const char* const*)argv);
535 }
68dc0745 536
50892819
GS
537 if (flag != P_NOWAIT) {
538 if (status < 0) {
0453d815
PM
539 dTHR;
540 if (ckWARN(WARN_EXEC))
541 Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno));
50892819
GS
542 status = 255 * 256;
543 }
544 else
545 status *= 256;
b28d0864 546 PL_statusvalue = status;
5aabfad6 547 }
ce1da67e 548 Safefree(argv);
50892819 549 return (status);
68dc0745
PP
550}
551
c69f6586 552int
4f63d024 553do_spawn2(pTHX_ char *cmd, int exectype)
68dc0745 554{
51371543 555 dPERLOBJ;
68dc0745
PP
556 char **a;
557 char *s;
558 char **argv;
559 int status = -1;
560 BOOL needToTry = TRUE;
2d7a9237 561 char *cmd2;
68dc0745 562
2d7a9237
GS
563 /* Save an extra exec if possible. See if there are shell
564 * metacharacters in it */
e200fe59 565 if (!has_shell_metachars(cmd)) {
fc36a67e
PP
566 New(1301,argv, strlen(cmd) / 2 + 2, char*);
567 New(1302,cmd2, strlen(cmd) + 1, char);
68dc0745
PP
568 strcpy(cmd2, cmd);
569 a = argv;
570 for (s = cmd2; *s;) {
de030af3 571 while (*s && isSPACE(*s))
68dc0745
PP
572 s++;
573 if (*s)
574 *(a++) = s;
de030af3 575 while (*s && !isSPACE(*s))
68dc0745 576 s++;
9404a519 577 if (*s)
68dc0745 578 *s++ = '\0';
0a753a76 579 }
68dc0745 580 *a = Nullch;
ce1da67e 581 if (argv[0]) {
6890e559
GS
582 switch (exectype) {
583 case EXECF_SPAWN:
584 status = win32_spawnvp(P_WAIT, argv[0],
585 (const char* const*)argv);
586 break;
587 case EXECF_SPAWN_NOWAIT:
588 status = win32_spawnvp(P_NOWAIT, argv[0],
589 (const char* const*)argv);
590 break;
591 case EXECF_EXEC:
592 status = win32_execvp(argv[0], (const char* const*)argv);
593 break;
594 }
2d7a9237 595 if (status != -1 || errno == 0)
68dc0745 596 needToTry = FALSE;
0a753a76 597 }
0a753a76 598 Safefree(argv);
68dc0745
PP
599 Safefree(cmd2);
600 }
2d7a9237 601 if (needToTry) {
ce1da67e
GS
602 char **argv;
603 int i = -1;
604 get_shell();
605 New(1306, argv, w32_perlshell_items + 2, char*);
606 while (++i < w32_perlshell_items)
607 argv[i] = w32_perlshell_vec[i];
2d7a9237
GS
608 argv[i++] = cmd;
609 argv[i] = Nullch;
6890e559
GS
610 switch (exectype) {
611 case EXECF_SPAWN:
612 status = win32_spawnvp(P_WAIT, argv[0],
613 (const char* const*)argv);
614 break;
615 case EXECF_SPAWN_NOWAIT:
616 status = win32_spawnvp(P_NOWAIT, argv[0],
617 (const char* const*)argv);
618 break;
619 case EXECF_EXEC:
620 status = win32_execvp(argv[0], (const char* const*)argv);
621 break;
622 }
ce1da67e
GS
623 cmd = argv[0];
624 Safefree(argv);
68dc0745 625 }
50892819
GS
626 if (exectype != EXECF_SPAWN_NOWAIT) {
627 if (status < 0) {
0453d815
PM
628 dTHR;
629 if (ckWARN(WARN_EXEC))
630 Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
50892819
GS
631 (exectype == EXECF_EXEC ? "exec" : "spawn"),
632 cmd, strerror(errno));
633 status = 255 * 256;
634 }
635 else
636 status *= 256;
b28d0864 637 PL_statusvalue = status;
5aabfad6 638 }
50892819 639 return (status);
0a753a76
PP
640}
641
6890e559 642int
4f63d024 643do_spawn(pTHX_ char *cmd)
6890e559 644{
4f63d024 645 return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
6890e559
GS
646}
647
2d7a9237 648int
4f63d024 649do_spawn_nowait(pTHX_ char *cmd)
2d7a9237 650{
4f63d024 651 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
2d7a9237
GS
652}
653
6890e559 654bool
4f63d024 655Perl_do_exec(pTHX_ char *cmd)
6890e559 656{
4f63d024 657 do_spawn2(aTHX_ cmd, EXECF_EXEC);
6890e559
GS
658 return FALSE;
659}
660
68dc0745
PP
661/* The idea here is to read all the directory names into a string table
662 * (separated by nulls) and when one of the other dir functions is called
663 * return the pointer to the current file name.
664 */
665DIR *
ce2e26e5 666win32_opendir(char *filename)
0a753a76 667{
73c4f7a1 668 dTHX;
51371543 669 dPERLOBJ;
9404a519
GS
670 DIR *p;
671 long len;
672 long idx;
673 char scanname[MAX_PATH+3];
674 struct stat sbuf;
7fac1903
GS
675 WIN32_FIND_DATAA aFindData;
676 WIN32_FIND_DATAW wFindData;
9404a519 677 HANDLE fh;
7fac1903
GS
678 char buffer[MAX_PATH*2];
679 WCHAR wbuffer[MAX_PATH];
680 char* ptr;
9404a519
GS
681
682 len = strlen(filename);
683 if (len > MAX_PATH)
684 return NULL;
68dc0745
PP
685
686 /* check to see if filename is a directory */
69d3ab13 687 if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
24caa93f 688 return NULL;
68dc0745 689
68dc0745 690 /* Get us a DIR structure */
fc36a67e 691 Newz(1303, p, 1, DIR);
9404a519 692 if (p == NULL)
68dc0745
PP
693 return NULL;
694
695 /* Create the search pattern */
696 strcpy(scanname, filename);
23db2e2d
GS
697
698 /* bare drive name means look in cwd for drive */
699 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
700 scanname[len++] = '.';
701 scanname[len++] = '/';
702 }
703 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
9404a519 704 scanname[len++] = '/';
23db2e2d 705 }
9404a519
GS
706 scanname[len++] = '*';
707 scanname[len] = '\0';
68dc0745
PP
708
709 /* do the FindFirstFile call */
7fac1903 710 if (USING_WIDE()) {
0cb96387 711 A2WHELPER(scanname, wbuffer, sizeof(wbuffer));
7fac1903
GS
712 fh = FindFirstFileW(wbuffer, &wFindData);
713 }
714 else {
715 fh = FindFirstFileA(scanname, &aFindData);
716 }
9404a519 717 if (fh == INVALID_HANDLE_VALUE) {
21e72512
AB
718 /* FindFirstFile() fails on empty drives! */
719 if (GetLastError() == ERROR_FILE_NOT_FOUND)
720 return p;
721 Safefree( p);
68dc0745
PP
722 return NULL;
723 }
724
725 /* now allocate the first part of the string table for
726 * the filenames that we find.
727 */
7fac1903 728 if (USING_WIDE()) {
0cb96387 729 W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
7fac1903
GS
730 ptr = buffer;
731 }
732 else {
733 ptr = aFindData.cFileName;
734 }
735 idx = strlen(ptr)+1;
fc36a67e 736 New(1304, p->start, idx, char);
9404a519 737 if (p->start == NULL)
4f63d024 738 Perl_croak_nocontext("opendir: malloc failed!\n");
7fac1903 739 strcpy(p->start, ptr);
68dc0745
PP
740 p->nfiles++;
741
742 /* loop finding all the files that match the wildcard
743 * (which should be all of them in this directory!).
744 * the variable idx should point one past the null terminator
745 * of the previous string found.
746 */
7fac1903
GS
747 while (USING_WIDE()
748 ? FindNextFileW(fh, &wFindData)
749 : FindNextFileA(fh, &aFindData)) {
750 if (USING_WIDE()) {
0cb96387 751 W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
7fac1903
GS
752 }
753 /* ptr is set above to the correct area */
754 len = strlen(ptr);
68dc0745
PP
755 /* bump the string table size by enough for the
756 * new name and it's null terminator
757 */
758 Renew(p->start, idx+len+1, char);
9404a519 759 if (p->start == NULL)
4f63d024 760 Perl_croak_nocontext("opendir: malloc failed!\n");
7fac1903 761 strcpy(&p->start[idx], ptr);
9404a519
GS
762 p->nfiles++;
763 idx += len+1;
764 }
765 FindClose(fh);
766 p->size = idx;
767 p->curr = p->start;
768 return p;
0a753a76
PP
769}
770
771
68dc0745
PP
772/* Readdir just returns the current string pointer and bumps the
773 * string pointer to the nDllExport entry.
774 */
775struct direct *
ce2e26e5 776win32_readdir(DIR *dirp)
0a753a76 777{
68dc0745
PP
778 int len;
779 static int dummy = 0;
0a753a76 780
68dc0745
PP
781 if (dirp->curr) {
782 /* first set up the structure to return */
783 len = strlen(dirp->curr);
784 strcpy(dirp->dirstr.d_name, dirp->curr);
785 dirp->dirstr.d_namlen = len;
0a753a76 786
68dc0745
PP
787 /* Fake an inode */
788 dirp->dirstr.d_ino = dummy++;
0a753a76 789
68dc0745
PP
790 /* Now set up for the nDllExport call to readdir */
791 dirp->curr += len + 1;
792 if (dirp->curr >= (dirp->start + dirp->size)) {
793 dirp->curr = NULL;
794 }
0a753a76 795
68dc0745
PP
796 return &(dirp->dirstr);
797 }
798 else
799 return NULL;
0a753a76
PP
800}
801
68dc0745
PP
802/* Telldir returns the current string pointer position */
803long
ce2e26e5 804win32_telldir(DIR *dirp)
0a753a76
PP
805{
806 return (long) dirp->curr;
807}
808
809
68dc0745
PP
810/* Seekdir moves the string pointer to a previously saved position
811 *(Saved by telldir).
812 */
813void
ce2e26e5 814win32_seekdir(DIR *dirp, long loc)
0a753a76
PP
815{
816 dirp->curr = (char *)loc;
817}
818
68dc0745
PP
819/* Rewinddir resets the string pointer to the start */
820void
ce2e26e5 821win32_rewinddir(DIR *dirp)
0a753a76
PP
822{
823 dirp->curr = dirp->start;
824}
825
68dc0745
PP
826/* free the memory allocated by opendir */
827int
ce2e26e5 828win32_closedir(DIR *dirp)
0a753a76 829{
0cb96387 830 dPERLOBJ;
0a753a76
PP
831 Safefree(dirp->start);
832 Safefree(dirp);
68dc0745 833 return 1;
0a753a76
PP
834}
835
836
68dc0745
PP
837/*
838 * various stubs
839 */
0a753a76
PP
840
841
68dc0745
PP
842/* Ownership
843 *
844 * Just pretend that everyone is a superuser. NT will let us know if
845 * we don\'t really have permission to do something.
846 */
0a753a76
PP
847
848#define ROOT_UID ((uid_t)0)
849#define ROOT_GID ((gid_t)0)
850
68dc0745
PP
851uid_t
852getuid(void)
0a753a76 853{
68dc0745 854 return ROOT_UID;
0a753a76
PP
855}
856
68dc0745
PP
857uid_t
858geteuid(void)
0a753a76 859{
68dc0745 860 return ROOT_UID;
0a753a76
PP
861}
862
68dc0745
PP
863gid_t
864getgid(void)
0a753a76 865{
68dc0745 866 return ROOT_GID;
0a753a76
PP
867}
868
68dc0745
PP
869gid_t
870getegid(void)
0a753a76 871{
68dc0745 872 return ROOT_GID;
0a753a76
PP
873}
874
68dc0745 875int
22239a37 876setuid(uid_t auid)
0a753a76 877{
22239a37 878 return (auid == ROOT_UID ? 0 : -1);
0a753a76
PP
879}
880
68dc0745 881int
22239a37 882setgid(gid_t agid)
0a753a76 883{
22239a37 884 return (agid == ROOT_GID ? 0 : -1);
0a753a76
PP
885}
886
e34ffe5a
GS
887char *
888getlogin(void)
889{
4f63d024 890 dTHX;
e34ffe5a
GS
891 char *buf = getlogin_buffer;
892 DWORD size = sizeof(getlogin_buffer);
893 if (GetUserName(buf,&size))
894 return buf;
895 return (char*)NULL;
896}
897
b990f8c8
GS
898int
899chown(const char *path, uid_t owner, gid_t group)
900{
901 /* XXX noop */
1c1c7f20 902 return 0;
b990f8c8
GS
903}
904
0aaad0ff
GS
905static long
906find_pid(int pid)
0a753a76 907{
0cb96387 908 dPERLOBJ;
51371543 909 long child;
f55ee38a 910 for (child = 0 ; child < w32_num_children ; ++child) {
0aaad0ff
GS
911 if (w32_child_pids[child] == pid)
912 return child;
913 }
914 return -1;
915}
916
917static void
918remove_dead_process(long child)
919{
920 if (child >= 0) {
0cb96387 921 dPERLOBJ;
0aaad0ff
GS
922 CloseHandle(w32_child_handles[child]);
923 Copy(&w32_child_handles[child+1], &w32_child_handles[child],
924 (w32_num_children-child-1), HANDLE);
925 Copy(&w32_child_pids[child+1], &w32_child_pids[child],
926 (w32_num_children-child-1), DWORD);
927 w32_num_children--;
f55ee38a 928 }
f55ee38a
GS
929}
930
931DllExport int
932win32_kill(int pid, int sig)
933{
0aaad0ff
GS
934 HANDLE hProcess;
935 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
936 if (hProcess && TerminateProcess(hProcess, sig))
68dc0745 937 CloseHandle(hProcess);
0aaad0ff
GS
938 else {
939 errno = EINVAL;
940 return -1;
68dc0745
PP
941 }
942 return 0;
0a753a76 943}
fbbbcc48 944
68dc0745
PP
945/*
946 * File system stuff
947 */
0a753a76 948
f3986ebb
GS
949DllExport unsigned int
950win32_sleep(unsigned int t)
0a753a76 951{
68dc0745
PP
952 Sleep(t*1000);
953 return 0;
0a753a76
PP
954}
955
68dc0745
PP
956DllExport int
957win32_stat(const char *path, struct stat *buffer)
0a753a76 958{
51371543 959 dPERLOBJ;
24caa93f 960 char t[MAX_PATH+1];
68dc0745 961 int l = strlen(path);
67fbe06e 962 int res;
7fac1903 963 WCHAR wbuffer[MAX_PATH];
0a753a76 964
68dc0745
PP
965 if (l > 1) {
966 switch(path[l - 1]) {
e1dbac94
GS
967 /* FindFirstFile() and stat() are buggy with a trailing
968 * backslash, so change it to a forward slash :-( */
68dc0745 969 case '\\':
e1dbac94
GS
970 strncpy(t, path, l-1);
971 t[l - 1] = '/';
972 t[l] = '\0';
973 path = t;
974 break;
23db2e2d 975 /* FindFirstFile() is buggy with "x:", so add a dot :-( */
e1dbac94
GS
976 case ':':
977 if (l == 2 && isALPHA(path[0])) {
23db2e2d 978 t[0] = path[0]; t[1] = ':'; t[2] = '.'; t[3] = '\0';
e1dbac94
GS
979 l = 3;
980 path = t;
981 }
982 break;
68dc0745
PP
983 }
984 }
7fac1903 985 if (USING_WIDE()) {
73c4f7a1 986 dTHX;
0cb96387 987 A2WHELPER(path, wbuffer, sizeof(wbuffer));
7fac1903
GS
988 res = _wstat(wbuffer, (struct _stat *)buffer);
989 }
990 else {
991 res = stat(path, buffer);
992 }
24caa93f
GS
993 if (res < 0) {
994 /* CRT is buggy on sharenames, so make sure it really isn't.
995 * XXX using GetFileAttributesEx() will enable us to set
996 * buffer->st_*time (but note that's not available on the
997 * Windows of 1995) */
7fac1903
GS
998 DWORD r;
999 if (USING_WIDE()) {
1000 r = GetFileAttributesW(wbuffer);
1001 }
1002 else {
1003 r = GetFileAttributesA(path);
1004 }
24caa93f 1005 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
e1dbac94
GS
1006 /* buffer may still contain old garbage since stat() failed */
1007 Zero(buffer, 1, struct stat);
1008 buffer->st_mode = S_IFDIR | S_IREAD;
24caa93f
GS
1009 errno = 0;
1010 if (!(r & FILE_ATTRIBUTE_READONLY))
1011 buffer->st_mode |= S_IWRITE | S_IEXEC;
1012 return 0;
1013 }
1014 }
24caa93f 1015 else {
e1dbac94
GS
1016 if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1017 && (path[2] == '\\' || path[2] == '/'))
2293b0e9
AB
1018 {
1019 /* The drive can be inaccessible, some _stat()s are buggy */
7fac1903
GS
1020 if (USING_WIDE()
1021 ? !GetVolumeInformationW(wbuffer,NULL,0,NULL,NULL,NULL,NULL,0)
1022 : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
2293b0e9
AB
1023 errno = ENOENT;
1024 return -1;
1025 }
1026 }
1027#ifdef __BORLANDC__
67fbe06e
GS
1028 if (S_ISDIR(buffer->st_mode))
1029 buffer->st_mode |= S_IWRITE | S_IEXEC;
1030 else if (S_ISREG(buffer->st_mode)) {
1031 if (l >= 4 && path[l-4] == '.') {
1032 const char *e = path + l - 3;
1033 if (strnicmp(e,"exe",3)
1034 && strnicmp(e,"bat",3)
1035 && strnicmp(e,"com",3)
1036 && (IsWin95() || strnicmp(e,"cmd",3)))
1037 buffer->st_mode &= ~S_IEXEC;
1038 else
1039 buffer->st_mode |= S_IEXEC;
1040 }
1041 else
1042 buffer->st_mode &= ~S_IEXEC;
1043 }
67fbe06e 1044#endif
2293b0e9 1045 }
67fbe06e 1046 return res;
0a753a76
PP
1047}
1048
8ac9c18d
GS
1049/* Find the longname of a given path. path is destructively modified.
1050 * It should have space for at least MAX_PATH characters. */
1051DllExport char *
1052win32_longpath(char *path)
1053{
1054 WIN32_FIND_DATA fdata;
1055 HANDLE fhand;
1056 char tmpbuf[MAX_PATH+1];
1057 char *tmpstart = tmpbuf;
1058 char *start = path;
1059 char sep;
1060 if (!path)
1061 return Nullch;
1062
1063 /* drive prefix */
1064 if (isALPHA(path[0]) && path[1] == ':' &&
1065 (path[2] == '/' || path[2] == '\\'))
1066 {
1067 start = path + 2;
1068 *tmpstart++ = path[0];
1069 *tmpstart++ = ':';
1070 }
1071 /* UNC prefix */
1072 else if ((path[0] == '/' || path[0] == '\\') &&
1073 (path[1] == '/' || path[1] == '\\'))
1074 {
1075 start = path + 2;
52fcf7ee
GS
1076 *tmpstart++ = path[0];
1077 *tmpstart++ = path[1];
8ac9c18d
GS
1078 /* copy machine name */
1079 while (*start && *start != '/' && *start != '\\')
1080 *tmpstart++ = *start++;
1081 if (*start) {
52fcf7ee 1082 *tmpstart++ = *start;
8ac9c18d
GS
1083 start++;
1084 /* copy share name */
1085 while (*start && *start != '/' && *start != '\\')
1086 *tmpstart++ = *start++;
1087 }
1088 }
1089 sep = *start++;
1090 if (sep == '/' || sep == '\\')
52fcf7ee 1091 *tmpstart++ = sep;
8ac9c18d
GS
1092 *tmpstart = '\0';
1093 while (sep) {
1094 /* walk up to slash */
1095 while (*start && *start != '/' && *start != '\\')
1096 ++start;
1097
1098 /* discard doubled slashes */
1099 while (*start && (start[1] == '/' || start[1] == '\\'))
1100 ++start;
1101 sep = *start;
1102
1103 /* stop and find full name of component */
1104 *start = '\0';
1105 fhand = FindFirstFile(path,&fdata);
1106 if (fhand != INVALID_HANDLE_VALUE) {
1107 strcpy(tmpstart, fdata.cFileName);
1108 tmpstart += strlen(fdata.cFileName);
1109 if (sep)
52fcf7ee 1110 *tmpstart++ = sep;
8ac9c18d
GS
1111 *tmpstart = '\0';
1112 *start++ = sep;
1113 FindClose(fhand);
1114 }
1115 else {
1116 /* failed a step, just return without side effects */
1117 /*PerlIO_printf(PerlIO_stderr(), "Failed to find %s\n", path);*/
1118 *start = sep;
1119 return Nullch;
1120 }
1121 }
1122 strcpy(path,tmpbuf);
1123 return path;
1124}
1125
0551aaa8
GS
1126#ifndef USE_WIN32_RTL_ENV
1127
1128DllExport char *
1129win32_getenv(const char *name)
1130{
73c4f7a1 1131 dTHX;
0cb96387 1132 dPERLOBJ;
7fac1903 1133 WCHAR wBuffer[MAX_PATH];
0551aaa8 1134 DWORD needlen;
51371543 1135 SV *curitem = Nullsv;
58a50f62 1136
7fac1903 1137 if (USING_WIDE()) {
0cb96387 1138 A2WHELPER(name, wBuffer, sizeof(wBuffer));
51371543 1139 needlen = GetEnvironmentVariableW(wBuffer, NULL, 0);
7fac1903
GS
1140 }
1141 else
51371543 1142 needlen = GetEnvironmentVariableA(name,NULL,0);
58a50f62 1143 if (needlen != 0) {
51371543 1144 curitem = sv_2mortal(newSVpvn("", 0));
7fac1903 1145 if (USING_WIDE()) {
51371543
GS
1146 SV *acuritem;
1147 do {
1148 SvGROW(curitem, (needlen+1)*sizeof(WCHAR));
1149 needlen = GetEnvironmentVariableW(wBuffer,
1150 (WCHAR*)SvPVX(curitem),
1151 needlen);
1152 } while (needlen >= SvLEN(curitem)/sizeof(WCHAR));
1153 SvCUR_set(curitem, needlen*sizeof(WCHAR));
1154 acuritem = sv_2mortal(newSVsv(curitem));
1155 W2AHELPER((WCHAR*)SvPVX(acuritem), SvPVX(curitem), SvCUR(curitem));
7fac1903
GS
1156 }
1157 else {
51371543
GS
1158 do {
1159 SvGROW(curitem, needlen+1);
1160 needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
1161 needlen);
1162 } while (needlen >= SvLEN(curitem));
1163 SvCUR_set(curitem, needlen);
58a50f62 1164 }
0551aaa8 1165 }
c934e9d4 1166 else {
7a5f8e82 1167 /* allow any environment variables that begin with 'PERL'
c934e9d4 1168 to be stored in the registry */
51371543
GS
1169 if (strncmp(name, "PERL", 4) == 0)
1170 (void)get_regstr(name, curitem);
c69f6586 1171 }
51371543
GS
1172 if (curitem && SvCUR(curitem))
1173 return SvPVX(curitem);
58a50f62 1174
51371543 1175 return Nullch;
0551aaa8
GS
1176}
1177
ac5c734f
GS
1178DllExport int
1179win32_putenv(const char *name)
1180{
51371543 1181 dPERLOBJ;
ac5c734f
GS
1182 char* curitem;
1183 char* val;
7fac1903
GS
1184 WCHAR* wCuritem;
1185 WCHAR* wVal;
1186 int length, relval = -1;
51371543 1187
73c4f7a1 1188 if (name) {
7fac1903 1189 if (USING_WIDE()) {
73c4f7a1 1190 dTHX;
7fac1903
GS
1191 length = strlen(name)+1;
1192 New(1309,wCuritem,length,WCHAR);
0cb96387 1193 A2WHELPER(name, wCuritem, length*2);
7fac1903
GS
1194 wVal = wcschr(wCuritem, '=');
1195 if(wVal) {
1196 *wVal++ = '\0';
1197 if(SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
1198 relval = 0;
1199 }
1200 Safefree(wCuritem);
1201 }
1202 else {
1203 New(1309,curitem,strlen(name)+1,char);
1204 strcpy(curitem, name);
1205 val = strchr(curitem, '=');
1206 if(val) {
1207 /* The sane way to deal with the environment.
1208 * Has these advantages over putenv() & co.:
1209 * * enables us to store a truly empty value in the
1210 * environment (like in UNIX).
1211 * * we don't have to deal with RTL globals, bugs and leaks.
1212 * * Much faster.
1213 * Why you may want to enable USE_WIN32_RTL_ENV:
1214 * * environ[] and RTL functions will not reflect changes,
1215 * which might be an issue if extensions want to access
1216 * the env. via RTL. This cuts both ways, since RTL will
1217 * not see changes made by extensions that call the Win32
1218 * functions directly, either.
1219 * GSAR 97-06-07
1220 */
1221 *val++ = '\0';
1222 if(SetEnvironmentVariableA(curitem, *val ? val : NULL))
1223 relval = 0;
1224 }
1225 Safefree(curitem);
ac5c734f 1226 }
ac5c734f
GS
1227 }
1228 return relval;
1229}
1230
0551aaa8
GS
1231#endif
1232
d55594ae 1233static long
2d7a9237 1234filetime_to_clock(PFILETIME ft)
d55594ae
GS
1235{
1236 __int64 qw = ft->dwHighDateTime;
1237 qw <<= 32;
1238 qw |= ft->dwLowDateTime;
1239 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
1240 return (long) qw;
1241}
1242
f3986ebb
GS
1243DllExport int
1244win32_times(struct tms *timebuf)
0a753a76 1245{
d55594ae
GS
1246 FILETIME user;
1247 FILETIME kernel;
1248 FILETIME dummy;
1249 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
1250 &kernel,&user)) {
2d7a9237
GS
1251 timebuf->tms_utime = filetime_to_clock(&user);
1252 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS
1253 timebuf->tms_cutime = 0;
1254 timebuf->tms_cstime = 0;
1255
1256 } else {
1257 /* That failed - e.g. Win95 fallback to clock() */
1258 clock_t t = clock();
1259 timebuf->tms_utime = t;
1260 timebuf->tms_stime = 0;
1261 timebuf->tms_cutime = 0;
1262 timebuf->tms_cstime = 0;
1263 }
68dc0745 1264 return 0;
0a753a76
PP
1265}
1266
ad0751ec
GS
1267/* fix utime() so it works on directories in NT
1268 * thanks to Jan Dubois <jan.dubois@ibm.net>
1269 */
1270static BOOL
1271filetime_from_time(PFILETIME pFileTime, time_t Time)
1272{
1273 struct tm *pTM = gmtime(&Time);
1274 SYSTEMTIME SystemTime;
1275
1276 if (pTM == NULL)
1277 return FALSE;
1278
1279 SystemTime.wYear = pTM->tm_year + 1900;
1280 SystemTime.wMonth = pTM->tm_mon + 1;
1281 SystemTime.wDay = pTM->tm_mday;
1282 SystemTime.wHour = pTM->tm_hour;
1283 SystemTime.wMinute = pTM->tm_min;
1284 SystemTime.wSecond = pTM->tm_sec;
1285 SystemTime.wMilliseconds = 0;
1286
1287 return SystemTimeToFileTime(&SystemTime, pFileTime);
1288}
1289
1290DllExport int
3b405fc5 1291win32_utime(const char *filename, struct utimbuf *times)
ad0751ec 1292{
51371543 1293 dPERLOBJ;
ad0751ec
GS
1294 HANDLE handle;
1295 FILETIME ftCreate;
1296 FILETIME ftAccess;
1297 FILETIME ftWrite;
1298 struct utimbuf TimeBuffer;
7fac1903 1299 WCHAR wbuffer[MAX_PATH];
ad0751ec 1300
7fac1903
GS
1301 int rc;
1302 if (USING_WIDE()) {
73c4f7a1 1303 dTHX;
0cb96387 1304 A2WHELPER(filename, wbuffer, sizeof(wbuffer));
7fac1903
GS
1305 rc = _wutime(wbuffer, (struct _utimbuf*)times);
1306 }
1307 else {
1308 rc = utime(filename, times);
1309 }
ad0751ec
GS
1310 /* EACCES: path specifies directory or readonly file */
1311 if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
1312 return rc;
1313
1314 if (times == NULL) {
1315 times = &TimeBuffer;
1316 time(&times->actime);
1317 times->modtime = times->actime;
1318 }
1319
1320 /* This will (and should) still fail on readonly files */
7fac1903
GS
1321 if (USING_WIDE()) {
1322 handle = CreateFileW(wbuffer, GENERIC_READ | GENERIC_WRITE,
1323 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1324 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
1325 }
1326 else {
1327 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
1328 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1329 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
1330 }
ad0751ec
GS
1331 if (handle == INVALID_HANDLE_VALUE)
1332 return rc;
1333
1334 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
1335 filetime_from_time(&ftAccess, times->actime) &&
1336 filetime_from_time(&ftWrite, times->modtime) &&
1337 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
1338 {
1339 rc = 0;
1340 }
1341
1342 CloseHandle(handle);
1343 return rc;
1344}
1345
2d7a9237 1346DllExport int
b2af26b1
GS
1347win32_uname(struct utsname *name)
1348{
1349 struct hostent *hep;
1350 STRLEN nodemax = sizeof(name->nodename)-1;
1351 OSVERSIONINFO osver;
1352
1353 memset(&osver, 0, sizeof(OSVERSIONINFO));
1354 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
1355 if (GetVersionEx(&osver)) {
1356 /* sysname */
1357 switch (osver.dwPlatformId) {
1358 case VER_PLATFORM_WIN32_WINDOWS:
1359 strcpy(name->sysname, "Windows");
1360 break;
1361 case VER_PLATFORM_WIN32_NT:
1362 strcpy(name->sysname, "Windows NT");
1363 break;
1364 case VER_PLATFORM_WIN32s:
1365 strcpy(name->sysname, "Win32s");
1366 break;
1367 default:
1368 strcpy(name->sysname, "Win32 Unknown");
1369 break;
1370 }
1371
cf6cacac
GS
1372 /* release */
1373 sprintf(name->release, "%d.%d",
b2af26b1
GS
1374 osver.dwMajorVersion, osver.dwMinorVersion);
1375
cf6cacac
GS
1376 /* version */
1377 sprintf(name->version, "Build %d",
b2af26b1
GS
1378 osver.dwPlatformId == VER_PLATFORM_WIN32_NT
1379 ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff));
1380 if (osver.szCSDVersion[0]) {
cf6cacac 1381 char *buf = name->version + strlen(name->version);
b2af26b1
GS
1382 sprintf(buf, " (%s)", osver.szCSDVersion);
1383 }
1384 }
1385 else {
1386 *name->sysname = '\0';
1387 *name->version = '\0';
1388 *name->release = '\0';
1389 }
1390
1391 /* nodename */
1392 hep = win32_gethostbyname("localhost");
1393 if (hep) {
1394 STRLEN len = strlen(hep->h_name);
1395 if (len <= nodemax) {
1396 strcpy(name->nodename, hep->h_name);
1397 }
1398 else {
1399 strncpy(name->nodename, hep->h_name, nodemax);
1400 name->nodename[nodemax] = '\0';
1401 }
1402 }
1403 else {
1404 DWORD sz = nodemax;
1405 if (!GetComputerName(name->nodename, &sz))
1406 *name->nodename = '\0';
1407 }
1408
1409 /* machine (architecture) */
1410 {
1411 SYSTEM_INFO info;
1412 char *arch;
1413 GetSystemInfo(&info);
a6c40364 1414
2d63fa08 1415#if defined(__BORLANDC__) || defined(__MINGW32__)
a6c40364
GS
1416 switch (info.u.s.wProcessorArchitecture) {
1417#else
b2af26b1 1418 switch (info.wProcessorArchitecture) {
a6c40364 1419#endif
b2af26b1
GS
1420 case PROCESSOR_ARCHITECTURE_INTEL:
1421 arch = "x86"; break;
1422 case PROCESSOR_ARCHITECTURE_MIPS:
1423 arch = "mips"; break;
1424 case PROCESSOR_ARCHITECTURE_ALPHA:
1425 arch = "alpha"; break;
1426 case PROCESSOR_ARCHITECTURE_PPC:
1427 arch = "ppc"; break;
1428 default:
1429 arch = "unknown"; break;
1430 }
1431 strcpy(name->machine, arch);
1432 }
1433 return 0;
1434}
1435
1436DllExport int
f55ee38a
GS
1437win32_waitpid(int pid, int *status, int flags)
1438{
0cb96387 1439 dPERLOBJ;
0aaad0ff 1440 int retval = -1;
f55ee38a 1441 if (pid == -1)
0aaad0ff 1442 return win32_wait(status);
f55ee38a 1443 else {
0aaad0ff
GS
1444 long child = find_pid(pid);
1445 if (child >= 0) {
1446 HANDLE hProcess = w32_child_handles[child];
1447 DWORD waitcode = WaitForSingleObject(hProcess, INFINITE);
1448 if (waitcode != WAIT_FAILED) {
1449 if (GetExitCodeProcess(hProcess, &waitcode)) {
1450 *status = (int)((waitcode & 0xff) << 8);
1451 retval = (int)w32_child_pids[child];
1452 remove_dead_process(child);
1453 return retval;
1454 }
1455 }
1456 else
1457 errno = ECHILD;
1458 }
1459 else {
1460 retval = cwait(status, pid, WAIT_CHILD);
1461 /* cwait() returns "correctly" on Borland */
8f1e745d 1462#ifndef __BORLANDC__
0aaad0ff
GS
1463 if (status)
1464 *status *= 256;
f55ee38a 1465#endif
0aaad0ff 1466 }
f55ee38a 1467 }
0aaad0ff 1468 return retval >= 0 ? pid : retval;
f55ee38a
GS
1469}
1470
1471DllExport int
2d7a9237
GS
1472win32_wait(int *status)
1473{
2d7a9237
GS
1474 /* XXX this wait emulation only knows about processes
1475 * spawned via win32_spawnvp(P_NOWAIT, ...).
1476 */
51371543 1477 dPERLOBJ;
2d7a9237
GS
1478 int i, retval;
1479 DWORD exitcode, waitcode;
1480
1481 if (!w32_num_children) {
1482 errno = ECHILD;
1483 return -1;
1484 }
1485
1486 /* if a child exists, wait for it to die */
1487 waitcode = WaitForMultipleObjects(w32_num_children,
0aaad0ff 1488 w32_child_handles,
2d7a9237
GS
1489 FALSE,
1490 INFINITE);
1491 if (waitcode != WAIT_FAILED) {
1492 if (waitcode >= WAIT_ABANDONED_0
1493 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
1494 i = waitcode - WAIT_ABANDONED_0;
1495 else
1496 i = waitcode - WAIT_OBJECT_0;
0aaad0ff 1497 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2d7a9237
GS
1498 *status = (int)((exitcode & 0xff) << 8);
1499 retval = (int)w32_child_pids[i];
0aaad0ff 1500 remove_dead_process(i);
2d7a9237
GS
1501 return retval;
1502 }
1503 }
1504
1505FAILED:
1506 errno = GetLastError();
1507 return -1;
2d7a9237 1508}
d55594ae 1509
2d7a9237 1510static UINT timerid = 0;
d55594ae
GS
1511
1512static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
1513{
0cb96387
GS
1514 dPERLOBJ;
1515 KillTimer(NULL,timerid);
1516 timerid=0;
1517 sighandler(14);
d55594ae
GS
1518}
1519
f3986ebb
GS
1520DllExport unsigned int
1521win32_alarm(unsigned int sec)
0a753a76 1522{
d55594ae
GS
1523 /*
1524 * the 'obvious' implentation is SetTimer() with a callback
1525 * which does whatever receiving SIGALRM would do
1526 * we cannot use SIGALRM even via raise() as it is not
1527 * one of the supported codes in <signal.h>
1528 *
1529 * Snag is unless something is looking at the message queue
1530 * nothing happens :-(
1531 */
0cb96387 1532 dPERLOBJ;
d55594ae
GS
1533 if (sec)
1534 {
1535 timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
1536 if (!timerid)
4f63d024 1537 Perl_croak_nocontext("Cannot set timer");
d55594ae
GS
1538 }
1539 else
1540 {
1541 if (timerid)
1542 {
1543 KillTimer(NULL,timerid);
1544 timerid=0;
1545 }
1546 }
68dc0745 1547 return 0;
0a753a76
PP
1548}
1549
ff95b63e 1550#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
26618a56 1551#ifdef HAVE_DES_FCRYPT
2d77217b 1552extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
ff95b63e 1553#endif
26618a56
GS
1554
1555DllExport char *
1556win32_crypt(const char *txt, const char *salt)
1557{
ff95b63e 1558#ifdef HAVE_DES_FCRYPT
26618a56 1559 dTHR;
0cb96387 1560 dPERLOBJ;
2d77217b 1561 return des_fcrypt(txt, salt, crypt_buffer);
ff95b63e
DL
1562#else
1563 die("The crypt() function is unimplemented due to excessive paranoia.");
b8957cf1 1564 return Nullch;
ff95b63e 1565#endif
26618a56
GS
1566}
1567#endif
1568
f3986ebb 1569#ifdef USE_FIXED_OSFHANDLE
390b85e7
GS
1570
1571EXTERN_C int __cdecl _alloc_osfhnd(void);
1572EXTERN_C int __cdecl _set_osfhnd(int fh, long value);
1573EXTERN_C void __cdecl _lock_fhandle(int);
1574EXTERN_C void __cdecl _unlock_fhandle(int);
1575EXTERN_C void __cdecl _unlock(int);
1576
1577#if (_MSC_VER >= 1000)
1578typedef struct {
1579 long osfhnd; /* underlying OS file HANDLE */
1580 char osfile; /* attributes of file (e.g., open in text mode?) */
1581 char pipech; /* one char buffer for handles opened on pipes */
1582#if defined (_MT) && !defined (DLL_FOR_WIN32S)
1583 int lockinitflag;
1584 CRITICAL_SECTION lock;
1585#endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */
1586} ioinfo;
1587
1588EXTERN_C ioinfo * __pioinfo[];
1589
1590#define IOINFO_L2E 5
1591#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
1592#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
1593#define _osfile(i) (_pioinfo(i)->osfile)
1594
1595#else /* (_MSC_VER >= 1000) */
1596extern char _osfile[];
1597#endif /* (_MSC_VER >= 1000) */
1598
1599#define FOPEN 0x01 /* file handle open */
1600#define FAPPEND 0x20 /* file handle opened O_APPEND */
1601#define FDEV 0x40 /* file handle refers to device */
1602#define FTEXT 0x80 /* file handle is in text mode */
1603
1604#define _STREAM_LOCKS 26 /* Table of stream locks */
1605#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */
1606#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */
1607
1608/***
1609*int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle
1610*
1611*Purpose:
1612* This function allocates a free C Runtime file handle and associates
1613* it with the Win32 HANDLE specified by the first parameter. This is a
1614* temperary fix for WIN95's brain damage GetFileType() error on socket
1615* we just bypass that call for socket
1616*
1617*Entry:
1618* long osfhandle - Win32 HANDLE to associate with C Runtime file handle.
1619* int flags - flags to associate with C Runtime file handle.
1620*
1621*Exit:
1622* returns index of entry in fh, if successful
1623* return -1, if no free entry is found
1624*
1625*Exceptions:
1626*
1627*******************************************************************************/
1628
1629static int
1630my_open_osfhandle(long osfhandle, int flags)
1631{
1632 int fh;
1633 char fileflags; /* _osfile flags */
1634
1635 /* copy relevant flags from second parameter */
1636 fileflags = FDEV;
1637
9404a519 1638 if (flags & O_APPEND)
390b85e7
GS
1639 fileflags |= FAPPEND;
1640
9404a519 1641 if (flags & O_TEXT)
390b85e7
GS
1642 fileflags |= FTEXT;
1643
1644 /* attempt to allocate a C Runtime file handle */
9404a519 1645 if ((fh = _alloc_osfhnd()) == -1) {
390b85e7
GS
1646 errno = EMFILE; /* too many open files */
1647 _doserrno = 0L; /* not an OS error */
1648 return -1; /* return error to caller */
1649 }
1650
1651 /* the file is open. now, set the info in _osfhnd array */
1652 _set_osfhnd(fh, osfhandle);
1653
1654 fileflags |= FOPEN; /* mark as open */
1655
1656#if (_MSC_VER >= 1000)
1657 _osfile(fh) = fileflags; /* set osfile entry */
1658 _unlock_fhandle(fh);
1659#else
1660 _osfile[fh] = fileflags; /* set osfile entry */
1661 _unlock(fh+_FH_LOCKS); /* unlock handle */
1662#endif
1663
1664 return fh; /* return handle */
1665}
1666
1667#define _open_osfhandle my_open_osfhandle
f3986ebb 1668#endif /* USE_FIXED_OSFHANDLE */
390b85e7
GS
1669
1670/* simulate flock by locking a range on the file */
1671
1672#define LK_ERR(f,i) ((f) ? (i = 0) : (errno = GetLastError()))
1673#define LK_LEN 0xffff0000
1674
f3986ebb
GS
1675DllExport int
1676win32_flock(int fd, int oper)
390b85e7
GS
1677{
1678 OVERLAPPED o;
1679 int i = -1;
1680 HANDLE fh;
1681
f3986ebb 1682 if (!IsWinNT()) {
0cb96387 1683 dPERLOBJ;
4f63d024 1684 Perl_croak_nocontext("flock() unimplemented on this platform");
f3986ebb
GS
1685 return -1;
1686 }
390b85e7
GS
1687 fh = (HANDLE)_get_osfhandle(fd);
1688 memset(&o, 0, sizeof(o));
1689
1690 switch(oper) {
1691 case LOCK_SH: /* shared lock */
1692 LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
1693 break;
1694 case LOCK_EX: /* exclusive lock */
1695 LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
1696 break;
1697 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
1698 LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
1699 break;
1700 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
1701 LK_ERR(LockFileEx(fh,
1702 LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
1703 0, LK_LEN, 0, &o),i);
1704 break;
1705 case LOCK_UN: /* unlock lock */
1706 LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
1707 break;
1708 default: /* unknown */
1709 errno = EINVAL;
1710 break;
1711 }
1712 return i;
1713}
1714
1715#undef LK_ERR
1716#undef LK_LEN
1717
68dc0745
PP
1718/*
1719 * redirected io subsystem for all XS modules
1720 *
1721 */
0a753a76 1722
68dc0745
PP
1723DllExport int *
1724win32_errno(void)
0a753a76 1725{
390b85e7 1726 return (&errno);
0a753a76
PP
1727}
1728
dcb2879a
GS
1729DllExport char ***
1730win32_environ(void)
1731{
390b85e7 1732 return (&(_environ));
dcb2879a
GS
1733}
1734
68dc0745
PP
1735/* the rest are the remapped stdio routines */
1736DllExport FILE *
1737win32_stderr(void)
0a753a76 1738{
390b85e7 1739 return (stderr);
0a753a76
PP
1740}
1741
68dc0745
PP
1742DllExport FILE *
1743win32_stdin(void)
0a753a76 1744{
390b85e7 1745 return (stdin);
0a753a76
PP
1746}
1747
68dc0745
PP
1748DllExport FILE *
1749win32_stdout()
0a753a76 1750{
390b85e7 1751 return (stdout);
0a753a76
PP
1752}
1753
68dc0745
PP
1754DllExport int
1755win32_ferror(FILE *fp)
0a753a76 1756{
390b85e7 1757 return (ferror(fp));
0a753a76
PP
1758}
1759
1760
68dc0745
PP
1761DllExport int
1762win32_feof(FILE *fp)
0a753a76 1763{
390b85e7 1764 return (feof(fp));
0a753a76
PP
1765}
1766
68dc0745
PP
1767/*
1768 * Since the errors returned by the socket error function
1769 * WSAGetLastError() are not known by the library routine strerror
1770 * we have to roll our own.
1771 */
0a753a76 1772
68dc0745
PP
1773DllExport char *
1774win32_strerror(int e)
0a753a76 1775{
3e3baf6d 1776#ifndef __BORLANDC__ /* Borland intolerance */
68dc0745 1777 extern int sys_nerr;
3e3baf6d 1778#endif
68dc0745 1779 DWORD source = 0;
0a753a76 1780
9404a519 1781 if (e < 0 || e > sys_nerr) {
4f63d024 1782 dTHX;
9404a519 1783 if (e < 0)
68dc0745 1784 e = GetLastError();
0a753a76 1785
9404a519 1786 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
68dc0745
PP
1787 strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
1788 strcpy(strerror_buffer, "Unknown Error");
0a753a76 1789
68dc0745
PP
1790 return strerror_buffer;
1791 }
390b85e7 1792 return strerror(e);
0a753a76
PP
1793}
1794
22fae026 1795DllExport void
4f63d024 1796win32_str_os_error(pTHX_ void *sv, DWORD dwErr)
22fae026
TM
1797{
1798 DWORD dwLen;
1799 char *sMsg;
1800 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
1801 |FORMAT_MESSAGE_IGNORE_INSERTS
1802 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
1803 dwErr, 0, (char *)&sMsg, 1, NULL);
1804 if (0 < dwLen) {
de030af3 1805 while (0 < dwLen && isSPACE(sMsg[--dwLen]))
22fae026
TM
1806 ;
1807 if ('.' != sMsg[dwLen])
1808 dwLen++;
1809 sMsg[dwLen]= '\0';
1810 }
1811 if (0 == dwLen) {
c69f6586 1812 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
db7c17d7
GS
1813 if (sMsg)
1814 dwLen = sprintf(sMsg,
1815 "Unknown error #0x%lX (lookup 0x%lX)",
1816 dwErr, GetLastError());
1817 }
1818 if (sMsg) {
0cb96387 1819 dPERLOBJ;
db7c17d7
GS
1820 sv_setpvn((SV*)sv, sMsg, dwLen);
1821 LocalFree(sMsg);
22fae026 1822 }
22fae026
TM
1823}
1824
1825
68dc0745
PP
1826DllExport int
1827win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 1828{
68dc0745
PP
1829 va_list marker;
1830 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 1831
390b85e7 1832 return (vfprintf(fp, format, marker));
0a753a76
PP
1833}
1834
68dc0745
PP
1835DllExport int
1836win32_printf(const char *format, ...)
0a753a76 1837{
68dc0745
PP
1838 va_list marker;
1839 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 1840
390b85e7 1841 return (vprintf(format, marker));
0a753a76
PP
1842}
1843
68dc0745
PP
1844DllExport int
1845win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 1846{
390b85e7 1847 return (vfprintf(fp, format, args));
0a753a76
PP
1848}
1849
96e4d5b1
PP
1850DllExport int
1851win32_vprintf(const char *format, va_list args)
1852{
390b85e7 1853 return (vprintf(format, args));
96e4d5b1
PP
1854}
1855
68dc0745
PP
1856DllExport size_t
1857win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 1858{
390b85e7 1859 return fread(buf, size, count, fp);
0a753a76
PP
1860}
1861
68dc0745
PP
1862DllExport size_t
1863win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 1864{
390b85e7 1865 return fwrite(buf, size, count, fp);
0a753a76
PP
1866}
1867
7fac1903
GS
1868#define MODE_SIZE 10
1869
68dc0745
PP
1870DllExport FILE *
1871win32_fopen(const char *filename, const char *mode)
0a753a76 1872{
51371543 1873 dPERLOBJ;
7fac1903 1874 WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH];
68dc0745 1875 if (stricmp(filename, "/dev/null")==0)
7fac1903
GS
1876 filename = "NUL";
1877
1878 if (USING_WIDE()) {
73c4f7a1 1879 dTHX;
0cb96387
GS
1880 A2WHELPER(mode, wMode, sizeof(wMode));
1881 A2WHELPER(filename, wBuffer, sizeof(wBuffer));
7fac1903
GS
1882 return _wfopen(wBuffer, wMode);
1883 }
390b85e7 1884 return fopen(filename, mode);
0a753a76
PP
1885}
1886
f3986ebb
GS
1887#ifndef USE_SOCKETS_AS_HANDLES
1888#undef fdopen
1889#define fdopen my_fdopen
1890#endif
1891
68dc0745 1892DllExport FILE *
7fac1903 1893win32_fdopen(int handle, const char *mode)
0a753a76 1894{
0cb96387 1895 dPERLOBJ;
51371543 1896 WCHAR wMode[MODE_SIZE];
7fac1903 1897 if (USING_WIDE()) {
73c4f7a1 1898 dTHX;
0cb96387 1899 A2WHELPER(mode, wMode, sizeof(wMode));
7fac1903
GS
1900 return _wfdopen(handle, wMode);
1901 }
390b85e7 1902 return fdopen(handle, (char *) mode);
0a753a76
PP
1903}
1904
68dc0745 1905DllExport FILE *
7fac1903 1906win32_freopen(const char *path, const char *mode, FILE *stream)
0a753a76 1907{
0cb96387 1908 dPERLOBJ;
51371543 1909 WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH];
68dc0745 1910 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
1911 path = "NUL";
1912
1913 if (USING_WIDE()) {
73c4f7a1 1914 dTHX;
0cb96387
GS
1915 A2WHELPER(mode, wMode, sizeof(wMode));
1916 A2WHELPER(path, wBuffer, sizeof(wBuffer));
7fac1903
GS
1917 return _wfreopen(wBuffer, wMode, stream);
1918 }
390b85e7 1919 return freopen(path, mode, stream);
0a753a76
PP
1920}
1921
68dc0745
PP
1922DllExport int
1923win32_fclose(FILE *pf)
0a753a76 1924{
f3986ebb 1925 return my_fclose(pf); /* defined in win32sck.c */
0a753a76
PP
1926}
1927
68dc0745
PP
1928DllExport int
1929win32_fputs(const char *s,FILE *pf)
0a753a76 1930{
390b85e7 1931 return fputs(s, pf);
0a753a76
PP
1932}
1933
68dc0745
PP
1934DllExport int
1935win32_fputc(int c,FILE *pf)
0a753a76 1936{
390b85e7 1937 return fputc(c,pf);
0a753a76
PP
1938}
1939
68dc0745
PP
1940DllExport int
1941win32_ungetc(int c,FILE *pf)
0a753a76 1942{
390b85e7 1943 return ungetc(c,pf);
0a753a76
PP
1944}
1945
68dc0745
PP
1946DllExport int
1947win32_getc(FILE *pf)
0a753a76 1948{
390b85e7 1949 return getc(pf);
0a753a76
PP
1950}
1951
68dc0745
PP
1952DllExport int
1953win32_fileno(FILE *pf)
0a753a76 1954{
390b85e7 1955 return fileno(pf);
0a753a76
PP
1956}
1957
68dc0745
PP
1958DllExport void
1959win32_clearerr(FILE *pf)
0a753a76 1960{
390b85e7 1961 clearerr(pf);
68dc0745 1962 return;
0a753a76
PP
1963}
1964
68dc0745
PP
1965DllExport int
1966win32_fflush(FILE *pf)
0a753a76 1967{
390b85e7 1968 return fflush(pf);
0a753a76
PP
1969}
1970
68dc0745
PP
1971DllExport long
1972win32_ftell(FILE *pf)
0a753a76 1973{
390b85e7 1974 return ftell(pf);
0a753a76
PP
1975}
1976
68dc0745
PP
1977DllExport int
1978win32_fseek(FILE *pf,long offset,int origin)
0a753a76 1979{
390b85e7 1980 return fseek(pf, offset, origin);
0a753a76
PP
1981}
1982
68dc0745
PP
1983DllExport int
1984win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 1985{
390b85e7 1986 return fgetpos(pf, p);
0a753a76
PP
1987}
1988
68dc0745
PP
1989DllExport int
1990win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 1991{
390b85e7 1992 return fsetpos(pf, p);
0a753a76
PP
1993}
1994
68dc0745
PP
1995DllExport void
1996win32_rewind(FILE *pf)
0a753a76 1997{
390b85e7 1998 rewind(pf);
68dc0745 1999 return;
0a753a76
PP
2000}
2001
68dc0745
PP
2002DllExport FILE*
2003win32_tmpfile(void)
0a753a76 2004{
390b85e7 2005 return tmpfile();
0a753a76
PP
2006}
2007
68dc0745
PP
2008DllExport void
2009win32_abort(void)
0a753a76 2010{
390b85e7 2011 abort();
68dc0745 2012 return;
0a753a76
PP
2013}
2014
68dc0745 2015DllExport int
22239a37 2016win32_fstat(int fd,struct stat *sbufptr)
0a753a76 2017{
22239a37 2018 return fstat(fd,sbufptr);
0a753a76
PP
2019}
2020
68dc0745
PP
2021DllExport int
2022win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 2023{
390b85e7 2024 return _pipe(pfd, size, mode);
0a753a76
PP
2025}
2026
50892819
GS
2027/*
2028 * a popen() clone that respects PERL5SHELL
2029 */
2030
68dc0745
PP
2031DllExport FILE*
2032win32_popen(const char *command, const char *mode)
0a753a76 2033{
4b556e6c 2034#ifdef USE_RTL_POPEN
390b85e7 2035 return _popen(command, mode);
50892819
GS
2036#else
2037 int p[2];
2038 int parent, child;
2039 int stdfd, oldfd;
2040 int ourmode;
2041 int childpid;
2042
2043 /* establish which ends read and write */
2044 if (strchr(mode,'w')) {
2045 stdfd = 0; /* stdin */
2046 parent = 1;
2047 child = 0;
2048 }
2049 else if (strchr(mode,'r')) {
2050 stdfd = 1; /* stdout */
2051 parent = 0;
2052 child = 1;
2053 }
2054 else
2055 return NULL;
2056
2057 /* set the correct mode */
2058 if (strchr(mode,'b'))
2059 ourmode = O_BINARY;
2060 else if (strchr(mode,'t'))
2061 ourmode = O_TEXT;
2062 else
2063 ourmode = _fmode & (O_TEXT | O_BINARY);
2064
2065 /* the child doesn't inherit handles */
2066 ourmode |= O_NOINHERIT;
2067
2068 if (win32_pipe( p, 512, ourmode) == -1)
2069 return NULL;
2070
2071 /* save current stdfd */
2072 if ((oldfd = win32_dup(stdfd)) == -1)
2073 goto cleanup;
2074
2075 /* make stdfd go to child end of pipe (implicitly closes stdfd) */
2076 /* stdfd will be inherited by the child */
2077 if (win32_dup2(p[child], stdfd) == -1)
2078 goto cleanup;
2079
2080 /* close the child end in parent */
2081 win32_close(p[child]);
2082
2083 /* start the child */
4f63d024
GS
2084 {
2085 dTHX;
0cb96387 2086 dPERLOBJ;
4f63d024
GS
2087 if ((childpid = do_spawn_nowait(aTHX_ (char*)command)) == -1)
2088 goto cleanup;
50892819 2089
4f63d024
GS
2090 /* revert stdfd to whatever it was before */
2091 if (win32_dup2(oldfd, stdfd) == -1)
2092 goto cleanup;
50892819 2093
4f63d024
GS
2094 /* close saved handle */
2095 win32_close(oldfd);
50892819 2096
4f63d024 2097 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
d91d68c1
R
2098
2099 /* set process id so that it can be returned by perl's open() */
2100 PL_forkprocess = childpid;
4f63d024 2101 }
50892819
GS
2102
2103 /* we have an fd, return a file stream */
2104 return (win32_fdopen(p[parent], (char *)mode));
2105
2106cleanup:
2107 /* we don't need to check for errors here */
2108 win32_close(p[0]);
2109 win32_close(p[1]);
2110 if (oldfd != -1) {
2111 win32_dup2(oldfd, stdfd);
2112 win32_close(oldfd);
2113 }
2114 return (NULL);
2115
4b556e6c 2116#endif /* USE_RTL_POPEN */
0a753a76
PP
2117}
2118
50892819
GS
2119/*
2120 * pclose() clone
2121 */
2122
68dc0745
PP
2123DllExport int
2124win32_pclose(FILE *pf)
0a753a76 2125{
4b556e6c 2126#ifdef USE_RTL_POPEN
390b85e7 2127 return _pclose(pf);
50892819 2128#else
4f63d024 2129 dTHX;
0cb96387 2130 dPERLOBJ;
e17cb2a9
JD
2131 int childpid, status;
2132 SV *sv;
2133
4b556e6c 2134 sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
e17cb2a9
JD
2135 if (SvIOK(sv))
2136 childpid = SvIVX(sv);
2137 else
2138 childpid = 0;
50892819
GS
2139
2140 if (!childpid) {
2141 errno = EBADF;
2142 return -1;
2143 }
2144
2145 win32_fclose(pf);
e17cb2a9
JD
2146 SvIVX(sv) = 0;
2147
0aaad0ff
GS
2148 if (win32_waitpid(childpid, &status, 0) == -1)
2149 return -1;
50892819 2150
0aaad0ff 2151 return status;
50892819 2152
4b556e6c 2153#endif /* USE_RTL_POPEN */
0a753a76
PP
2154}
2155
68dc0745 2156DllExport int
8d9b2e3c 2157win32_rename(const char *oname, const char *newname)
e24c7c18 2158{
7fac1903
GS
2159 WCHAR wOldName[MAX_PATH];
2160 WCHAR wNewName[MAX_PATH];
2161 BOOL bResult;
80252599
GS
2162 /* XXX despite what the documentation says about MoveFileEx(),
2163 * it doesn't work under Windows95!
2164 */
2165 if (IsWinNT()) {
0cb96387 2166 dPERLOBJ;
7fac1903 2167 if (USING_WIDE()) {
73c4f7a1 2168 dTHX;
0cb96387
GS
2169 A2WHELPER(oname, wOldName, sizeof(wOldName));
2170 A2WHELPER(newname, wNewName, sizeof(wNewName));
7fac1903
GS
2171 bResult = MoveFileExW(wOldName,wNewName,
2172 MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
2173 }
2174 else {
2175 bResult = MoveFileExA(oname,newname,
2176 MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
2177 }
2178 if (!bResult) {
80252599
GS
2179 DWORD err = GetLastError();
2180 switch (err) {
2181 case ERROR_BAD_NET_NAME:
2182 case ERROR_BAD_NETPATH:
2183 case ERROR_BAD_PATHNAME:
2184 case ERROR_FILE_NOT_FOUND:
2185 case ERROR_FILENAME_EXCED_RANGE:
2186 case ERROR_INVALID_DRIVE:
2187 case ERROR_NO_MORE_FILES:
2188 case ERROR_PATH_NOT_FOUND:
2189 errno = ENOENT;
2190 break;
2191 default:
2192 errno = EACCES;
2193 break;
2194 }
2195 return -1;
2196 }
2197 return 0;
e24c7c18 2198 }
80252599
GS
2199 else {
2200 int retval = 0;
2201 char tmpname[MAX_PATH+1];
2202 char dname[MAX_PATH+1];
2203 char *endname = Nullch;
2204 STRLEN tmplen = 0;
2205 DWORD from_attr, to_attr;
2206
2207 /* if oname doesn't exist, do nothing */
2208 from_attr = GetFileAttributes(oname);
2209 if (from_attr == 0xFFFFFFFF) {
2210 errno = ENOENT;
2211 return -1;
2212 }
2213
2214 /* if newname exists, rename it to a temporary name so that we
2215 * don't delete it in case oname happens to be the same file
2216 * (but perhaps accessed via a different path)
2217 */
2218 to_attr = GetFileAttributes(newname);
2219 if (to_attr != 0xFFFFFFFF) {
2220 /* if newname is a directory, we fail
2221 * XXX could overcome this with yet more convoluted logic */
2222 if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
2223 errno = EACCES;
2224 return -1;
2225 }
2226 tmplen = strlen(newname);
2227 strcpy(tmpname,newname);
2228 endname = tmpname+tmplen;
2229 for (; endname > tmpname ; --endname) {
2230 if (*endname == '/' || *endname == '\\') {
2231 *endname = '\0';
2232 break;
2233 }
2234 }
2235 if (endname > tmpname)
2236 endname = strcpy(dname,tmpname);
e24c7c18 2237 else
80252599
GS
2238 endname = ".";
2239
2240 /* get a temporary filename in same directory
2241 * XXX is this really the best we can do? */
2242 if (!GetTempFileName((LPCTSTR)endname, "plr", 0, tmpname)) {
2243 errno = ENOENT;
2244 return -1;
2245 }
2246 DeleteFile(tmpname);
2247
2248 retval = rename(newname, tmpname);
2249 if (retval != 0) {
2250 errno = EACCES;
2251 return retval;
e24c7c18
GS
2252 }
2253 }
80252599
GS
2254
2255 /* rename oname to newname */
2256 retval = rename(oname, newname);
2257
2258 /* if we created a temporary file before ... */
2259 if (endname != Nullch) {
2260 /* ...and rename succeeded, delete temporary file/directory */
2261 if (retval == 0)
2262 DeleteFile(tmpname);
2263 /* else restore it to what it was */
2264 else
2265 (void)rename(tmpname, newname);
2266 }
2267 return retval;
e24c7c18 2268 }
e24c7c18
GS
2269}
2270
2271DllExport int
68dc0745 2272win32_setmode(int fd, int mode)
0a753a76 2273{
390b85e7 2274 return setmode(fd, mode);
0a753a76
PP
2275}
2276
96e4d5b1
PP
2277DllExport long
2278win32_lseek(int fd, long offset, int origin)
2279{
390b85e7 2280 return lseek(fd, offset, origin);
96e4d5b1
PP
2281}
2282
2283DllExport long
2284win32_tell(int fd)
2285{
390b85e7 2286 return tell(fd);
96e4d5b1
PP
2287}
2288
68dc0745
PP
2289DllExport int
2290win32_open(const char *path, int flag, ...)
0a753a76 2291{
51371543 2292 dPERLOBJ;
68dc0745
PP
2293 va_list ap;
2294 int pmode;
b9010385 2295 WCHAR wBuffer[MAX_PATH];
0a753a76
PP
2296
2297 va_start(ap, flag);
2298 pmode = va_arg(ap, int);
2299 va_end(ap);
2300
68dc0745 2301 if (stricmp(path, "/dev/null")==0)
7fac1903
GS
2302 path = "NUL";
2303
2304 if (USING_WIDE()) {
73c4f7a1 2305 dTHX;
0cb96387 2306 A2WHELPER(path, wBuffer, sizeof(wBuffer));
7fac1903
GS
2307 return _wopen(wBuffer, flag, pmode);
2308 }
390b85e7 2309 return open(path,flag,pmode);
0a753a76
PP
2310}
2311
68dc0745
PP
2312DllExport int
2313win32_close(int fd)
0a753a76 2314{
390b85e7 2315 return close(fd);
0a753a76
PP
2316}
2317
68dc0745 2318DllExport int
96e4d5b1
PP
2319win32_eof(int fd)
2320{
390b85e7 2321 return eof(fd);
96e4d5b1
PP
2322}
2323
2324DllExport int
68dc0745 2325win32_dup(int fd)
0a753a76 2326{
390b85e7 2327 return dup(fd);
0a753a76
PP
2328}
2329
68dc0745
PP
2330DllExport int
2331win32_dup2(int fd1,int fd2)
0a753a76 2332{
390b85e7 2333 return dup2(fd1,fd2);
0a753a76
PP
2334}
2335
68dc0745 2336DllExport int
3e3baf6d 2337win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 2338{
390b85e7 2339 return read(fd, buf, cnt);
0a753a76
PP
2340}
2341
68dc0745 2342DllExport int
3e3baf6d 2343win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 2344{
390b85e7 2345 return write(fd, buf, cnt);
0a753a76
PP
2346}
2347
68dc0745 2348DllExport int
5aabfad6
PP
2349win32_mkdir(const char *dir, int mode)
2350{
390b85e7 2351 return mkdir(dir); /* just ignore mode */
5aabfad6 2352}
96e4d5b1 2353
5aabfad6
PP
2354DllExport int
2355win32_rmdir(const char *dir)
2356{
390b85e7 2357 return rmdir(dir);
5aabfad6 2358}
96e4d5b1 2359
5aabfad6
PP
2360DllExport int
2361win32_chdir(const char *dir)
2362{
390b85e7 2363 return chdir(dir);
5aabfad6 2364}
96e4d5b1 2365
0aaad0ff
GS
2366static char *
2367create_command_line(const char* command, const char * const *args)
2368{
51371543 2369 dPERLOBJ;
0aaad0ff
GS
2370 int index;
2371 char *cmd, *ptr, *arg;
2372 STRLEN len = strlen(command) + 1;
2373
2374 for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
2375 len += strlen(ptr) + 1;
2376
2377 New(1310, cmd, len, char);
2378 ptr = cmd;
2379 strcpy(ptr, command);
0aaad0ff
GS
2380
2381 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
0aaad0ff 2382 ptr += strlen(ptr);
18a945d4
GS
2383 *ptr++ = ' ';
2384 strcpy(ptr, arg);
0aaad0ff
GS
2385 }
2386
2387 return cmd;
2388}
2389
2390static char *
2391qualified_path(const char *cmd)
2392{
51371543 2393 dPERLOBJ;
0aaad0ff
GS
2394 char *pathstr;
2395 char *fullcmd, *curfullcmd;
2396 STRLEN cmdlen = 0;
2397 int has_slash = 0;
2398
2399 if (!cmd)
2400 return Nullch;
2401 fullcmd = (char*)cmd;
2402 while (*fullcmd) {
2403 if (*fullcmd == '/' || *fullcmd == '\\')
2404 has_slash++;
2405 fullcmd++;
2406 cmdlen++;
2407 }
2408
2409 /* look in PATH */
2410 pathstr = win32_getenv("PATH");
2411 New(0, fullcmd, MAX_PATH+1, char);
2412 curfullcmd = fullcmd;
2413
2414 while (1) {
2415 DWORD res;
2416
2417 /* start by appending the name to the current prefix */
2418 strcpy(curfullcmd, cmd);
2419 curfullcmd += cmdlen;
2420
2421 /* if it doesn't end with '.', or has no extension, try adding
2422 * a trailing .exe first */
2423 if (cmd[cmdlen-1] != '.'
2424 && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
2425 {
2426 strcpy(curfullcmd, ".exe");
2427 res = GetFileAttributes(fullcmd);
2428 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
2429 return fullcmd;
2430 *curfullcmd = '\0';
2431 }
2432
2433 /* that failed, try the bare name */
2434 res = GetFileAttributes(fullcmd);
2435 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
2436 return fullcmd;
2437
2438 /* quit if no other path exists, or if cmd already has path */
2439 if (!pathstr || !*pathstr || has_slash)
2440 break;
2441
2442 /* skip leading semis */
2443 while (*pathstr == ';')
2444 pathstr++;
2445
2446 /* build a new prefix from scratch */
2447 curfullcmd = fullcmd;
2448 while (*pathstr && *pathstr != ';') {
2449 if (*pathstr == '"') { /* foo;"baz;etc";bar */
2450 pathstr++; /* skip initial '"' */
2451 while (*pathstr && *pathstr != '"') {
2452 if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
2453 *curfullcmd++ = *pathstr;
2454 pathstr++;
2455 }
2456 if (*pathstr)
2457 pathstr++; /* skip trailing '"' */
2458 }
2459 else {
2460 if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
2461 *curfullcmd++ = *pathstr;
2462 pathstr++;
2463 }
2464 }
2465 if (*pathstr)
2466 pathstr++; /* skip trailing semi */
2467 if (curfullcmd > fullcmd /* append a dir separator */
2468 && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
2469 {
2470 *curfullcmd++ = '\\';
2471 }
2472 }
2473GIVE_UP:
2474 Safefree(fullcmd);
2475 return Nullch;
2476}
2477
2478/* XXX this needs to be made more compatible with the spawnvp()
2479 * provided by the various RTLs. In particular, searching for
2480 * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
2481 * This doesn't significantly affect perl itself, because we
2482 * always invoke things using PERL5SHELL if a direct attempt to
2483 * spawn the executable fails.
2484 *
2485 * XXX splitting and rejoining the commandline between do_aspawn()
2486 * and win32_spawnvp() could also be avoided.
2487 */
2488
5aabfad6 2489DllExport int
3e3baf6d 2490win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
0a753a76 2491{
0aaad0ff
GS
2492#ifdef USE_RTL_SPAWNVP
2493 return spawnvp(mode, cmdname, (char * const *)argv);
2494#else
51371543 2495 dPERLOBJ;
0aaad0ff
GS
2496 DWORD ret;
2497 STARTUPINFO StartupInfo;
2498 PROCESS_INFORMATION ProcessInformation;
2499 DWORD create = 0;
2500
2501 char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
2502 ? &argv[1] : argv);
2503 char *fullcmd = Nullch;
2504
2505 switch(mode) {
2506 case P_NOWAIT: /* asynch + remember result */
2507 if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
2508 errno = EAGAIN;
2509 ret = -1;
2510 goto RETVAL;
2511 }
2512 /* FALL THROUGH */
2513 case P_WAIT: /* synchronous execution */
2514 break;
2515 default: /* invalid mode */
2516 errno = EINVAL;
2517 ret = -1;
2518 goto RETVAL;
2519 }
2520 memset(&StartupInfo,0,sizeof(StartupInfo));
2521 StartupInfo.cb = sizeof(StartupInfo);
3ffaa937
GS
2522 StartupInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
2523 StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
2524 StartupInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);
2525 if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE &&
2526 StartupInfo.hStdOutput != INVALID_HANDLE_VALUE &&
2527 StartupInfo.hStdError != INVALID_HANDLE_VALUE)
2528 {
2529 StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
2530 }
2531 else {
2532 create |= CREATE_NEW_CONSOLE;
2533 }
2534
2535#ifndef DEBUGGING
2536 StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
2537 StartupInfo.wShowWindow = SW_HIDE;
2538#endif
0aaad0ff
GS
2539
2540RETRY:
2541 if (!CreateProcess(cmdname, /* search PATH to find executable */
2542 cmd, /* executable, and its arguments */
2543 NULL, /* process attributes */
2544 NULL, /* thread attributes */
2545 TRUE, /* inherit handles */
2546 create, /* creation flags */
2547 NULL, /* inherit environment */
2548 NULL, /* inherit cwd */
2549 &StartupInfo,
2550 &ProcessInformation))
2551 {
2552 /* initial NULL argument to CreateProcess() does a PATH
2553 * search, but it always first looks in the directory
2554 * where the current process was started, which behavior
2555 * is undesirable for backward compatibility. So we
2556 * jump through our own hoops by picking out the path
2557 * we really want it to use. */
2558 if (!fullcmd) {
2559 fullcmd = qualified_path(cmdname);
2560 if (fullcmd) {
2561 cmdname = fullcmd;
2562 goto RETRY;
2563 }
2564 }
2565 errno = ENOENT;
2566 ret = -1;
2567 goto RETVAL;
2568 }
2d7a9237 2569
0aaad0ff
GS
2570 if (mode == P_NOWAIT) {
2571 /* asynchronous spawn -- store handle, return PID */
2572 w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
2573 ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
2574 ++w32_num_children;
2575 }
2576 else {
2577 WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
2578 GetExitCodeProcess(ProcessInformation.hProcess, &ret);
2579 CloseHandle(ProcessInformation.hProcess);
2580 }
e17cb2a9 2581
0aaad0ff
GS
2582 CloseHandle(ProcessInformation.hThread);
2583RETVAL:
2584 Safefree(cmd);
2585 Safefree(fullcmd);
2586 return (int)ret;
2d7a9237 2587#endif
0a753a76
PP
2588}
2589
6890e559 2590DllExport int
eb62e965
JD
2591win32_execv(const char *cmdname, const char *const *argv)
2592{
2593 return execv(cmdname, (char *const *)argv);
2594}
2595
2596DllExport int
6890e559
GS
2597win32_execvp(const char *cmdname, const char *const *argv)
2598{
390b85e7 2599 return execvp(cmdname, (char *const *)argv);
6890e559
GS
2600}
2601
84902520
TB
2602DllExport void
2603win32_perror(const char *str)
2604{
390b85e7 2605 perror(str);
84902520
TB
2606}
2607
2608DllExport void
2609win32_setbuf(FILE *pf, char *buf)
2610{
390b85e7 2611 setbuf(pf, buf);
84902520
TB
2612}
2613
2614DllExport int
2615win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
2616{
390b85e7 2617 return setvbuf(pf, buf, type, size);
84902520
TB
2618}
2619
2620DllExport int
2621win32_flushall(void)
2622{
390b85e7 2623 return flushall();
84902520
TB
2624}
2625
2626DllExport int
2627win32_fcloseall(void)
2628{
390b85e7 2629 return fcloseall();
84902520
TB
2630}
2631
2632DllExport char*
2633win32_fgets(char *s, int n, FILE *pf)
2634{
390b85e7 2635 return fgets(s, n, pf);
84902520
TB
2636}
2637
2638DllExport char*
2639win32_gets(char *s)
2640{
390b85e7 2641 return gets(s);
84902520
TB
2642}
2643
2644DllExport int
2645win32_fgetc(FILE *pf)
2646{
390b85e7 2647 return fgetc(pf);
84902520
TB
2648}
2649
2650DllExport int
2651win32_putc(int c, FILE *pf)
2652{
390b85e7 2653 return putc(c,pf);
84902520
TB
2654}
2655
2656DllExport int
2657win32_puts(const char *s)
2658{
390b85e7 2659 return puts(s);
84902520
TB
2660}
2661
2662DllExport int
2663win32_getchar(void)
2664{
390b85e7 2665 return getchar();
84902520
TB
2666}
2667
2668DllExport int
2669win32_putchar(int c)
2670{
390b85e7 2671 return putchar(c);
84902520
TB
2672}
2673
bbc8f9de
NIS
2674#ifdef MYMALLOC
2675
2676#ifndef USE_PERL_SBRK
2677
2678static char *committed = NULL;
2679static char *base = NULL;
2680static char *reserved = NULL;
2681static char *brk = NULL;
2682static DWORD pagesize = 0;
2683static DWORD allocsize = 0;
2684
2685void *
2686sbrk(int need)
2687{
2688 void *result;
2689 if (!pagesize)
2690 {SYSTEM_INFO info;
2691 GetSystemInfo(&info);
2692 /* Pretend page size is larger so we don't perpetually
2693 * call the OS to commit just one page ...
2694 */
2695 pagesize = info.dwPageSize << 3;
2696 allocsize = info.dwAllocationGranularity;
2697 }
2698 /* This scheme fails eventually if request for contiguous
2699 * block is denied so reserve big blocks - this is only
2700 * address space not memory ...
2701 */
2702 if (brk+need >= reserved)
2703 {
2704 DWORD size = 64*1024*1024;
2705 char *addr;
2706 if (committed && reserved && committed < reserved)
2707 {
2708 /* Commit last of previous chunk cannot span allocations */
161b471a 2709 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de
NIS
2710 if (addr)
2711 committed = reserved;
2712 }
2713 /* Reserve some (more) space
2714 * Note this is a little sneaky, 1st call passes NULL as reserved
2715 * so lets system choose where we start, subsequent calls pass
2716 * the old end address so ask for a contiguous block
2717 */
161b471a 2718 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
bbc8f9de
NIS
2719 if (addr)
2720 {
2721 reserved = addr+size;
2722 if (!base)
2723 base = addr;
2724 if (!committed)
2725 committed = base;
2726 if (!brk)
2727 brk = committed;
2728 }
2729 else
2730 {
2731 return (void *) -1;
2732 }
2733 }
2734 result = brk;
2735 brk += need;
2736 if (brk > committed)
2737 {
2738 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
161b471a 2739 char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de
NIS
2740 if (addr)
2741 {
2742 committed += size;
2743 }
2744 else
2745 return (void *) -1;
2746 }
2747 return result;
2748}
2749
2750#endif
2751#endif
2752
84902520
TB
2753DllExport void*
2754win32_malloc(size_t size)
2755{
390b85e7 2756 return malloc(size);
84902520
TB
2757}
2758
2759DllExport void*
2760win32_calloc(size_t numitems, size_t size)
2761{
390b85e7 2762 return calloc(numitems,size);
84902520
TB
2763}
2764
2765DllExport void*
2766win32_realloc(void *block, size_t size)
2767{
390b85e7 2768 return realloc(block,size);
84902520
TB
2769}
2770
2771DllExport void
2772win32_free(void *block)
2773{
390b85e7 2774 free(block);
84902520
TB
2775}
2776
bbc8f9de 2777
68dc0745 2778int
65e48ea9 2779win32_open_osfhandle(long handle, int flags)
0a753a76 2780{
390b85e7 2781 return _open_osfhandle(handle, flags);
0a753a76
PP
2782}
2783
68dc0745 2784long
65e48ea9 2785win32_get_osfhandle(int fd)
0a753a76 2786{
390b85e7 2787 return _get_osfhandle(fd);
0a753a76 2788}
7bac28a0 2789
0cb96387
GS
2790DllExport void*
2791win32_dynaload(aTHX_ const char*filename)
2792{
0cb96387 2793 dPERLOBJ;
51371543 2794 HMODULE hModule;
0cb96387
GS
2795 if (USING_WIDE()) {
2796 WCHAR wfilename[MAX_PATH];
2797 A2WHELPER(filename, wfilename, sizeof(wfilename));
2798 hModule = LoadLibraryExW(wfilename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
2799 }
2800 else {
2801 hModule = LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
2802 }
2803 return hModule;
2804}
2805
2806DllExport int
2807win32_add_host(char *nameId, void *data)
2808{
2809 /*
2810 * This must be called before the script is parsed,
2811 * therefore no locking of threads is needed
2812 */
2813 dTHX;
2814 dPERLOBJ;
2815 struct host_link *link;
2816 New(1314, link, 1, struct host_link);
2817 link->host_data = data;
2818 link->nameId = nameId;
2819 link->next = w32_host_link;
2820 w32_host_link = link;
2821 return 1;
2822}
2823
2824DllExport void *
2825win32_get_host_data(char *nameId)
2826{
2827 dTHX;
2828 dPERLOBJ;
2829 struct host_link *link = w32_host_link;
2830 while(link) {
2831 if(strEQ(link->nameId, nameId))
2832 return link->host_data;
2833 link = link->next;
2834 }
2835 return Nullch;
2836}
2837
7bac28a0
PP
2838/*
2839 * Extras.
2840 */
2841
ad2e33dc
GS
2842static
2843XS(w32_GetCwd)
2844{
2845 dXSARGS;
2846 SV *sv = sv_newmortal();
2847 /* Make one call with zero size - return value is required size */
2848 DWORD len = GetCurrentDirectory((DWORD)0,NULL);
2849 SvUPGRADE(sv,SVt_PV);
2850 SvGROW(sv,len);
2851 SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
2852 /*
2853 * If result != 0
2854 * then it worked, set PV valid,
2855 * else leave it 'undef'
2856 */
3467312b 2857 EXTEND(SP,1);
bb897dfc 2858 if (SvCUR(sv)) {
ad2e33dc 2859 SvPOK_on(sv);
bb897dfc
JD
2860 ST(0) = sv;
2861 XSRETURN(1);
2862 }
3467312b 2863 XSRETURN_UNDEF;
ad2e33dc
GS
2864}
2865
2866static
2867XS(w32_SetCwd)
2868{
2869 dXSARGS;
2870 if (items != 1)
4f63d024 2871 Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
bb897dfc 2872 if (SetCurrentDirectory(SvPV_nolen(ST(0))))
ad2e33dc
GS
2873 XSRETURN_YES;
2874
2875 XSRETURN_NO;
2876}
2877
2878static
2879XS(w32_GetNextAvailDrive)
2880{
2881 dXSARGS;
2882 char ix = 'C';
2883 char root[] = "_:\\";
3467312b
JD
2884
2885 EXTEND(SP,1);
ad2e33dc
GS
2886 while (ix <= 'Z') {
2887 root[0] = ix++;
2888 if (GetDriveType(root) == 1) {
2889 root[2] = '\0';
2890 XSRETURN_PV(root);
2891 }
2892 }
3467312b 2893 XSRETURN_UNDEF;
ad2e33dc
GS
2894}
2895
2896static
2897XS(w32_GetLastError)
2898{
2899 dXSARGS;
bb897dfc 2900 EXTEND(SP,1);
ad2e33dc
GS
2901 XSRETURN_IV(GetLastError());
2902}
2903
2904static
ca135624
JD
2905XS(w32_SetLastError)
2906{
2907 dXSARGS;
2908 if (items != 1)
4f63d024 2909 Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
ca135624 2910 SetLastError(SvIV(ST(0)));
bb897dfc 2911 XSRETURN_EMPTY;
ca135624
JD
2912}
2913
2914static
ad2e33dc
GS
2915XS(w32_LoginName)
2916{
2917 dXSARGS;
e34ffe5a
GS
2918 char *name = getlogin_buffer;
2919 DWORD size = sizeof(getlogin_buffer);
3467312b 2920 EXTEND(SP,1);
ad2e33dc
GS
2921 if (GetUserName(name,&size)) {
2922 /* size includes NULL */
79cb57f6 2923 ST(0) = sv_2mortal(newSVpvn(name,size-1));
ad2e33dc
GS
2924 XSRETURN(1);
2925 }
3467312b 2926 XSRETURN_UNDEF;
ad2e33dc
GS
2927}
2928
2929static
2930XS(w32_NodeName)
2931{
2932 dXSARGS;
2933 char name[MAX_COMPUTERNAME_LENGTH+1];
2934 DWORD size = sizeof(name);
3467312b 2935 EXTEND(SP,1);
ad2e33dc
GS
2936 if (GetComputerName(name,&size)) {
2937 /* size does NOT include NULL :-( */
79cb57f6 2938 ST(0) = sv_2mortal(newSVpvn(name,size));
ad2e33dc
GS
2939 XSRETURN(1);
2940 }
3467312b 2941 XSRETURN_UNDEF;
ad2e33dc
GS
2942}
2943
2944
2945static
2946XS(w32_DomainName)
2947{
2948 dXSARGS;
8c9208bc
GS
2949#ifndef HAS_NETWKSTAGETINFO
2950 /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
ad2e33dc
GS
2951 char name[256];
2952 DWORD size = sizeof(name);
3467312b 2953 EXTEND(SP,1);
ad2e33dc
GS
2954 if (GetUserName(name,&size)) {
2955 char sid[1024];
2956 DWORD sidlen = sizeof(sid);
2957 char dname[256];
2958 DWORD dnamelen = sizeof(dname);
2959 SID_NAME_USE snu;
db15561c 2960 if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
ad2e33dc
GS
2961 dname, &dnamelen, &snu)) {
2962 XSRETURN_PV(dname); /* all that for this */
2963 }
2964 }
e56670dd 2965#else
8c9208bc
GS
2966 /* this way is more reliable, in case user has a local account.
2967 * XXX need dynamic binding of netapi32.dll symbols or this will fail on
2968 * Win95. Probably makes more sense to move it into libwin32. */
9404a519
GS
2969 char dname[256];
2970 DWORD dnamelen = sizeof(dname);
0a2408cf 2971 PWKSTA_INFO_100 pwi;
3467312b 2972 EXTEND(SP,1);
0a2408cf
GS
2973 if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
2974 if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
2975 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
2976 -1, (LPSTR)dname, dnamelen, NULL, NULL);
2977 }
2978 else {
2979 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
2980 -1, (LPSTR)dname, dnamelen, NULL, NULL);
2981 }
2982 NetApiBufferFree(pwi);
9404a519
GS
2983 XSRETURN_PV(dname);
2984 }
e56670dd 2985#endif
3467312b 2986 XSRETURN_UNDEF;
ad2e33dc
GS
2987}
2988
2989static
2990XS(w32_FsType)
2991{
2992 dXSARGS;
2993 char fsname[256];
2994 DWORD flags, filecomplen;
2995 if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
2996 &flags, fsname, sizeof(fsname))) {
bb897dfc 2997 if (GIMME_V == G_ARRAY) {
79cb57f6 2998 XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
ad2e33dc
GS
2999 XPUSHs(sv_2mortal(newSViv(flags)));
3000 XPUSHs(sv_2mortal(newSViv(filecomplen)));
3001 PUTBACK;
3002 return;
3003 }
bb897dfc 3004 EXTEND(SP,1);
ad2e33dc
GS
3005 XSRETURN_PV(fsname);
3006 }
bb897dfc 3007 XSRETURN_EMPTY;
ad2e33dc
GS
3008}
3009
3010static
3011XS(w32_GetOSVersion)
3012{
3013 dXSARGS;
3014 OSVERSIONINFO osver;
3015
3016 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
3017 if (GetVersionEx(&osver)) {
79cb57f6 3018 XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
ad2e33dc
GS
3019 XPUSHs(newSViv(osver.dwMajorVersion));
3020 XPUSHs(newSViv(osver.dwMinorVersion));
3021 XPUSHs(newSViv(osver.dwBuildNumber));
3022 XPUSHs(newSViv(osver.dwPlatformId));
3023 PUTBACK;
3024 return;
3025 }
bb897dfc 3026 XSRETURN_EMPTY;
ad2e33dc
GS
3027}
3028
3029static
3030XS(w32_IsWinNT)
3031{
3032 dXSARGS;
bb897dfc 3033 EXTEND(SP,1);
ad2e33dc
GS
3034 XSRETURN_IV(IsWinNT());
3035}
3036
3037static
3038XS(w32_IsWin95)
3039{
3040 dXSARGS;
bb897dfc 3041 EXTEND(SP,1);
ad2e33dc
GS
3042 XSRETURN_IV(IsWin95());
3043}
3044
3045static
3046XS(w32_FormatMessage)
3047{
3048 dXSARGS;
3049 DWORD source = 0;
3050 char msgbuf[1024];
3051
3052 if (items != 1)
4f63d024 3053 Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
ad2e33dc
GS
3054
3055 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
3056 &source, SvIV(ST(0)), 0,
3057 msgbuf, sizeof(msgbuf)-1, NULL))
3058 XSRETURN_PV(msgbuf);
3059
3467312b 3060 XSRETURN_UNDEF;
ad2e33dc
GS
3061}
3062
3063static
3064XS(w32_Spawn)
3065{
3066 dXSARGS;
3067 char *cmd, *args;
3068 PROCESS_INFORMATION stProcInfo;
3069 STARTUPINFO stStartInfo;
3070 BOOL bSuccess = FALSE;
3071
9404a519 3072 if (items != 3)
4f63d024 3073 Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
ad2e33dc 3074
bb897dfc
JD
3075 cmd = SvPV_nolen(ST(0));
3076 args = SvPV_nolen(ST(1));
ad2e33dc
GS
3077
3078 memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
3079 stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
3080 stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
3081 stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
3082
9404a519 3083 if (CreateProcess(
ad2e33dc
GS
3084 cmd, /* Image path */
3085 args, /* Arguments for command line */
3086 NULL, /* Default process security */
3087 NULL, /* Default thread security */
3088 FALSE, /* Must be TRUE to use std handles */
3089 NORMAL_PRIORITY_CLASS, /* No special scheduling */
3090 NULL, /* Inherit our environment block */
3091 NULL, /* Inherit our currrent directory */
3092 &stStartInfo, /* -> Startup info */
3093 &stProcInfo)) /* <- Process info (if OK) */
3094 {
3095 CloseHandle(stProcInfo.hThread);/* library source code does this. */
3096 sv_setiv(ST(2), stProcInfo.dwProcessId);
3097 bSuccess = TRUE;
3098 }
3099 XSRETURN_IV(bSuccess);
3100}
3101
3102static
3103XS(w32_GetTickCount)
3104{
3105 dXSARGS;
fdb068fa 3106 DWORD msec = GetTickCount();
a6c40364 3107 EXTEND(SP,1);
fdb068fa
JD
3108 if ((IV)msec > 0)
3109 XSRETURN_IV(msec);
3110 XSRETURN_NV(msec);
ad2e33dc
GS
3111}
3112
3113static
3114XS(w32_GetShortPathName)
3115{
3116 dXSARGS;
3117 SV *shortpath;
e8bab181 3118 DWORD len;
ad2e33dc 3119
9404a519 3120 if (items != 1)
4f63d024 3121 Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
ad2e33dc
GS
3122
3123 shortpath = sv_mortalcopy(ST(0));
3124 SvUPGRADE(shortpath, SVt_PV);
3125 /* src == target is allowed */
e8bab181
GS
3126 do {
3127 len = GetShortPathName(SvPVX(shortpath),
3128 SvPVX(shortpath),
3129 SvLEN(shortpath));
3130 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
3131 if (len) {
3132 SvCUR_set(shortpath,len);
ad2e33dc 3133 ST(0) = shortpath;
bb897dfc 3134 XSRETURN(1);
e8bab181 3135 }
3467312b 3136 XSRETURN_UNDEF;
ad2e33dc
GS
3137}
3138
ad0751ec 3139static
ca135624
JD
3140XS(w32_GetFullPathName)
3141{
3142 dXSARGS;
3143 SV *filename;
3144 SV *fullpath;
3145 char *filepart;
3146 DWORD len;
3147
3148 if (items != 1)
4f63d024 3149 Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
ca135624
JD
3150
3151 filename = ST(0);
3152 fullpath = sv_mortalcopy(filename);
3153 SvUPGRADE(fullpath, SVt_PV);
3154 do {
3155 len = GetFullPathName(SvPVX(filename),
3156 SvLEN(fullpath),
3157 SvPVX(fullpath),
3158 &filepart);
3159 } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
3160 if (len) {
3161 if (GIMME_V == G_ARRAY) {
3162 EXTEND(SP,1);
bb897dfc 3163 XST_mPV(1,filepart);
ca135624
JD
3164 len = filepart - SvPVX(fullpath);
3165 items = 2;
3166 }
3167 SvCUR_set(fullpath,len);
3168 ST(0) = fullpath;
bb897dfc 3169 XSRETURN(items);
ca135624 3170 }
bb897dfc 3171 XSRETURN_EMPTY;
ca135624
JD
3172}
3173
3174static
8ac9c18d
GS
3175XS(w32_GetLongPathName)
3176{
3177 dXSARGS;
3178 SV *path;
3179 char tmpbuf[MAX_PATH+1];
3180 char *pathstr;
3181 STRLEN len;
3182
3183 if (items != 1)
4f63d024 3184 Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
8ac9c18d
GS
3185
3186 path = ST(0);
3187 pathstr = SvPV(path,len);
3188 strcpy(tmpbuf, pathstr);
3189 pathstr = win32_longpath(tmpbuf);
3190 if (pathstr) {
3191 ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
3192 XSRETURN(1);
3193 }
3194 XSRETURN_EMPTY;
3195}
3196
3197static
ad0751ec
GS
3198XS(w32_Sleep)
3199{
3200 dXSARGS;
3201 if (items != 1)
4f63d024 3202 Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
ad0751ec
GS
3203 Sleep(SvIV(ST(0)));
3204 XSRETURN_YES;
3205}
3206
7509b657
GS
3207static
3208XS(w32_CopyFile)
3209{
3210 dXSARGS;
3211 if (items != 3)
4f63d024 3212 Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
7509b657
GS
3213 if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2))))
3214 XSRETURN_YES;
3215 XSRETURN_NO;
3216}
3217
ad2e33dc 3218void
4f63d024 3219Perl_init_os_extras(pTHX)
ad2e33dc 3220{
51371543 3221 dPERLOBJ;
ad2e33dc
GS
3222 char *file = __FILE__;
3223 dXSUB_SYS;
3224
4b556e6c
JD
3225 w32_perlshell_tokens = Nullch;
3226 w32_perlshell_items = -1;
3227 w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
0aaad0ff 3228 New(1313, w32_children, 1, child_tab);
4b556e6c 3229 w32_num_children = 0;
4b556e6c 3230
ad2e33dc
GS
3231 /* these names are Activeware compatible */
3232 newXS("Win32::GetCwd", w32_GetCwd, file);
3233 newXS("Win32::SetCwd", w32_SetCwd, file);
3234 newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
3235 newXS("Win32::GetLastError", w32_GetLastError, file);
ca135624 3236 newXS("Win32::SetLastError", w32_SetLastError, file);
ad2e33dc
GS
3237 newXS("Win32::LoginName", w32_LoginName, file);
3238 newXS("Win32::NodeName", w32_NodeName, file);
3239 newXS("Win32::DomainName", w32_DomainName, file);
3240 newXS("Win32::FsType", w32_FsType, file);
3241 newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
3242 newXS("Win32::IsWinNT", w32_IsWinNT, file);
3243 newXS("Win32::IsWin95", w32_IsWin95, file);
3244 newXS("Win32::FormatMessage", w32_FormatMessage, file);
3245 newXS("Win32::Spawn", w32_Spawn, file);
3246 newXS("Win32::GetTickCount", w32_GetTickCount, file);
3247 newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
ca135624 3248 newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
8ac9c18d 3249 newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
7509b657 3250 newXS("Win32::CopyFile", w32_CopyFile, file);
ad0751ec 3251 newXS("Win32::Sleep", w32_Sleep, file);
ad2e33dc
GS
3252
3253 /* XXX Bloat Alert! The following Activeware preloads really
3254 * ought to be part of Win32::Sys::*, so they're not included
3255 * here.
3256 */
3257 /* LookupAccountName
3258 * LookupAccountSID
3259 * InitiateSystemShutdown
3260 * AbortSystemShutdown
3261 * ExpandEnvrironmentStrings
3262 */
3263}
3264
3265void
3266Perl_win32_init(int *argcp, char ***argvp)
3267{
3268 /* Disable floating point errors, Perl will trap the ones we
3269 * care about. VC++ RTL defaults to switching these off
3270 * already, but the Borland RTL doesn't. Since we don't
3271 * want to be at the vendor's whim on the default, we set
3272 * it explicitly here.
3273 */
a835ef8a 3274#if !defined(_ALPHA_) && !defined(__GNUC__)
ad2e33dc 3275 _control87(MCW_EM, MCW_EM);
3dc9191e 3276#endif
4b556e6c 3277 MALLOC_INIT;
ad2e33dc 3278}
d55594ae 3279
a868473f
NIS
3280#ifdef USE_BINMODE_SCRIPTS
3281
3282void
3283win32_strip_return(SV *sv)
3284{
3285 char *s = SvPVX(sv);
3286 char *e = s+SvCUR(sv);
3287 char *d = s;
3288 while (s < e)
3289 {
3290 if (*s == '\r' && s[1] == '\n')
3291 {
3292 *d++ = '\n';
3293 s += 2;
3294 }
3295 else
3296 {
3297 *d++ = *s++;
3298 }
3299 }
3300 SvCUR_set(sv,d-SvPVX(sv));
3301}
3302
3303#endif
0cb96387 3304