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