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