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