This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
various tweaks for PERL_OBJECT build & test
[perl5.git] / win32 / win32.c
CommitLineData
68dc0745
PP
1/* WIN32.C
2 *
3 * (c) 1995 Microsoft Corporation. All rights reserved.
4 * Developed by hip communications inc., http://info.hip.com/info/
5 * Portions (c) 1993 Intergraph Corporation. All rights reserved.
6 *
7 * You may distribute under the terms of either the GNU General Public
8 * License or the Artistic License, as specified in the README file.
9 */
0a753a76
PP
10
11#define WIN32_LEAN_AND_MEAN
12#define WIN32IO_IS_STDIO
13#include <tchar.h>
a835ef8a
NIS
14#ifdef __GNUC__
15#define Win32_Winsock
ac4c12e7
GS
16# ifdef __cplusplus
17#undef __attribute__ /* seems broken in 2.8.0 */
18#define __attribute__(p)
19# endif
a835ef8a 20#endif
0a753a76
PP
21#include <windows.h>
22
e56670dd 23#ifndef __MINGW32__
9404a519
GS
24#include <lmcons.h>
25#include <lmerr.h>
26/* ugliness to work around a buggy struct definition in lmwksta.h */
27#undef LPTSTR
28#define LPTSTR LPWSTR
29#include <lmwksta.h>
30#undef LPTSTR
31#define LPTSTR LPSTR
e56670dd
GS
32#include <lmapibuf.h>
33#endif /* __MINGW32__ */
9404a519 34
68dc0745 35/* #include "config.h" */
0a753a76
PP
36
37#define PERLIO_NOT_STDIO 0
38#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
39#define PerlIO FILE
40#endif
41
42#include "EXTERN.h"
43#include "perl.h"
c69f6586
GS
44
45#define NO_XSLOCKS
46#ifdef PERL_OBJECT
47extern CPerlObj* pPerl;
48#endif
ad2e33dc 49#include "XSUB.h"
c69f6586
GS
50
51#include "Win32iop.h"
0a753a76
PP
52#include <fcntl.h>
53#include <sys/stat.h>
5b0d9cbe
NIS
54#ifndef __GNUC__
55/* assert.h conflicts with #define of assert in perl.h */
0a753a76 56#include <assert.h>
5b0d9cbe 57#endif
0a753a76
PP
58#include <string.h>
59#include <stdarg.h>
ad2e33dc 60#include <float.h>
ad0751ec 61#include <time.h>
3730b96e 62#if defined(_MSC_VER) || defined(__MINGW32__)
ad0751ec
GS
63#include <sys/utime.h>
64#else
65#include <utime.h>
66#endif
0a753a76 67
5b0d9cbe
NIS
68#ifdef __GNUC__
69/* Mingw32 defaults to globing command line
70 * So we turn it off like this:
71 */
72int _CRT_glob = 0;
73#endif
74
6890e559
GS
75#define EXECF_EXEC 1
76#define EXECF_SPAWN 2
77#define EXECF_SPAWN_NOWAIT 3
78
c69f6586 79#if defined(PERL_OBJECT)
e5a95ffb
GS
80#undef win32_get_privlib
81#define win32_get_privlib g_win32_get_privlib
00dc2f4f
GS
82#undef win32_get_sitelib
83#define win32_get_sitelib g_win32_get_sitelib
c69f6586
GS
84#undef do_aspawn
85#define do_aspawn g_do_aspawn
86#undef do_spawn
87#define do_spawn g_do_spawn
88#undef do_exec
89#define do_exec g_do_exec
c69f6586
GS
90#undef getlogin
91#define getlogin g_getlogin
92#endif
93
2d7a9237 94static DWORD os_id(void);
ce1da67e
GS
95static void get_shell(void);
96static long tokenize(char *str, char **dest, char ***destv);
c69f6586 97 int do_spawn2(char *cmd, int exectype);
2d7a9237
GS
98static BOOL has_redirection(char *ptr);
99static long filetime_to_clock(PFILETIME ft);
ad0751ec 100static BOOL filetime_from_time(PFILETIME ft, time_t t);
e5a95ffb 101static char * get_emd_part(char *leading, char *trailing, ...);
f55ee38a 102static void remove_dead_process(HANDLE deceased);
c69f6586 103
2d7a9237 104HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
4b556e6c 105static DWORD w32_platform = (DWORD)-1;
50892819 106
26618a56
GS
107#ifdef USE_THREADS
108# ifdef USE_DECLSPEC_THREAD
109__declspec(thread) char strerror_buffer[512];
e34ffe5a 110__declspec(thread) char getlogin_buffer[128];
4b556e6c 111__declspec(thread) char w32_perllib_root[MAX_PATH+1];
26618a56
GS
112# ifdef HAVE_DES_FCRYPT
113__declspec(thread) char crypt_buffer[30];
114# endif
115# else
116# define strerror_buffer (thr->i.Wstrerror_buffer)
e34ffe5a 117# define getlogin_buffer (thr->i.Wgetlogin_buffer)
4b556e6c 118# define w32_perllib_root (thr->i.Ww32_perllib_root)
26618a56
GS
119# define crypt_buffer (thr->i.Wcrypt_buffer)
120# endif
121#else
4b556e6c
JD
122static char strerror_buffer[512];
123static char getlogin_buffer[128];
124static char w32_perllib_root[MAX_PATH+1];
26618a56 125# ifdef HAVE_DES_FCRYPT
4b556e6c 126static char crypt_buffer[30];
26618a56
GS
127# endif
128#endif
129
3fe9a6f1
PP
130int
131IsWin95(void) {
2d7a9237 132 return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
3fe9a6f1
PP
133}
134
135int
136IsWinNT(void) {
2d7a9237 137 return (os_id() == VER_PLATFORM_WIN32_NT);
3fe9a6f1 138}
0a753a76 139
00dc2f4f
GS
140char*
141GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
142{ /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
143 HKEY handle;
144 DWORD type;
145 const char *subkey = "Software\\Perl";
146 long retval;
147
148 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
ba3eb2af 149 if (retval == ERROR_SUCCESS){
00dc2f4f 150 retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
ba3eb2af
GS
151 if (retval == ERROR_SUCCESS && type == REG_SZ) {
152 if (*ptr != NULL) {
00dc2f4f
GS
153 Renew(*ptr, *lpDataLen, char);
154 }
155 else {
156 New(1312, *ptr, *lpDataLen, char);
157 }
158 retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
ba3eb2af 159 if (retval != ERROR_SUCCESS) {
e5a95ffb
GS
160 Safefree(*ptr);
161 *ptr = NULL;
00dc2f4f
GS
162 }
163 }
164 RegCloseKey(handle);
165 }
166 return *ptr;
167}
168
169char*
170GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
171{
172 *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
ba3eb2af 173 if (*ptr == NULL)
00dc2f4f
GS
174 {
175 *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
176 }
177 return *ptr;
178}
179
e5a95ffb
GS
180static char *
181get_emd_part(char *prev_path, char *trailing_path, ...)
00dc2f4f 182{
e5a95ffb 183 va_list ap;
e24c7c18 184 char mod_name[MAX_PATH+1];
00dc2f4f 185 char *ptr;
e5a95ffb
GS
186 char *optr;
187 char *strip;
188 int oldsize, newsize;
189
190 va_start(ap, trailing_path);
191 strip = va_arg(ap, char *);
192
123cbbb4
GS
193 GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
194 ? GetModuleHandle(NULL)
195 : w32_perldll_handle, mod_name, sizeof(mod_name));
e5a95ffb
GS
196 ptr = strrchr(mod_name, '\\');
197 while (ptr && strip) {
198 /* look for directories to skip back */
199 optr = ptr;
00dc2f4f 200 *ptr = '\0';
e5a95ffb
GS
201 ptr = strrchr(mod_name, '\\');
202 if (!ptr || stricmp(ptr+1, strip) != 0) {
203 *optr = '\\';
204 ptr = optr;
00dc2f4f 205 }
e5a95ffb 206 strip = va_arg(ap, char *);
00dc2f4f 207 }
e5a95ffb
GS
208 if (!ptr) {
209 ptr = mod_name;
210 *ptr++ = '.';
00dc2f4f
GS
211 *ptr = '\\';
212 }
e5a95ffb
GS
213 va_end(ap);
214 strcpy(++ptr, trailing_path);
215
216 newsize = strlen(mod_name) + 1;
217 if (prev_path) {
218 oldsize = strlen(prev_path) + 1;
219 newsize += oldsize; /* includes plus 1 for ';' */
220 Renew(prev_path, newsize, char);
221 prev_path[oldsize] = ';';
222 strcpy(&prev_path[oldsize], mod_name);
00dc2f4f 223 }
e5a95ffb
GS
224 else {
225 New(1311, prev_path, newsize, char);
226 strcpy(prev_path, mod_name);
00dc2f4f 227 }
00dc2f4f 228
e5a95ffb 229 return prev_path;
00dc2f4f
GS
230}
231
232char *
e5a95ffb 233win32_get_privlib(char *pl)
00dc2f4f 234{
e5a95ffb
GS
235 char *stdlib = "lib";
236 char buffer[MAX_PATH+1];
237 char *path = Nullch;
238 DWORD datalen;
00dc2f4f 239
e5a95ffb
GS
240 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
241 sprintf(buffer, "%s-%s", stdlib, pl);
242 path = GetRegStr(buffer, &path, &datalen);
243 if (path == NULL)
244 path = GetRegStr(stdlib, &path, &datalen);
00dc2f4f 245
e5a95ffb
GS
246 /* $stdlib .= ";$EMD/../../lib" */
247 return get_emd_part(path, stdlib, ARCHNAME, "bin", Nullch);
00dc2f4f
GS
248}
249
68dc0745 250char *
00dc2f4f
GS
251win32_get_sitelib(char *pl)
252{
e5a95ffb
GS
253 char *sitelib = "sitelib";
254 char regstr[40];
e24c7c18 255 char pathstr[MAX_PATH+1];
e5a95ffb
GS
256 DWORD datalen;
257 char *path1 = Nullch;
258 char *path2 = Nullch;
259 int len, newsize;
00dc2f4f
GS
260
261 /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
e5a95ffb
GS
262 sprintf(regstr, "%s-%s", sitelib, pl);
263 path1 = GetRegStr(regstr, &path1, &datalen);
264
265 /* $sitelib .=
266 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
267 sprintf(pathstr, "site\\%s\\lib", pl);
268 path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
00dc2f4f
GS
269
270 /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
e5a95ffb 271 path2 = GetRegStr(sitelib, &path2, &datalen);
00dc2f4f 272
e5a95ffb
GS
273 /* $sitelib .=
274 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */
275 path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
00dc2f4f 276
e5a95ffb
GS
277 if (!path1)
278 return path2;
00dc2f4f 279
e5a95ffb
GS
280 if (!path2)
281 return path1;
282
283 len = strlen(path1);
284 newsize = len + strlen(path2) + 2; /* plus one for ';' */
285
286 Renew(path1, newsize, char);
287 path1[len++] = ';';
288 strcpy(&path1[len], path2);
289
290 Safefree(path2);
291 return path1;
68dc0745 292}
0a753a76 293
b4793f7f 294
2d7a9237
GS
295static BOOL
296has_redirection(char *ptr)
68dc0745
PP
297{
298 int inquote = 0;
299 char quote = '\0';
300
301 /*
302 * Scan string looking for redirection (< or >) or pipe
303 * characters (|) that are not in a quoted string
304 */
9404a519 305 while (*ptr) {
68dc0745
PP
306 switch(*ptr) {
307 case '\'':
308 case '\"':
9404a519
GS
309 if (inquote) {
310 if (quote == *ptr) {
68dc0745
PP
311 inquote = 0;
312 quote = '\0';
0a753a76 313 }
68dc0745
PP
314 }
315 else {
316 quote = *ptr;
317 inquote++;
318 }
319 break;
320 case '>':
321 case '<':
322 case '|':
9404a519 323 if (!inquote)
68dc0745
PP
324 return TRUE;
325 default:
326 break;
0a753a76 327 }
68dc0745
PP
328 ++ptr;
329 }
330 return FALSE;
0a753a76
PP
331}
332
c69f6586 333#if !defined(PERL_OBJECT)
68dc0745
PP
334/* since the current process environment is being updated in util.c
335 * the library functions will get the correct environment
336 */
337PerlIO *
338my_popen(char *cmd, char *mode)
0a753a76
PP
339{
340#ifdef FIXCMD
68dc0745
PP
341#define fixcmd(x) { \
342 char *pspace = strchr((x),' '); \
343 if (pspace) { \
344 char *p = (x); \
345 while (p < pspace) { \
346 if (*p == '/') \
347 *p = '\\'; \
348 p++; \
349 } \
350 } \
351 }
0a753a76
PP
352#else
353#define fixcmd(x)
354#endif
68dc0745 355 fixcmd(cmd);
3e3baf6d
TB
356 win32_fflush(stdout);
357 win32_fflush(stderr);
0a753a76 358 return win32_popen(cmd, mode);
0a753a76
PP
359}
360
68dc0745
PP
361long
362my_pclose(PerlIO *fp)
0a753a76
PP
363{
364 return win32_pclose(fp);
365}
c69f6586 366#endif
0a753a76 367
8b10511d 368static DWORD
2d7a9237 369os_id(void)
0a753a76 370{
8b10511d 371 static OSVERSIONINFO osver;
0a753a76 372
2d7a9237 373 if (osver.dwPlatformId != w32_platform) {
8b10511d
GS
374 memset(&osver, 0, sizeof(OSVERSIONINFO));
375 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
376 GetVersionEx(&osver);
2d7a9237 377 w32_platform = osver.dwPlatformId;
8b10511d 378 }
2d7a9237 379 return (w32_platform);
0a753a76
PP
380}
381
ce1da67e
GS
382/* Tokenize a string. Words are null-separated, and the list
383 * ends with a doubled null. Any character (except null and
384 * including backslash) may be escaped by preceding it with a
385 * backslash (the backslash will be stripped).
386 * Returns number of words in result buffer.
387 */
388static long
389tokenize(char *str, char **dest, char ***destv)
390{
391 char *retstart = Nullch;
392 char **retvstart = 0;
393 int items = -1;
394 if (str) {
395 int slen = strlen(str);
396 register char *ret;
397 register char **retv;
398 New(1307, ret, slen+2, char);
399 New(1308, retv, (slen+3)/2, char*);
400
401 retstart = ret;
402 retvstart = retv;
403 *retv = ret;
404 items = 0;
405 while (*str) {
406 *ret = *str++;
407 if (*ret == '\\' && *str)
408 *ret = *str++;
409 else if (*ret == ' ') {
410 while (*str == ' ')
411 str++;
412 if (ret == retstart)
413 ret--;
414 else {
415 *ret = '\0';
416 ++items;
417 if (*str)
418 *++retv = ret+1;
419 }
420 }
421 else if (!*str)
422 ++items;
423 ret++;
424 }
425 retvstart[items] = Nullch;
426 *ret++ = '\0';
427 *ret = '\0';
428 }
429 *dest = retstart;
430 *destv = retvstart;
431 return items;
432}
433
434static void
2d7a9237 435get_shell(void)
0a753a76 436{
ce1da67e 437 if (!w32_perlshell_tokens) {
174c211a
GS
438 /* we don't use COMSPEC here for two reasons:
439 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and
440 * uncontrolled unportability of the ensuing scripts.
441 * 2. PERL5SHELL could be set to a shell that may not be fit for
442 * interactive use (which is what most programs look in COMSPEC
443 * for).
444 */
ce1da67e
GS
445 char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
446 char *usershell = getenv("PERL5SHELL");
447 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
448 &w32_perlshell_tokens,
449 &w32_perlshell_vec);
68dc0745 450 }
0a753a76
PP
451}
452
68dc0745 453int
2d7a9237 454do_aspawn(void *vreally, void **vmark, void **vsp)
0a753a76 455{
2d7a9237
GS
456 SV *really = (SV*)vreally;
457 SV **mark = (SV**)vmark;
458 SV **sp = (SV**)vsp;
68dc0745 459 char **argv;
2d7a9237 460 char *str;
68dc0745 461 int status;
2d7a9237 462 int flag = P_WAIT;
68dc0745 463 int index = 0;
68dc0745 464
2d7a9237
GS
465 if (sp <= mark)
466 return -1;
68dc0745 467
ce1da67e
GS
468 get_shell();
469 New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
2d7a9237
GS
470
471 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
472 ++mark;
473 flag = SvIVx(*mark);
68dc0745
PP
474 }
475
9404a519 476 while (++mark <= sp) {
2d7a9237
GS
477 if (*mark && (str = SvPV(*mark, na)))
478 argv[index++] = str;
479 else
480 argv[index++] = "";
68dc0745
PP
481 }
482 argv[index++] = 0;
483
2d7a9237 484 status = win32_spawnvp(flag,
c69f6586 485 (const char*)(really ? SvPV(really,na) : argv[0]),
2d7a9237
GS
486 (const char* const*)argv);
487
488 if (status < 0 && errno == ENOEXEC) {
489 /* possible shell-builtin, invoke with shell */
ce1da67e
GS
490 int sh_items;
491 sh_items = w32_perlshell_items;
2d7a9237
GS
492 while (--index >= 0)
493 argv[index+sh_items] = argv[index];
ce1da67e
GS
494 while (--sh_items >= 0)
495 argv[sh_items] = w32_perlshell_vec[sh_items];
2d7a9237
GS
496
497 status = win32_spawnvp(flag,
c69f6586 498 (const char*)(really ? SvPV(really,na) : argv[0]),
2d7a9237
GS
499 (const char* const*)argv);
500 }
68dc0745 501
50892819
GS
502 if (flag != P_NOWAIT) {
503 if (status < 0) {
504 if (dowarn)
505 warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
506 status = 255 * 256;
507 }
508 else
509 status *= 256;
510 statusvalue = status;
5aabfad6 511 }
ce1da67e 512 Safefree(argv);
50892819 513 return (status);
68dc0745
PP
514}
515
c69f6586 516int
6890e559 517do_spawn2(char *cmd, int exectype)
68dc0745
PP
518{
519 char **a;
520 char *s;
521 char **argv;
522 int status = -1;
523 BOOL needToTry = TRUE;
2d7a9237 524 char *cmd2;
68dc0745 525
2d7a9237
GS
526 /* Save an extra exec if possible. See if there are shell
527 * metacharacters in it */
9404a519 528 if (!has_redirection(cmd)) {
fc36a67e
PP
529 New(1301,argv, strlen(cmd) / 2 + 2, char*);
530 New(1302,cmd2, strlen(cmd) + 1, char);
68dc0745
PP
531 strcpy(cmd2, cmd);
532 a = argv;
533 for (s = cmd2; *s;) {
534 while (*s && isspace(*s))
535 s++;
536 if (*s)
537 *(a++) = s;
9404a519 538 while (*s && !isspace(*s))
68dc0745 539 s++;
9404a519 540 if (*s)
68dc0745 541 *s++ = '\0';
0a753a76 542 }
68dc0745 543 *a = Nullch;
ce1da67e 544 if (argv[0]) {
6890e559
GS
545 switch (exectype) {
546 case EXECF_SPAWN:
547 status = win32_spawnvp(P_WAIT, argv[0],
548 (const char* const*)argv);
549 break;
550 case EXECF_SPAWN_NOWAIT:
551 status = win32_spawnvp(P_NOWAIT, argv[0],
552 (const char* const*)argv);
553 break;
554 case EXECF_EXEC:
555 status = win32_execvp(argv[0], (const char* const*)argv);
556 break;
557 }
2d7a9237 558 if (status != -1 || errno == 0)
68dc0745 559 needToTry = FALSE;
0a753a76 560 }
0a753a76 561 Safefree(argv);
68dc0745
PP
562 Safefree(cmd2);
563 }
2d7a9237 564 if (needToTry) {
ce1da67e
GS
565 char **argv;
566 int i = -1;
567 get_shell();
568 New(1306, argv, w32_perlshell_items + 2, char*);
569 while (++i < w32_perlshell_items)
570 argv[i] = w32_perlshell_vec[i];
2d7a9237
GS
571 argv[i++] = cmd;
572 argv[i] = Nullch;
6890e559
GS
573 switch (exectype) {
574 case EXECF_SPAWN:
575 status = win32_spawnvp(P_WAIT, argv[0],
576 (const char* const*)argv);
577 break;
578 case EXECF_SPAWN_NOWAIT:
579 status = win32_spawnvp(P_NOWAIT, argv[0],
580 (const char* const*)argv);
581 break;
582 case EXECF_EXEC:
583 status = win32_execvp(argv[0], (const char* const*)argv);
584 break;
585 }
ce1da67e
GS
586 cmd = argv[0];
587 Safefree(argv);
68dc0745 588 }
50892819
GS
589 if (exectype != EXECF_SPAWN_NOWAIT) {
590 if (status < 0) {
591 if (dowarn)
592 warn("Can't %s \"%s\": %s",
593 (exectype == EXECF_EXEC ? "exec" : "spawn"),
594 cmd, strerror(errno));
595 status = 255 * 256;
596 }
597 else
598 status *= 256;
599 statusvalue = status;
5aabfad6 600 }
50892819 601 return (status);
0a753a76
PP
602}
603
6890e559
GS
604int
605do_spawn(char *cmd)
606{
607 return do_spawn2(cmd, EXECF_SPAWN);
608}
609
2d7a9237
GS
610int
611do_spawn_nowait(char *cmd)
612{
613 return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
614}
615
6890e559
GS
616bool
617do_exec(char *cmd)
618{
619 do_spawn2(cmd, EXECF_EXEC);
620 return FALSE;
621}
622
68dc0745
PP
623/* The idea here is to read all the directory names into a string table
624 * (separated by nulls) and when one of the other dir functions is called
625 * return the pointer to the current file name.
626 */
627DIR *
ce2e26e5 628win32_opendir(char *filename)
0a753a76 629{
9404a519
GS
630 DIR *p;
631 long len;
632 long idx;
633 char scanname[MAX_PATH+3];
634 struct stat sbuf;
635 WIN32_FIND_DATA FindData;
636 HANDLE fh;
637
638 len = strlen(filename);
639 if (len > MAX_PATH)
640 return NULL;
68dc0745
PP
641
642 /* check to see if filename is a directory */
d55594ae 643 if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
c6c1a8fd
GS
644 /* CRT is buggy on sharenames, so make sure it really isn't */
645 DWORD r = GetFileAttributes(filename);
646 if (r == 0xffffffff || !(r & FILE_ATTRIBUTE_DIRECTORY))
647 return NULL;
68dc0745
PP
648 }
649
68dc0745 650 /* Get us a DIR structure */
fc36a67e 651 Newz(1303, p, 1, DIR);
9404a519 652 if (p == NULL)
68dc0745
PP
653 return NULL;
654
655 /* Create the search pattern */
656 strcpy(scanname, filename);
9404a519
GS
657 if (scanname[len-1] != '/' && scanname[len-1] != '\\')
658 scanname[len++] = '/';
659 scanname[len++] = '*';
660 scanname[len] = '\0';
68dc0745
PP
661
662 /* do the FindFirstFile call */
663 fh = FindFirstFile(scanname, &FindData);
9404a519 664 if (fh == INVALID_HANDLE_VALUE) {
68dc0745
PP
665 return NULL;
666 }
667
668 /* now allocate the first part of the string table for
669 * the filenames that we find.
670 */
671 idx = strlen(FindData.cFileName)+1;
fc36a67e 672 New(1304, p->start, idx, char);
9404a519 673 if (p->start == NULL)
65e48ea9 674 croak("opendir: malloc failed!\n");
68dc0745 675 strcpy(p->start, FindData.cFileName);
68dc0745
PP
676 p->nfiles++;
677
678 /* loop finding all the files that match the wildcard
679 * (which should be all of them in this directory!).
680 * the variable idx should point one past the null terminator
681 * of the previous string found.
682 */
683 while (FindNextFile(fh, &FindData)) {
684 len = strlen(FindData.cFileName);
685 /* bump the string table size by enough for the
686 * new name and it's null terminator
687 */
688 Renew(p->start, idx+len+1, char);
9404a519 689 if (p->start == NULL)
65e48ea9 690 croak("opendir: malloc failed!\n");
68dc0745 691 strcpy(&p->start[idx], FindData.cFileName);
9404a519
GS
692 p->nfiles++;
693 idx += len+1;
694 }
695 FindClose(fh);
696 p->size = idx;
697 p->curr = p->start;
698 return p;
0a753a76
PP
699}
700
701
68dc0745
PP
702/* Readdir just returns the current string pointer and bumps the
703 * string pointer to the nDllExport entry.
704 */
705struct direct *
ce2e26e5 706win32_readdir(DIR *dirp)
0a753a76 707{
68dc0745
PP
708 int len;
709 static int dummy = 0;
0a753a76 710
68dc0745
PP
711 if (dirp->curr) {
712 /* first set up the structure to return */
713 len = strlen(dirp->curr);
714 strcpy(dirp->dirstr.d_name, dirp->curr);
715 dirp->dirstr.d_namlen = len;
0a753a76 716
68dc0745
PP
717 /* Fake an inode */
718 dirp->dirstr.d_ino = dummy++;
0a753a76 719
68dc0745
PP
720 /* Now set up for the nDllExport call to readdir */
721 dirp->curr += len + 1;
722 if (dirp->curr >= (dirp->start + dirp->size)) {
723 dirp->curr = NULL;
724 }
0a753a76 725
68dc0745
PP
726 return &(dirp->dirstr);
727 }
728 else
729 return NULL;
0a753a76
PP
730}
731
68dc0745
PP
732/* Telldir returns the current string pointer position */
733long
ce2e26e5 734win32_telldir(DIR *dirp)
0a753a76
PP
735{
736 return (long) dirp->curr;
737}
738
739
68dc0745
PP
740/* Seekdir moves the string pointer to a previously saved position
741 *(Saved by telldir).
742 */
743void
ce2e26e5 744win32_seekdir(DIR *dirp, long loc)
0a753a76
PP
745{
746 dirp->curr = (char *)loc;
747}
748
68dc0745
PP
749/* Rewinddir resets the string pointer to the start */
750void
ce2e26e5 751win32_rewinddir(DIR *dirp)
0a753a76
PP
752{
753 dirp->curr = dirp->start;
754}
755
68dc0745
PP
756/* free the memory allocated by opendir */
757int
ce2e26e5 758win32_closedir(DIR *dirp)
0a753a76
PP
759{
760 Safefree(dirp->start);
761 Safefree(dirp);
68dc0745 762 return 1;
0a753a76
PP
763}
764
765
68dc0745
PP
766/*
767 * various stubs
768 */
0a753a76
PP
769
770
68dc0745
PP
771/* Ownership
772 *
773 * Just pretend that everyone is a superuser. NT will let us know if
774 * we don\'t really have permission to do something.
775 */
0a753a76
PP
776
777#define ROOT_UID ((uid_t)0)
778#define ROOT_GID ((gid_t)0)
779
68dc0745
PP
780uid_t
781getuid(void)
0a753a76 782{
68dc0745 783 return ROOT_UID;
0a753a76
PP
784}
785
68dc0745
PP
786uid_t
787geteuid(void)
0a753a76 788{
68dc0745 789 return ROOT_UID;
0a753a76
PP
790}
791
68dc0745
PP
792gid_t
793getgid(void)
0a753a76 794{
68dc0745 795 return ROOT_GID;
0a753a76
PP
796}
797
68dc0745
PP
798gid_t
799getegid(void)
0a753a76 800{
68dc0745 801 return ROOT_GID;
0a753a76
PP
802}
803
68dc0745 804int
22239a37 805setuid(uid_t auid)
0a753a76 806{
22239a37 807 return (auid == ROOT_UID ? 0 : -1);
0a753a76
PP
808}
809
68dc0745 810int
22239a37 811setgid(gid_t agid)
0a753a76 812{
22239a37 813 return (agid == ROOT_GID ? 0 : -1);
0a753a76
PP
814}
815
e34ffe5a
GS
816char *
817getlogin(void)
818{
819 dTHR;
820 char *buf = getlogin_buffer;
821 DWORD size = sizeof(getlogin_buffer);
822 if (GetUserName(buf,&size))
823 return buf;
824 return (char*)NULL;
825}
826
b990f8c8
GS
827int
828chown(const char *path, uid_t owner, gid_t group)
829{
830 /* XXX noop */
1c1c7f20 831 return 0;
b990f8c8
GS
832}
833
f55ee38a
GS
834static void
835remove_dead_process(HANDLE deceased)
0a753a76 836{
f55ee38a
GS
837#ifndef USE_RTL_WAIT
838 int child;
839 for (child = 0 ; child < w32_num_children ; ++child) {
840 if (w32_child_pids[child] == deceased) {
841 Copy(&w32_child_pids[child+1], &w32_child_pids[child],
842 (w32_num_children-child-1), HANDLE);
843 w32_num_children--;
844 break;
845 }
846 }
847#endif
848}
849
850DllExport int
851win32_kill(int pid, int sig)
852{
853#ifdef USE_RTL_WAIT
68dc0745 854 HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
f55ee38a
GS
855#else
856 HANDLE hProcess = (HANDLE) pid;
857#endif
0a753a76
PP
858
859 if (hProcess == NULL) {
65e48ea9 860 croak("kill process failed!\n");
68dc0745
PP
861 }
862 else {
863 if (!TerminateProcess(hProcess, sig))
65e48ea9 864 croak("kill process failed!\n");
68dc0745 865 CloseHandle(hProcess);
f55ee38a
GS
866
867 /* WaitForMultipleObjects() on a pid that was killed returns error
868 * so if we know the pid is gone we remove it from process list */
869 remove_dead_process(hProcess);
68dc0745
PP
870 }
871 return 0;
0a753a76 872}
fbbbcc48 873
68dc0745
PP
874/*
875 * File system stuff
876 */
0a753a76 877
f3986ebb
GS
878DllExport unsigned int
879win32_sleep(unsigned int t)
0a753a76 880{
68dc0745
PP
881 Sleep(t*1000);
882 return 0;
0a753a76
PP
883}
884
68dc0745
PP
885DllExport int
886win32_stat(const char *path, struct stat *buffer)
0a753a76 887{
e24c7c18 888 char t[MAX_PATH+1];
68dc0745
PP
889 const char *p = path;
890 int l = strlen(path);
67fbe06e 891 int res;
0a753a76 892
68dc0745
PP
893 if (l > 1) {
894 switch(path[l - 1]) {
895 case '\\':
896 case '/':
897 if (path[l - 2] != ':') {
898 strncpy(t, path, l - 1);
899 t[l - 1] = 0;
900 p = t;
901 };
902 }
903 }
390b85e7 904 res = stat(p,buffer);
67fbe06e
GS
905#ifdef __BORLANDC__
906 if (res == 0) {
907 if (S_ISDIR(buffer->st_mode))
908 buffer->st_mode |= S_IWRITE | S_IEXEC;
909 else if (S_ISREG(buffer->st_mode)) {
910 if (l >= 4 && path[l-4] == '.') {
911 const char *e = path + l - 3;
912 if (strnicmp(e,"exe",3)
913 && strnicmp(e,"bat",3)
914 && strnicmp(e,"com",3)
915 && (IsWin95() || strnicmp(e,"cmd",3)))
916 buffer->st_mode &= ~S_IEXEC;
917 else
918 buffer->st_mode |= S_IEXEC;
919 }
920 else
921 buffer->st_mode &= ~S_IEXEC;
922 }
923 }
924#endif
925 return res;
0a753a76
PP
926}
927
0551aaa8
GS
928#ifndef USE_WIN32_RTL_ENV
929
930DllExport char *
931win32_getenv(const char *name)
932{
933 static char *curitem = Nullch;
934 static DWORD curlen = 512;
935 DWORD needlen;
936 if (!curitem)
937 New(1305,curitem,curlen,char);
58a50f62
GS
938
939 needlen = GetEnvironmentVariable(name,curitem,curlen);
940 if (needlen != 0) {
941 while (needlen > curlen) {
942 Renew(curitem,needlen,char);
943 curlen = needlen;
944 needlen = GetEnvironmentVariable(name,curitem,curlen);
945 }
0551aaa8 946 }
58a50f62 947 else
c69f6586 948 {
58a50f62
GS
949 /* allow any environment variables that begin with 'PERL5'
950 to be stored in the registry
951 */
952 if(curitem != NULL)
953 *curitem = '\0';
954
955 if (strncmp(name, "PERL5", 5) == 0) {
956 if (curitem != NULL) {
957 Safefree(curitem);
958 curitem = NULL;
959 }
00dc2f4f 960 curitem = GetRegStr(name, &curitem, &curlen);
58a50f62 961 }
c69f6586 962 }
58a50f62
GS
963 if(curitem != NULL && *curitem == '\0')
964 return Nullch;
965
0551aaa8
GS
966 return curitem;
967}
968
969#endif
970
d55594ae 971static long
2d7a9237 972filetime_to_clock(PFILETIME ft)
d55594ae
GS
973{
974 __int64 qw = ft->dwHighDateTime;
975 qw <<= 32;
976 qw |= ft->dwLowDateTime;
977 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
978 return (long) qw;
979}
980
f3986ebb
GS
981DllExport int
982win32_times(struct tms *timebuf)
0a753a76 983{
d55594ae
GS
984 FILETIME user;
985 FILETIME kernel;
986 FILETIME dummy;
987 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
988 &kernel,&user)) {
2d7a9237
GS
989 timebuf->tms_utime = filetime_to_clock(&user);
990 timebuf->tms_stime = filetime_to_clock(&kernel);
d55594ae
GS
991 timebuf->tms_cutime = 0;
992 timebuf->tms_cstime = 0;
993
994 } else {
995 /* That failed - e.g. Win95 fallback to clock() */
996 clock_t t = clock();
997 timebuf->tms_utime = t;
998 timebuf->tms_stime = 0;
999 timebuf->tms_cutime = 0;
1000 timebuf->tms_cstime = 0;
1001 }
68dc0745 1002 return 0;
0a753a76
PP
1003}
1004
ad0751ec
GS
1005/* fix utime() so it works on directories in NT
1006 * thanks to Jan Dubois <jan.dubois@ibm.net>
1007 */
1008static BOOL
1009filetime_from_time(PFILETIME pFileTime, time_t Time)
1010{
1011 struct tm *pTM = gmtime(&Time);
1012 SYSTEMTIME SystemTime;
1013
1014 if (pTM == NULL)
1015 return FALSE;
1016
1017 SystemTime.wYear = pTM->tm_year + 1900;
1018 SystemTime.wMonth = pTM->tm_mon + 1;
1019 SystemTime.wDay = pTM->tm_mday;
1020 SystemTime.wHour = pTM->tm_hour;
1021 SystemTime.wMinute = pTM->tm_min;
1022 SystemTime.wSecond = pTM->tm_sec;
1023 SystemTime.wMilliseconds = 0;
1024
1025 return SystemTimeToFileTime(&SystemTime, pFileTime);
1026}
1027
1028DllExport int
3b405fc5 1029win32_utime(const char *filename, struct utimbuf *times)
ad0751ec
GS
1030{
1031 HANDLE handle;
1032 FILETIME ftCreate;
1033 FILETIME ftAccess;
1034 FILETIME ftWrite;
1035 struct utimbuf TimeBuffer;
1036
1037 int rc = utime(filename,times);
1038 /* EACCES: path specifies directory or readonly file */
1039 if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
1040 return rc;
1041
1042 if (times == NULL) {
1043 times = &TimeBuffer;
1044 time(&times->actime);
1045 times->modtime = times->actime;
1046 }
1047
1048 /* This will (and should) still fail on readonly files */
1049 handle = CreateFile(filename, GENERIC_READ | GENERIC_WRITE,
1050 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1051 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
1052 if (handle == INVALID_HANDLE_VALUE)
1053 return rc;
1054
1055 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
1056 filetime_from_time(&ftAccess, times->actime) &&
1057 filetime_from_time(&ftWrite, times->modtime) &&
1058 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
1059 {
1060 rc = 0;
1061 }
1062
1063 CloseHandle(handle);
1064 return rc;
1065}
1066
2d7a9237 1067DllExport int
f55ee38a
GS
1068win32_waitpid(int pid, int *status, int flags)
1069{
1070 int rc;
1071 if (pid == -1)
1072 return win32_wait(status);
1073 else {
1074 rc = cwait(status, pid, WAIT_CHILD);
1075 /* cwait() returns differently on Borland */
1076#ifdef __BORLANDC__
1077 if (status)
1078 *status = (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
1079#endif
1080 remove_dead_process((HANDLE)pid);
1081 }
1082 return rc >= 0 ? pid : rc;
1083}
1084
1085DllExport int
2d7a9237
GS
1086win32_wait(int *status)
1087{
4b556e6c 1088#ifdef USE_RTL_WAIT
2d7a9237
GS
1089 return wait(status);
1090#else
1091 /* XXX this wait emulation only knows about processes
1092 * spawned via win32_spawnvp(P_NOWAIT, ...).
1093 */
1094 int i, retval;
1095 DWORD exitcode, waitcode;
1096
1097 if (!w32_num_children) {
1098 errno = ECHILD;
1099 return -1;
1100 }
1101
1102 /* if a child exists, wait for it to die */
1103 waitcode = WaitForMultipleObjects(w32_num_children,
1104 w32_child_pids,
1105 FALSE,
1106 INFINITE);
1107 if (waitcode != WAIT_FAILED) {
1108 if (waitcode >= WAIT_ABANDONED_0
1109 && waitcode < WAIT_ABANDONED_0 + w32_num_children)
1110 i = waitcode - WAIT_ABANDONED_0;
1111 else
1112 i = waitcode - WAIT_OBJECT_0;
1113 if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) {
1114 CloseHandle(w32_child_pids[i]);
1115 *status = (int)((exitcode & 0xff) << 8);
1116 retval = (int)w32_child_pids[i];
1117 Copy(&w32_child_pids[i+1], &w32_child_pids[i],
1118 (w32_num_children-i-1), HANDLE);
1119 w32_num_children--;
1120 return retval;
1121 }
1122 }
1123
1124FAILED:
1125 errno = GetLastError();
1126 return -1;
1127
1128#endif
1129}
d55594ae 1130
2d7a9237 1131static UINT timerid = 0;
d55594ae
GS
1132
1133static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
1134{
1135 KillTimer(NULL,timerid);
1136 timerid=0;
1137 sighandler(14);
1138}
1139
f3986ebb
GS
1140DllExport unsigned int
1141win32_alarm(unsigned int sec)
0a753a76 1142{
d55594ae
GS
1143 /*
1144 * the 'obvious' implentation is SetTimer() with a callback
1145 * which does whatever receiving SIGALRM would do
1146 * we cannot use SIGALRM even via raise() as it is not
1147 * one of the supported codes in <signal.h>
1148 *
1149 * Snag is unless something is looking at the message queue
1150 * nothing happens :-(
1151 */
1152 if (sec)
1153 {
1154 timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
1155 if (!timerid)
1156 croak("Cannot set timer");
1157 }
1158 else
1159 {
1160 if (timerid)
1161 {
1162 KillTimer(NULL,timerid);
1163 timerid=0;
1164 }
1165 }
68dc0745 1166 return 0;
0a753a76
PP
1167}
1168
26618a56
GS
1169#ifdef HAVE_DES_FCRYPT
1170extern char * des_fcrypt(char *cbuf, const char *txt, const char *salt);
1171
1172DllExport char *
1173win32_crypt(const char *txt, const char *salt)
1174{
1175 dTHR;
1176 return des_fcrypt(crypt_buffer, txt, salt);
1177}
1178#endif
1179
f3986ebb 1180#ifdef USE_FIXED_OSFHANDLE
390b85e7
GS
1181
1182EXTERN_C int __cdecl _alloc_osfhnd(void);
1183EXTERN_C int __cdecl _set_osfhnd(int fh, long value);
1184EXTERN_C void __cdecl _lock_fhandle(int);
1185EXTERN_C void __cdecl _unlock_fhandle(int);
1186EXTERN_C void __cdecl _unlock(int);
1187
1188#if (_MSC_VER >= 1000)
1189typedef struct {
1190 long osfhnd; /* underlying OS file HANDLE */
1191 char osfile; /* attributes of file (e.g., open in text mode?) */
1192 char pipech; /* one char buffer for handles opened on pipes */
1193#if defined (_MT) && !defined (DLL_FOR_WIN32S)
1194 int lockinitflag;
1195 CRITICAL_SECTION lock;
1196#endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */
1197} ioinfo;
1198
1199EXTERN_C ioinfo * __pioinfo[];
1200
1201#define IOINFO_L2E 5
1202#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
1203#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
1204#define _osfile(i) (_pioinfo(i)->osfile)
1205
1206#else /* (_MSC_VER >= 1000) */
1207extern char _osfile[];
1208#endif /* (_MSC_VER >= 1000) */
1209
1210#define FOPEN 0x01 /* file handle open */
1211#define FAPPEND 0x20 /* file handle opened O_APPEND */
1212#define FDEV 0x40 /* file handle refers to device */
1213#define FTEXT 0x80 /* file handle is in text mode */
1214
1215#define _STREAM_LOCKS 26 /* Table of stream locks */
1216#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */
1217#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */
1218
1219/***
1220*int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle
1221*
1222*Purpose:
1223* This function allocates a free C Runtime file handle and associates
1224* it with the Win32 HANDLE specified by the first parameter. This is a
1225* temperary fix for WIN95's brain damage GetFileType() error on socket
1226* we just bypass that call for socket
1227*
1228*Entry:
1229* long osfhandle - Win32 HANDLE to associate with C Runtime file handle.
1230* int flags - flags to associate with C Runtime file handle.
1231*
1232*Exit:
1233* returns index of entry in fh, if successful
1234* return -1, if no free entry is found
1235*
1236*Exceptions:
1237*
1238*******************************************************************************/
1239
1240static int
1241my_open_osfhandle(long osfhandle, int flags)
1242{
1243 int fh;
1244 char fileflags; /* _osfile flags */
1245
1246 /* copy relevant flags from second parameter */
1247 fileflags = FDEV;
1248
9404a519 1249 if (flags & O_APPEND)
390b85e7
GS
1250 fileflags |= FAPPEND;
1251
9404a519 1252 if (flags & O_TEXT)
390b85e7
GS
1253 fileflags |= FTEXT;
1254
1255 /* attempt to allocate a C Runtime file handle */
9404a519 1256 if ((fh = _alloc_osfhnd()) == -1) {
390b85e7
GS
1257 errno = EMFILE; /* too many open files */
1258 _doserrno = 0L; /* not an OS error */
1259 return -1; /* return error to caller */
1260 }
1261
1262 /* the file is open. now, set the info in _osfhnd array */
1263 _set_osfhnd(fh, osfhandle);
1264
1265 fileflags |= FOPEN; /* mark as open */
1266
1267#if (_MSC_VER >= 1000)
1268 _osfile(fh) = fileflags; /* set osfile entry */
1269 _unlock_fhandle(fh);
1270#else
1271 _osfile[fh] = fileflags; /* set osfile entry */
1272 _unlock(fh+_FH_LOCKS); /* unlock handle */
1273#endif
1274
1275 return fh; /* return handle */
1276}
1277
1278#define _open_osfhandle my_open_osfhandle
f3986ebb 1279#endif /* USE_FIXED_OSFHANDLE */
390b85e7
GS
1280
1281/* simulate flock by locking a range on the file */
1282
1283#define LK_ERR(f,i) ((f) ? (i = 0) : (errno = GetLastError()))
1284#define LK_LEN 0xffff0000
1285
f3986ebb
GS
1286DllExport int
1287win32_flock(int fd, int oper)
390b85e7
GS
1288{
1289 OVERLAPPED o;
1290 int i = -1;
1291 HANDLE fh;
1292
f3986ebb
GS
1293 if (!IsWinNT()) {
1294 croak("flock() unimplemented on this platform");
1295 return -1;
1296 }
390b85e7
GS
1297 fh = (HANDLE)_get_osfhandle(fd);
1298 memset(&o, 0, sizeof(o));
1299
1300 switch(oper) {
1301 case LOCK_SH: /* shared lock */
1302 LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
1303 break;
1304 case LOCK_EX: /* exclusive lock */
1305 LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
1306 break;
1307 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */
1308 LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
1309 break;
1310 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */
1311 LK_ERR(LockFileEx(fh,
1312 LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
1313 0, LK_LEN, 0, &o),i);
1314 break;
1315 case LOCK_UN: /* unlock lock */
1316 LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
1317 break;
1318 default: /* unknown */
1319 errno = EINVAL;
1320 break;
1321 }
1322 return i;
1323}
1324
1325#undef LK_ERR
1326#undef LK_LEN
1327
68dc0745
PP
1328/*
1329 * redirected io subsystem for all XS modules
1330 *
1331 */
0a753a76 1332
68dc0745
PP
1333DllExport int *
1334win32_errno(void)
0a753a76 1335{
390b85e7 1336 return (&errno);
0a753a76
PP
1337}
1338
dcb2879a
GS
1339DllExport char ***
1340win32_environ(void)
1341{
390b85e7 1342 return (&(_environ));
dcb2879a
GS
1343}
1344
68dc0745
PP
1345/* the rest are the remapped stdio routines */
1346DllExport FILE *
1347win32_stderr(void)
0a753a76 1348{
390b85e7 1349 return (stderr);
0a753a76
PP
1350}
1351
68dc0745
PP
1352DllExport FILE *
1353win32_stdin(void)
0a753a76 1354{
390b85e7 1355 return (stdin);
0a753a76
PP
1356}
1357
68dc0745
PP
1358DllExport FILE *
1359win32_stdout()
0a753a76 1360{
390b85e7 1361 return (stdout);
0a753a76
PP
1362}
1363
68dc0745
PP
1364DllExport int
1365win32_ferror(FILE *fp)
0a753a76 1366{
390b85e7 1367 return (ferror(fp));
0a753a76
PP
1368}
1369
1370
68dc0745
PP
1371DllExport int
1372win32_feof(FILE *fp)
0a753a76 1373{
390b85e7 1374 return (feof(fp));
0a753a76
PP
1375}
1376
68dc0745
PP
1377/*
1378 * Since the errors returned by the socket error function
1379 * WSAGetLastError() are not known by the library routine strerror
1380 * we have to roll our own.
1381 */
0a753a76 1382
68dc0745
PP
1383DllExport char *
1384win32_strerror(int e)
0a753a76 1385{
3e3baf6d 1386#ifndef __BORLANDC__ /* Borland intolerance */
68dc0745 1387 extern int sys_nerr;
3e3baf6d 1388#endif
68dc0745 1389 DWORD source = 0;
0a753a76 1390
9404a519 1391 if (e < 0 || e > sys_nerr) {
c53bd28a 1392 dTHR;
9404a519 1393 if (e < 0)
68dc0745 1394 e = GetLastError();
0a753a76 1395
9404a519 1396 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
68dc0745
PP
1397 strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
1398 strcpy(strerror_buffer, "Unknown Error");
0a753a76 1399
68dc0745
PP
1400 return strerror_buffer;
1401 }
390b85e7 1402 return strerror(e);
0a753a76
PP
1403}
1404
22fae026 1405DllExport void
3730b96e 1406win32_str_os_error(void *sv, DWORD dwErr)
22fae026
TM
1407{
1408 DWORD dwLen;
1409 char *sMsg;
1410 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
1411 |FORMAT_MESSAGE_IGNORE_INSERTS
1412 |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
1413 dwErr, 0, (char *)&sMsg, 1, NULL);
1414 if (0 < dwLen) {
1415 while (0 < dwLen && isspace(sMsg[--dwLen]))
1416 ;
1417 if ('.' != sMsg[dwLen])
1418 dwLen++;
1419 sMsg[dwLen]= '\0';
1420 }
1421 if (0 == dwLen) {
c69f6586 1422 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
22fae026
TM
1423 dwLen = sprintf(sMsg,
1424 "Unknown error #0x%lX (lookup 0x%lX)",
1425 dwErr, GetLastError());
1426 }
3730b96e 1427 sv_setpvn((SV*)sv, sMsg, dwLen);
22fae026
TM
1428 LocalFree(sMsg);
1429}
1430
1431
68dc0745
PP
1432DllExport int
1433win32_fprintf(FILE *fp, const char *format, ...)
0a753a76 1434{
68dc0745
PP
1435 va_list marker;
1436 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 1437
390b85e7 1438 return (vfprintf(fp, format, marker));
0a753a76
PP
1439}
1440
68dc0745
PP
1441DllExport int
1442win32_printf(const char *format, ...)
0a753a76 1443{
68dc0745
PP
1444 va_list marker;
1445 va_start(marker, format); /* Initialize variable arguments. */
0a753a76 1446
390b85e7 1447 return (vprintf(format, marker));
0a753a76
PP
1448}
1449
68dc0745
PP
1450DllExport int
1451win32_vfprintf(FILE *fp, const char *format, va_list args)
0a753a76 1452{
390b85e7 1453 return (vfprintf(fp, format, args));
0a753a76
PP
1454}
1455
96e4d5b1
PP
1456DllExport int
1457win32_vprintf(const char *format, va_list args)
1458{
390b85e7 1459 return (vprintf(format, args));
96e4d5b1
PP
1460}
1461
68dc0745
PP
1462DllExport size_t
1463win32_fread(void *buf, size_t size, size_t count, FILE *fp)
0a753a76 1464{
390b85e7 1465 return fread(buf, size, count, fp);
0a753a76
PP
1466}
1467
68dc0745
PP
1468DllExport size_t
1469win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
0a753a76 1470{
390b85e7 1471 return fwrite(buf, size, count, fp);
0a753a76
PP
1472}
1473
68dc0745
PP
1474DllExport FILE *
1475win32_fopen(const char *filename, const char *mode)
0a753a76 1476{
68dc0745 1477 if (stricmp(filename, "/dev/null")==0)
390b85e7
GS
1478 return fopen("NUL", mode);
1479 return fopen(filename, mode);
0a753a76
PP
1480}
1481
f3986ebb
GS
1482#ifndef USE_SOCKETS_AS_HANDLES
1483#undef fdopen
1484#define fdopen my_fdopen
1485#endif
1486
68dc0745
PP
1487DllExport FILE *
1488win32_fdopen( int handle, const char *mode)
0a753a76 1489{
390b85e7 1490 return fdopen(handle, (char *) mode);
0a753a76
PP
1491}
1492
68dc0745
PP
1493DllExport FILE *
1494win32_freopen( const char *path, const char *mode, FILE *stream)
0a753a76 1495{
68dc0745 1496 if (stricmp(path, "/dev/null")==0)
390b85e7
GS
1497 return freopen("NUL", mode, stream);
1498 return freopen(path, mode, stream);
0a753a76
PP
1499}
1500
68dc0745
PP
1501DllExport int
1502win32_fclose(FILE *pf)
0a753a76 1503{
f3986ebb 1504 return my_fclose(pf); /* defined in win32sck.c */
0a753a76
PP
1505}
1506
68dc0745
PP
1507DllExport int
1508win32_fputs(const char *s,FILE *pf)
0a753a76 1509{
390b85e7 1510 return fputs(s, pf);
0a753a76
PP
1511}
1512
68dc0745
PP
1513DllExport int
1514win32_fputc(int c,FILE *pf)
0a753a76 1515{
390b85e7 1516 return fputc(c,pf);
0a753a76
PP
1517}
1518
68dc0745
PP
1519DllExport int
1520win32_ungetc(int c,FILE *pf)
0a753a76 1521{
390b85e7 1522 return ungetc(c,pf);
0a753a76
PP
1523}
1524
68dc0745
PP
1525DllExport int
1526win32_getc(FILE *pf)
0a753a76 1527{
390b85e7 1528 return getc(pf);
0a753a76
PP
1529}
1530
68dc0745
PP
1531DllExport int
1532win32_fileno(FILE *pf)
0a753a76 1533{
390b85e7 1534 return fileno(pf);
0a753a76
PP
1535}
1536
68dc0745
PP
1537DllExport void
1538win32_clearerr(FILE *pf)
0a753a76 1539{
390b85e7 1540 clearerr(pf);
68dc0745 1541 return;
0a753a76
PP
1542}
1543
68dc0745
PP
1544DllExport int
1545win32_fflush(FILE *pf)
0a753a76 1546{
390b85e7 1547 return fflush(pf);
0a753a76
PP
1548}
1549
68dc0745
PP
1550DllExport long
1551win32_ftell(FILE *pf)
0a753a76 1552{
390b85e7 1553 return ftell(pf);
0a753a76
PP
1554}
1555
68dc0745
PP
1556DllExport int
1557win32_fseek(FILE *pf,long offset,int origin)
0a753a76 1558{
390b85e7 1559 return fseek(pf, offset, origin);
0a753a76
PP
1560}
1561
68dc0745
PP
1562DllExport int
1563win32_fgetpos(FILE *pf,fpos_t *p)
0a753a76 1564{
390b85e7 1565 return fgetpos(pf, p);
0a753a76
PP
1566}
1567
68dc0745
PP
1568DllExport int
1569win32_fsetpos(FILE *pf,const fpos_t *p)
0a753a76 1570{
390b85e7 1571 return fsetpos(pf, p);
0a753a76
PP
1572}
1573
68dc0745
PP
1574DllExport void
1575win32_rewind(FILE *pf)
0a753a76 1576{
390b85e7 1577 rewind(pf);
68dc0745 1578 return;
0a753a76
PP
1579}
1580
68dc0745
PP
1581DllExport FILE*
1582win32_tmpfile(void)
0a753a76 1583{
390b85e7 1584 return tmpfile();
0a753a76
PP
1585}
1586
68dc0745
PP
1587DllExport void
1588win32_abort(void)
0a753a76 1589{
390b85e7 1590 abort();
68dc0745 1591 return;
0a753a76
PP
1592}
1593
68dc0745 1594DllExport int
22239a37 1595win32_fstat(int fd,struct stat *sbufptr)
0a753a76 1596{
22239a37 1597 return fstat(fd,sbufptr);
0a753a76
PP
1598}
1599
68dc0745
PP
1600DllExport int
1601win32_pipe(int *pfd, unsigned int size, int mode)
0a753a76 1602{
390b85e7 1603 return _pipe(pfd, size, mode);
0a753a76
PP
1604}
1605
50892819
GS
1606/*
1607 * a popen() clone that respects PERL5SHELL
1608 */
1609
68dc0745
PP
1610DllExport FILE*
1611win32_popen(const char *command, const char *mode)
0a753a76 1612{
4b556e6c 1613#ifdef USE_RTL_POPEN
390b85e7 1614 return _popen(command, mode);
50892819
GS
1615#else
1616 int p[2];
1617 int parent, child;
1618 int stdfd, oldfd;
1619 int ourmode;
1620 int childpid;
1621
1622 /* establish which ends read and write */
1623 if (strchr(mode,'w')) {
1624 stdfd = 0; /* stdin */
1625 parent = 1;
1626 child = 0;
1627 }
1628 else if (strchr(mode,'r')) {
1629 stdfd = 1; /* stdout */
1630 parent = 0;
1631 child = 1;
1632 }
1633 else
1634 return NULL;
1635
1636 /* set the correct mode */
1637 if (strchr(mode,'b'))
1638 ourmode = O_BINARY;
1639 else if (strchr(mode,'t'))
1640 ourmode = O_TEXT;
1641 else
1642 ourmode = _fmode & (O_TEXT | O_BINARY);
1643
1644 /* the child doesn't inherit handles */
1645 ourmode |= O_NOINHERIT;
1646
1647 if (win32_pipe( p, 512, ourmode) == -1)
1648 return NULL;
1649
1650 /* save current stdfd */
1651 if ((oldfd = win32_dup(stdfd)) == -1)
1652 goto cleanup;
1653
1654 /* make stdfd go to child end of pipe (implicitly closes stdfd) */
1655 /* stdfd will be inherited by the child */
1656 if (win32_dup2(p[child], stdfd) == -1)
1657 goto cleanup;
1658
1659 /* close the child end in parent */
1660 win32_close(p[child]);
1661
1662 /* start the child */
1663 if ((childpid = do_spawn_nowait((char*)command)) == -1)
1664 goto cleanup;
1665
1666 /* revert stdfd to whatever it was before */
1667 if (win32_dup2(oldfd, stdfd) == -1)
1668 goto cleanup;
1669
1670 /* close saved handle */
1671 win32_close(oldfd);
1672
4b556e6c 1673 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
50892819
GS
1674
1675 /* we have an fd, return a file stream */
1676 return (win32_fdopen(p[parent], (char *)mode));
1677
1678cleanup:
1679 /* we don't need to check for errors here */
1680 win32_close(p[0]);
1681 win32_close(p[1]);
1682 if (oldfd != -1) {
1683 win32_dup2(oldfd, stdfd);
1684 win32_close(oldfd);
1685 }
1686 return (NULL);
1687
4b556e6c 1688#endif /* USE_RTL_POPEN */
0a753a76
PP
1689}
1690
50892819
GS
1691/*
1692 * pclose() clone
1693 */
1694
68dc0745
PP
1695DllExport int
1696win32_pclose(FILE *pf)
0a753a76 1697{
4b556e6c 1698#ifdef USE_RTL_POPEN
390b85e7 1699 return _pclose(pf);
50892819 1700#else
50892819 1701
e17cb2a9
JD
1702 int childpid, status;
1703 SV *sv;
1704
4b556e6c 1705 sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
e17cb2a9
JD
1706 if (SvIOK(sv))
1707 childpid = SvIVX(sv);
1708 else
1709 childpid = 0;
50892819
GS
1710
1711 if (!childpid) {
1712 errno = EBADF;
1713 return -1;
1714 }
1715
1716 win32_fclose(pf);
e17cb2a9
JD
1717 SvIVX(sv) = 0;
1718
f55ee38a 1719 remove_dead_process((HANDLE)childpid);
50892819
GS
1720
1721 /* wait for the child */
1722 if (cwait(&status, childpid, WAIT_CHILD) == -1)
1723 return (-1);
1724 /* cwait() returns differently on Borland */
1725#ifdef __BORLANDC__
1726 return (((status >> 8) & 0xff) | ((status << 8) & 0xff00));
1727#else
1728 return (status);
1729#endif
1730
4b556e6c 1731#endif /* USE_RTL_POPEN */
0a753a76
PP
1732}
1733
68dc0745 1734DllExport int
8d9b2e3c 1735win32_rename(const char *oname, const char *newname)
e24c7c18
GS
1736{
1737 char szNewWorkName[MAX_PATH+1];
1738 WIN32_FIND_DATA fdOldFile, fdNewFile;
1739 HANDLE handle;
1740 char *ptr;
1741
8d9b2e3c 1742 if ((strchr(oname, '\\') || strchr(oname, '/'))
e24c7c18
GS
1743 && strchr(newname, '\\') == NULL
1744 && strchr(newname, '/') == NULL)
1745 {
8d9b2e3c 1746 strcpy(szNewWorkName, oname);
e24c7c18
GS
1747 if ((ptr = strrchr(szNewWorkName, '\\')) == NULL)
1748 ptr = strrchr(szNewWorkName, '/');
1749 strcpy(++ptr, newname);
1750 }
1751 else
1752 strcpy(szNewWorkName, newname);
1753
8d9b2e3c 1754 if (stricmp(oname, szNewWorkName) != 0) {
e24c7c18
GS
1755 // check that we're not being fooled by relative paths
1756 // and only delete the new file
1757 // 1) if it exists
1758 // 2) it is not the same file as the old file
1759 // 3) old file exist
1760 // GetFullPathName does not return the long file name on some systems
8d9b2e3c 1761 handle = FindFirstFile(oname, &fdOldFile);
e24c7c18
GS
1762 if (handle != INVALID_HANDLE_VALUE) {
1763 FindClose(handle);
1764
1765 handle = FindFirstFile(szNewWorkName, &fdNewFile);
1766
1767 if (handle != INVALID_HANDLE_VALUE)
1768 FindClose(handle);
1769 else
1770 fdNewFile.cFileName[0] = '\0';
1771
1772 if (strcmp(fdOldFile.cAlternateFileName,
1773 fdNewFile.cAlternateFileName) != 0
1774 && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
1775 {
1776 // file exists and not same file
1777 DeleteFile(szNewWorkName);
1778 }
1779 }
1780 }
8d9b2e3c 1781 return rename(oname, newname);
e24c7c18
GS
1782}
1783
1784DllExport int
68dc0745 1785win32_setmode(int fd, int mode)
0a753a76 1786{
390b85e7 1787 return setmode(fd, mode);
0a753a76
PP
1788}
1789
96e4d5b1
PP
1790DllExport long
1791win32_lseek(int fd, long offset, int origin)
1792{
390b85e7 1793 return lseek(fd, offset, origin);
96e4d5b1
PP
1794}
1795
1796DllExport long
1797win32_tell(int fd)
1798{
390b85e7 1799 return tell(fd);
96e4d5b1
PP
1800}
1801
68dc0745
PP
1802DllExport int
1803win32_open(const char *path, int flag, ...)
0a753a76 1804{
68dc0745
PP
1805 va_list ap;
1806 int pmode;
0a753a76
PP
1807
1808 va_start(ap, flag);
1809 pmode = va_arg(ap, int);
1810 va_end(ap);
1811
68dc0745 1812 if (stricmp(path, "/dev/null")==0)
390b85e7
GS
1813 return open("NUL", flag, pmode);
1814 return open(path,flag,pmode);
0a753a76
PP
1815}
1816
68dc0745
PP
1817DllExport int
1818win32_close(int fd)
0a753a76 1819{
390b85e7 1820 return close(fd);
0a753a76
PP
1821}
1822
68dc0745 1823DllExport int
96e4d5b1
PP
1824win32_eof(int fd)
1825{
390b85e7 1826 return eof(fd);
96e4d5b1
PP
1827}
1828
1829DllExport int
68dc0745 1830win32_dup(int fd)
0a753a76 1831{
390b85e7 1832 return dup(fd);
0a753a76
PP
1833}
1834
68dc0745
PP
1835DllExport int
1836win32_dup2(int fd1,int fd2)
0a753a76 1837{
390b85e7 1838 return dup2(fd1,fd2);
0a753a76
PP
1839}
1840
68dc0745 1841DllExport int
3e3baf6d 1842win32_read(int fd, void *buf, unsigned int cnt)
0a753a76 1843{
390b85e7 1844 return read(fd, buf, cnt);
0a753a76
PP
1845}
1846
68dc0745 1847DllExport int
3e3baf6d 1848win32_write(int fd, const void *buf, unsigned int cnt)
0a753a76 1849{
390b85e7 1850 return write(fd, buf, cnt);
0a753a76
PP
1851}
1852
68dc0745 1853DllExport int
5aabfad6
PP
1854win32_mkdir(const char *dir, int mode)
1855{
390b85e7 1856 return mkdir(dir); /* just ignore mode */
5aabfad6 1857}
96e4d5b1 1858
5aabfad6
PP
1859DllExport int
1860win32_rmdir(const char *dir)
1861{
390b85e7 1862 return rmdir(dir);
5aabfad6 1863}
96e4d5b1 1864
5aabfad6
PP
1865DllExport int
1866win32_chdir(const char *dir)
1867{
390b85e7 1868 return chdir(dir);
5aabfad6 1869}
96e4d5b1 1870
5aabfad6 1871DllExport int
3e3baf6d 1872win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
0a753a76 1873{
2d7a9237
GS
1874 int status;
1875
4b556e6c 1876#ifndef USE_RTL_WAIT
e17cb2a9
JD
1877 if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
1878 return -1;
1879#endif
1880
2d7a9237 1881 status = spawnvp(mode, cmdname, (char * const *) argv);
4b556e6c 1882#ifndef USE_RTL_WAIT
2d7a9237
GS
1883 /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
1884 * while VC RTL returns pinfo.hProcess. For purposes of the custom
1885 * implementation of win32_wait(), we assume the latter.
1886 */
1887 if (mode == P_NOWAIT && status >= 0)
1888 w32_child_pids[w32_num_children++] = (HANDLE)status;
1889#endif
1890 return status;
0a753a76
PP
1891}
1892
6890e559 1893DllExport int
eb62e965
JD
1894win32_execv(const char *cmdname, const char *const *argv)
1895{
1896 return execv(cmdname, (char *const *)argv);
1897}
1898
1899DllExport int
6890e559
GS
1900win32_execvp(const char *cmdname, const char *const *argv)
1901{
390b85e7 1902 return execvp(cmdname, (char *const *)argv);
6890e559
GS
1903}
1904
84902520
TB
1905DllExport void
1906win32_perror(const char *str)
1907{
390b85e7 1908 perror(str);
84902520
TB
1909}
1910
1911DllExport void
1912win32_setbuf(FILE *pf, char *buf)
1913{
390b85e7 1914 setbuf(pf, buf);
84902520
TB
1915}
1916
1917DllExport int
1918win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
1919{
390b85e7 1920 return setvbuf(pf, buf, type, size);
84902520
TB
1921}
1922
1923DllExport int
1924win32_flushall(void)
1925{
390b85e7 1926 return flushall();
84902520
TB
1927}
1928
1929DllExport int
1930win32_fcloseall(void)
1931{
390b85e7 1932 return fcloseall();
84902520
TB
1933}
1934
1935DllExport char*
1936win32_fgets(char *s, int n, FILE *pf)
1937{
390b85e7 1938 return fgets(s, n, pf);
84902520
TB
1939}
1940
1941DllExport char*
1942win32_gets(char *s)
1943{
390b85e7 1944 return gets(s);
84902520
TB
1945}
1946
1947DllExport int
1948win32_fgetc(FILE *pf)
1949{
390b85e7 1950 return fgetc(pf);
84902520
TB
1951}
1952
1953DllExport int
1954win32_putc(int c, FILE *pf)
1955{
390b85e7 1956 return putc(c,pf);
84902520
TB
1957}
1958
1959DllExport int
1960win32_puts(const char *s)
1961{
390b85e7 1962 return puts(s);
84902520
TB
1963}
1964
1965DllExport int
1966win32_getchar(void)
1967{
390b85e7 1968 return getchar();
84902520
TB
1969}
1970
1971DllExport int
1972win32_putchar(int c)
1973{
390b85e7 1974 return putchar(c);
84902520
TB
1975}
1976
bbc8f9de
NIS
1977#ifdef MYMALLOC
1978
1979#ifndef USE_PERL_SBRK
1980
1981static char *committed = NULL;
1982static char *base = NULL;
1983static char *reserved = NULL;
1984static char *brk = NULL;
1985static DWORD pagesize = 0;
1986static DWORD allocsize = 0;
1987
1988void *
1989sbrk(int need)
1990{
1991 void *result;
1992 if (!pagesize)
1993 {SYSTEM_INFO info;
1994 GetSystemInfo(&info);
1995 /* Pretend page size is larger so we don't perpetually
1996 * call the OS to commit just one page ...
1997 */
1998 pagesize = info.dwPageSize << 3;
1999 allocsize = info.dwAllocationGranularity;
2000 }
2001 /* This scheme fails eventually if request for contiguous
2002 * block is denied so reserve big blocks - this is only
2003 * address space not memory ...
2004 */
2005 if (brk+need >= reserved)
2006 {
2007 DWORD size = 64*1024*1024;
2008 char *addr;
2009 if (committed && reserved && committed < reserved)
2010 {
2011 /* Commit last of previous chunk cannot span allocations */
161b471a 2012 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de
NIS
2013 if (addr)
2014 committed = reserved;
2015 }
2016 /* Reserve some (more) space
2017 * Note this is a little sneaky, 1st call passes NULL as reserved
2018 * so lets system choose where we start, subsequent calls pass
2019 * the old end address so ask for a contiguous block
2020 */
161b471a 2021 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
bbc8f9de
NIS
2022 if (addr)
2023 {
2024 reserved = addr+size;
2025 if (!base)
2026 base = addr;
2027 if (!committed)
2028 committed = base;
2029 if (!brk)
2030 brk = committed;
2031 }
2032 else
2033 {
2034 return (void *) -1;
2035 }
2036 }
2037 result = brk;
2038 brk += need;
2039 if (brk > committed)
2040 {
2041 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
161b471a 2042 char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
bbc8f9de
NIS
2043 if (addr)
2044 {
2045 committed += size;
2046 }
2047 else
2048 return (void *) -1;
2049 }
2050 return result;
2051}
2052
2053#endif
2054#endif
2055
84902520
TB
2056DllExport void*
2057win32_malloc(size_t size)
2058{
390b85e7 2059 return malloc(size);
84902520
TB
2060}
2061
2062DllExport void*
2063win32_calloc(size_t numitems, size_t size)
2064{
390b85e7 2065 return calloc(numitems,size);
84902520
TB
2066}
2067
2068DllExport void*
2069win32_realloc(void *block, size_t size)
2070{
390b85e7 2071 return realloc(block,size);
84902520
TB
2072}
2073
2074DllExport void
2075win32_free(void *block)
2076{
390b85e7 2077 free(block);
84902520
TB
2078}
2079
bbc8f9de 2080
68dc0745 2081int
65e48ea9 2082win32_open_osfhandle(long handle, int flags)
0a753a76 2083{
390b85e7 2084 return _open_osfhandle(handle, flags);
0a753a76
PP
2085}
2086
68dc0745 2087long
65e48ea9 2088win32_get_osfhandle(int fd)
0a753a76 2089{
390b85e7 2090 return _get_osfhandle(fd);
0a753a76 2091}
7bac28a0 2092
7bac28a0
PP
2093/*
2094 * Extras.
2095 */
2096
ad2e33dc
GS
2097static
2098XS(w32_GetCwd)
2099{
2100 dXSARGS;
2101 SV *sv = sv_newmortal();
2102 /* Make one call with zero size - return value is required size */
2103 DWORD len = GetCurrentDirectory((DWORD)0,NULL);
2104 SvUPGRADE(sv,SVt_PV);
2105 SvGROW(sv,len);
2106 SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
2107 /*
2108 * If result != 0
2109 * then it worked, set PV valid,
2110 * else leave it 'undef'
2111 */
2112 if (SvCUR(sv))
2113 SvPOK_on(sv);
50892819 2114 EXTEND(SP,1);
ad2e33dc
GS
2115 ST(0) = sv;
2116 XSRETURN(1);
2117}
2118
2119static
2120XS(w32_SetCwd)
2121{
2122 dXSARGS;
2123 if (items != 1)
2124 croak("usage: Win32::SetCurrentDirectory($cwd)");
2125 if (SetCurrentDirectory(SvPV(ST(0),na)))
2126 XSRETURN_YES;
2127
2128 XSRETURN_NO;
2129}
2130
2131static
2132XS(w32_GetNextAvailDrive)
2133{
2134 dXSARGS;
2135 char ix = 'C';
2136 char root[] = "_:\\";
2137 while (ix <= 'Z') {
2138 root[0] = ix++;
2139 if (GetDriveType(root) == 1) {
2140 root[2] = '\0';
2141 XSRETURN_PV(root);
2142 }
2143 }
2144 XSRETURN_UNDEF;
2145}
2146
2147static
2148XS(w32_GetLastError)
2149{
2150 dXSARGS;
2151 XSRETURN_IV(GetLastError());
2152}
2153
2154static
2155XS(w32_LoginName)
2156{
2157 dXSARGS;
e34ffe5a
GS
2158 char *name = getlogin_buffer;
2159 DWORD size = sizeof(getlogin_buffer);
ad2e33dc
GS
2160 if (GetUserName(name,&size)) {
2161 /* size includes NULL */
2162 ST(0) = sv_2mortal(newSVpv(name,size-1));
2163 XSRETURN(1);
2164 }
2165 XSRETURN_UNDEF;
2166}
2167
2168static
2169XS(w32_NodeName)
2170{
2171 dXSARGS;
2172 char name[MAX_COMPUTERNAME_LENGTH+1];
2173 DWORD size = sizeof(name);
2174 if (GetComputerName(name,&size)) {
2175 /* size does NOT include NULL :-( */
2176 ST(0) = sv_2mortal(newSVpv(name,size));
2177 XSRETURN(1);
2178 }
2179 XSRETURN_UNDEF;
2180}
2181
2182
2183static
2184XS(w32_DomainName)
2185{
2186 dXSARGS;
8c9208bc
GS
2187#ifndef HAS_NETWKSTAGETINFO
2188 /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
ad2e33dc
GS
2189 char name[256];
2190 DWORD size = sizeof(name);
2191 if (GetUserName(name,&size)) {
2192 char sid[1024];
2193 DWORD sidlen = sizeof(sid);
2194 char dname[256];
2195 DWORD dnamelen = sizeof(dname);
2196 SID_NAME_USE snu;
e56670dd 2197 if (LookupAccountName(NULL, name, &sid, &sidlen,
ad2e33dc
GS
2198 dname, &dnamelen, &snu)) {
2199 XSRETURN_PV(dname); /* all that for this */
2200 }
2201 }
e56670dd 2202#else
8c9208bc
GS
2203 /* this way is more reliable, in case user has a local account.
2204 * XXX need dynamic binding of netapi32.dll symbols or this will fail on
2205 * Win95. Probably makes more sense to move it into libwin32. */
9404a519
GS
2206 char dname[256];
2207 DWORD dnamelen = sizeof(dname);
0a2408cf
GS
2208 PWKSTA_INFO_100 pwi;
2209 if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
2210 if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
2211 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
2212 -1, (LPSTR)dname, dnamelen, NULL, NULL);
2213 }
2214 else {
2215 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
2216 -1, (LPSTR)dname, dnamelen, NULL, NULL);
2217 }
2218 NetApiBufferFree(pwi);
9404a519
GS
2219 XSRETURN_PV(dname);
2220 }
e56670dd 2221#endif
ad2e33dc
GS
2222 XSRETURN_UNDEF;
2223}
2224
2225static
2226XS(w32_FsType)
2227{
2228 dXSARGS;
2229 char fsname[256];
2230 DWORD flags, filecomplen;
2231 if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
2232 &flags, fsname, sizeof(fsname))) {
2233 if (GIMME == G_ARRAY) {
2234 XPUSHs(sv_2mortal(newSVpv(fsname,0)));
2235 XPUSHs(sv_2mortal(newSViv(flags)));
2236 XPUSHs(sv_2mortal(newSViv(filecomplen)));
2237 PUTBACK;
2238 return;
2239 }
2240 XSRETURN_PV(fsname);
2241 }
2242 XSRETURN_UNDEF;
2243}
2244
2245static
2246XS(w32_GetOSVersion)
2247{
2248 dXSARGS;
2249 OSVERSIONINFO osver;
2250
2251 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
2252 if (GetVersionEx(&osver)) {
2253 XPUSHs(newSVpv(osver.szCSDVersion, 0));
2254 XPUSHs(newSViv(osver.dwMajorVersion));
2255 XPUSHs(newSViv(osver.dwMinorVersion));
2256 XPUSHs(newSViv(osver.dwBuildNumber));
2257 XPUSHs(newSViv(osver.dwPlatformId));
2258 PUTBACK;
2259 return;
2260 }
2261 XSRETURN_UNDEF;
2262}
2263
2264static
2265XS(w32_IsWinNT)
2266{
2267 dXSARGS;
2268 XSRETURN_IV(IsWinNT());
2269}
2270
2271static
2272XS(w32_IsWin95)
2273{
2274 dXSARGS;
2275 XSRETURN_IV(IsWin95());
2276}
2277
2278static
2279XS(w32_FormatMessage)
2280{
2281 dXSARGS;
2282 DWORD source = 0;
2283 char msgbuf[1024];
2284
2285 if (items != 1)
2286 croak("usage: Win32::FormatMessage($errno)");
2287
2288 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
2289 &source, SvIV(ST(0)), 0,
2290 msgbuf, sizeof(msgbuf)-1, NULL))
2291 XSRETURN_PV(msgbuf);
2292
2293 XSRETURN_UNDEF;
2294}
2295
2296static
2297XS(w32_Spawn)
2298{
2299 dXSARGS;
2300 char *cmd, *args;
2301 PROCESS_INFORMATION stProcInfo;
2302 STARTUPINFO stStartInfo;
2303 BOOL bSuccess = FALSE;
2304
9404a519 2305 if (items != 3)
ad2e33dc
GS
2306 croak("usage: Win32::Spawn($cmdName, $args, $PID)");
2307
2308 cmd = SvPV(ST(0),na);
2309 args = SvPV(ST(1), na);
2310
2311 memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
2312 stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
2313 stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
2314 stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
2315
9404a519 2316 if (CreateProcess(
ad2e33dc
GS
2317 cmd, /* Image path */
2318 args, /* Arguments for command line */
2319 NULL, /* Default process security */
2320 NULL, /* Default thread security */
2321 FALSE, /* Must be TRUE to use std handles */
2322 NORMAL_PRIORITY_CLASS, /* No special scheduling */
2323 NULL, /* Inherit our environment block */
2324 NULL, /* Inherit our currrent directory */
2325 &stStartInfo, /* -> Startup info */
2326 &stProcInfo)) /* <- Process info (if OK) */
2327 {
2328 CloseHandle(stProcInfo.hThread);/* library source code does this. */
2329 sv_setiv(ST(2), stProcInfo.dwProcessId);
2330 bSuccess = TRUE;
2331 }
2332 XSRETURN_IV(bSuccess);
2333}
2334
2335static
2336XS(w32_GetTickCount)
2337{
2338 dXSARGS;
2339 XSRETURN_IV(GetTickCount());
2340}
2341
2342static
2343XS(w32_GetShortPathName)
2344{
2345 dXSARGS;
2346 SV *shortpath;
e8bab181 2347 DWORD len;
ad2e33dc 2348
9404a519 2349 if (items != 1)
ad2e33dc
GS
2350 croak("usage: Win32::GetShortPathName($longPathName)");
2351
2352 shortpath = sv_mortalcopy(ST(0));
2353 SvUPGRADE(shortpath, SVt_PV);
2354 /* src == target is allowed */
e8bab181
GS
2355 do {
2356 len = GetShortPathName(SvPVX(shortpath),
2357 SvPVX(shortpath),
2358 SvLEN(shortpath));
2359 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
2360 if (len) {
2361 SvCUR_set(shortpath,len);
ad2e33dc 2362 ST(0) = shortpath;
e8bab181 2363 }
ad2e33dc
GS
2364 else
2365 ST(0) = &sv_undef;
2366 XSRETURN(1);
2367}
2368
ad0751ec
GS
2369static
2370XS(w32_Sleep)
2371{
2372 dXSARGS;
2373 if (items != 1)
2374 croak("usage: Win32::Sleep($milliseconds)");
2375 Sleep(SvIV(ST(0)));
2376 XSRETURN_YES;
2377}
2378
ad2e33dc 2379void
f3986ebb 2380Perl_init_os_extras()
ad2e33dc
GS
2381{
2382 char *file = __FILE__;
2383 dXSUB_SYS;
2384
4b556e6c
JD
2385 w32_perlshell_tokens = Nullch;
2386 w32_perlshell_items = -1;
2387 w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
2388#ifndef USE_RTL_WAIT
2389 w32_num_children = 0;
2390#endif
2391
ad2e33dc
GS
2392 /* these names are Activeware compatible */
2393 newXS("Win32::GetCwd", w32_GetCwd, file);
2394 newXS("Win32::SetCwd", w32_SetCwd, file);
2395 newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
2396 newXS("Win32::GetLastError", w32_GetLastError, file);
2397 newXS("Win32::LoginName", w32_LoginName, file);
2398 newXS("Win32::NodeName", w32_NodeName, file);
2399 newXS("Win32::DomainName", w32_DomainName, file);
2400 newXS("Win32::FsType", w32_FsType, file);
2401 newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
2402 newXS("Win32::IsWinNT", w32_IsWinNT, file);
2403 newXS("Win32::IsWin95", w32_IsWin95, file);
2404 newXS("Win32::FormatMessage", w32_FormatMessage, file);
2405 newXS("Win32::Spawn", w32_Spawn, file);
2406 newXS("Win32::GetTickCount", w32_GetTickCount, file);
2407 newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
ad0751ec 2408 newXS("Win32::Sleep", w32_Sleep, file);
ad2e33dc
GS
2409
2410 /* XXX Bloat Alert! The following Activeware preloads really
2411 * ought to be part of Win32::Sys::*, so they're not included
2412 * here.
2413 */
2414 /* LookupAccountName
2415 * LookupAccountSID
2416 * InitiateSystemShutdown
2417 * AbortSystemShutdown
2418 * ExpandEnvrironmentStrings
2419 */
2420}
2421
2422void
2423Perl_win32_init(int *argcp, char ***argvp)
2424{
2425 /* Disable floating point errors, Perl will trap the ones we
2426 * care about. VC++ RTL defaults to switching these off
2427 * already, but the Borland RTL doesn't. Since we don't
2428 * want to be at the vendor's whim on the default, we set
2429 * it explicitly here.
2430 */
a835ef8a 2431#if !defined(_ALPHA_) && !defined(__GNUC__)
ad2e33dc 2432 _control87(MCW_EM, MCW_EM);
3dc9191e 2433#endif
4b556e6c 2434 MALLOC_INIT;
ad2e33dc 2435}
d55594ae 2436
a868473f
NIS
2437#ifdef USE_BINMODE_SCRIPTS
2438
2439void
2440win32_strip_return(SV *sv)
2441{
2442 char *s = SvPVX(sv);
2443 char *e = s+SvCUR(sv);
2444 char *d = s;
2445 while (s < e)
2446 {
2447 if (*s == '\r' && s[1] == '\n')
2448 {
2449 *d++ = '\n';
2450 s += 2;
2451 }
2452 else
2453 {
2454 *d++ = *s++;
2455 }
2456 }
2457 SvCUR_set(sv,d-SvPVX(sv));
2458}
2459
2460#endif