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