Mercurial > repo
comparison perl-5.22.2/win32/wince.c @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 /* WINCE.C - stuff for Windows CE | |
2 * | |
3 * Time-stamp: <26/10/01 15:25:20 keuchel@keuchelnt> | |
4 * | |
5 * You may distribute under the terms of either the GNU General Public | |
6 * License or the Artistic License, as specified in the README file. | |
7 */ | |
8 | |
9 #define WIN32_LEAN_AND_MEAN | |
10 #define WIN32IO_IS_STDIO | |
11 #include <windows.h> | |
12 #include <signal.h> | |
13 | |
14 #define PERLIO_NOT_STDIO 0 | |
15 | |
16 #if !defined(PERLIO_IS_STDIO) | |
17 #define PerlIO FILE | |
18 #endif | |
19 | |
20 #define wince_private | |
21 #include "errno.h" | |
22 | |
23 #include "EXTERN.h" | |
24 #include "perl.h" | |
25 | |
26 #define NO_XSLOCKS | |
27 #define PERL_NO_GET_CONTEXT | |
28 #include "XSUB.h" | |
29 | |
30 #include "win32iop.h" | |
31 #include <string.h> | |
32 #include <stdarg.h> | |
33 #include <float.h> | |
34 #include <shellapi.h> | |
35 #include <process.h> | |
36 | |
37 #define perl | |
38 #include "celib_defs.h" | |
39 #include "cewin32.h" | |
40 #include "cecrt.h" | |
41 #include "cewin32_defs.h" | |
42 #include "cecrt_defs.h" | |
43 | |
44 #define GetCurrentDirectoryW XCEGetCurrentDirectoryW | |
45 | |
46 #ifdef PALM_SIZE | |
47 #include "stdio-palmsize.h" | |
48 #endif | |
49 | |
50 #define EXECF_EXEC 1 | |
51 #define EXECF_SPAWN 2 | |
52 #define EXECF_SPAWN_NOWAIT 3 | |
53 | |
54 #if defined(PERL_IMPLICIT_SYS) | |
55 # undef win32_get_privlib | |
56 # define win32_get_privlib g_win32_get_privlib | |
57 # undef win32_get_sitelib | |
58 # define win32_get_sitelib g_win32_get_sitelib | |
59 # undef win32_get_vendorlib | |
60 # define win32_get_vendorlib g_win32_get_vendorlib | |
61 # undef do_spawn | |
62 # define do_spawn g_do_spawn | |
63 # undef getlogin | |
64 # define getlogin g_getlogin | |
65 #endif | |
66 | |
67 static void get_shell(void); | |
68 static long tokenize(const char *str, char **dest, char ***destv); | |
69 static int do_spawn2(pTHX_ char *cmd, int exectype); | |
70 static BOOL has_shell_metachars(char *ptr); | |
71 static long filetime_to_clock(PFILETIME ft); | |
72 static BOOL filetime_from_time(PFILETIME ft, time_t t); | |
73 static char * get_emd_part(SV **leading, STRLEN *const len, | |
74 char *trailing, ...); | |
75 static void remove_dead_process(long deceased); | |
76 static long find_pid(pTHX_ int pid); | |
77 static char * qualified_path(const char *cmd); | |
78 static char * win32_get_xlib(const char *pl, const char *xlib, | |
79 const char *libname, STRLEN *const len); | |
80 | |
81 #ifdef USE_ITHREADS | |
82 static void remove_dead_pseudo_process(long child); | |
83 static long find_pseudo_pid(pTHX_ int pid); | |
84 #endif | |
85 | |
86 int _fmode = O_TEXT; /* celib do not provide _fmode, so we define it here */ | |
87 | |
88 START_EXTERN_C | |
89 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; | |
90 char w32_module_name[MAX_PATH+1]; | |
91 END_EXTERN_C | |
92 | |
93 static DWORD w32_platform = (DWORD)-1; | |
94 | |
95 int | |
96 IsWin95(void) | |
97 { | |
98 return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS); | |
99 } | |
100 | |
101 int | |
102 IsWinNT(void) | |
103 { | |
104 return (win32_os_id() == VER_PLATFORM_WIN32_NT); | |
105 } | |
106 | |
107 int | |
108 IsWinCE(void) | |
109 { | |
110 return (win32_os_id() == VER_PLATFORM_WIN32_CE); | |
111 } | |
112 | |
113 EXTERN_C void | |
114 set_w32_module_name(void) | |
115 { | |
116 char* ptr; | |
117 XCEGetModuleFileNameA((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE) | |
118 ? XCEGetModuleHandleA(NULL) | |
119 : w32_perldll_handle), | |
120 w32_module_name, sizeof(w32_module_name)); | |
121 | |
122 /* normalize to forward slashes */ | |
123 ptr = w32_module_name; | |
124 while (*ptr) { | |
125 if (*ptr == '\\') | |
126 *ptr = '/'; | |
127 ++ptr; | |
128 } | |
129 } | |
130 | |
131 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ | |
132 static char* | |
133 get_regstr_from(HKEY hkey, const char *valuename, SV **svp) | |
134 { | |
135 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */ | |
136 HKEY handle; | |
137 DWORD type; | |
138 const char *subkey = "Software\\Perl"; | |
139 char *str = NULL; | |
140 long retval; | |
141 | |
142 retval = XCERegOpenKeyExA(hkey, subkey, 0, KEY_READ, &handle); | |
143 if (retval == ERROR_SUCCESS) { | |
144 DWORD datalen; | |
145 retval = XCERegQueryValueExA(handle, valuename, 0, &type, NULL, &datalen); | |
146 if (retval == ERROR_SUCCESS && type == REG_SZ) { | |
147 dTHX; | |
148 if (!*svp) | |
149 *svp = sv_2mortal(newSVpvs("")); | |
150 SvGROW(*svp, datalen); | |
151 retval = XCERegQueryValueExA(handle, valuename, 0, NULL, | |
152 (PBYTE)SvPVX(*svp), &datalen); | |
153 if (retval == ERROR_SUCCESS) { | |
154 str = SvPVX(*svp); | |
155 SvCUR_set(*svp,datalen-1); | |
156 } | |
157 } | |
158 RegCloseKey(handle); | |
159 } | |
160 return str; | |
161 } | |
162 | |
163 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ | |
164 static char* | |
165 get_regstr(const char *valuename, SV **svp) | |
166 { | |
167 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp); | |
168 if (!str) | |
169 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp); | |
170 return str; | |
171 } | |
172 | |
173 /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ | |
174 static char * | |
175 get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...) | |
176 { | |
177 char base[10]; | |
178 va_list ap; | |
179 char mod_name[MAX_PATH+1]; | |
180 char *ptr; | |
181 char *optr; | |
182 char *strip; | |
183 int oldsize, newsize; | |
184 STRLEN baselen; | |
185 | |
186 va_start(ap, trailing_path); | |
187 strip = va_arg(ap, char *); | |
188 | |
189 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION); | |
190 baselen = strlen(base); | |
191 | |
192 if (!*w32_module_name) { | |
193 set_w32_module_name(); | |
194 } | |
195 strcpy(mod_name, w32_module_name); | |
196 ptr = strrchr(mod_name, '/'); | |
197 while (ptr && strip) { | |
198 /* look for directories to skip back */ | |
199 optr = ptr; | |
200 *ptr = '\0'; | |
201 ptr = strrchr(mod_name, '/'); | |
202 /* avoid stripping component if there is no slash, | |
203 * or it doesn't match ... */ | |
204 if (!ptr || stricmp(ptr+1, strip) != 0) { | |
205 /* ... but not if component matches m|5\.$patchlevel.*| */ | |
206 if (!ptr || !(*strip == '5' && *(ptr+1) == '5' | |
207 && strncmp(strip, base, baselen) == 0 | |
208 && strncmp(ptr+1, base, baselen) == 0)) | |
209 { | |
210 *optr = '/'; | |
211 ptr = optr; | |
212 } | |
213 } | |
214 strip = va_arg(ap, char *); | |
215 } | |
216 if (!ptr) { | |
217 ptr = mod_name; | |
218 *ptr++ = '.'; | |
219 *ptr = '/'; | |
220 } | |
221 va_end(ap); | |
222 strcpy(++ptr, trailing_path); | |
223 | |
224 /* only add directory if it exists */ | |
225 if (XCEGetFileAttributesA(mod_name) != (DWORD) -1) { | |
226 /* directory exists */ | |
227 dTHX; | |
228 if (!*prev_pathp) | |
229 *prev_pathp = sv_2mortal(newSVpvs("")); | |
230 sv_catpvs(*prev_pathp, ";"); | |
231 sv_catpv(*prev_pathp, mod_name); | |
232 if(len) | |
233 *len = SvCUR(*prev_pathp); | |
234 return SvPVX(*prev_pathp); | |
235 } | |
236 | |
237 return NULL; | |
238 } | |
239 | |
240 char * | |
241 win32_get_privlib(const char *pl, STRLEN *const len) | |
242 { | |
243 dTHX; | |
244 char *stdlib = "lib"; | |
245 char buffer[MAX_PATH+1]; | |
246 SV *sv = NULL; | |
247 | |
248 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */ | |
249 sprintf(buffer, "%s-%s", stdlib, pl); | |
250 if (!get_regstr(buffer, &sv)) | |
251 (void)get_regstr(stdlib, &sv); | |
252 | |
253 /* $stdlib .= ";$EMD/../../lib" */ | |
254 return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL); | |
255 } | |
256 | |
257 static char * | |
258 win32_get_xlib(const char *pl, const char *xlib, const char *libname, | |
259 STRLEN *const len) | |
260 { | |
261 dTHX; | |
262 char regstr[40]; | |
263 char pathstr[MAX_PATH+1]; | |
264 SV *sv1 = NULL; | |
265 SV *sv2 = NULL; | |
266 | |
267 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */ | |
268 sprintf(regstr, "%s-%s", xlib, pl); | |
269 (void)get_regstr(regstr, &sv1); | |
270 | |
271 /* $xlib .= | |
272 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */ | |
273 sprintf(pathstr, "%s/%s/lib", libname, pl); | |
274 (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL); | |
275 | |
276 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */ | |
277 (void)get_regstr(xlib, &sv2); | |
278 | |
279 /* $xlib .= | |
280 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */ | |
281 sprintf(pathstr, "%s/lib", libname); | |
282 (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL); | |
283 | |
284 if (!sv1 && !sv2) | |
285 return NULL; | |
286 if (!sv1) { | |
287 sv1 = sv2; | |
288 } else if (sv2) { | |
289 sv_catpvs(sv1, ";"); | |
290 sv_catsv(sv1, sv2); | |
291 } | |
292 | |
293 if (len) | |
294 *len = SvCUR(sv1); | |
295 return SvPVX(sv1); | |
296 } | |
297 | |
298 char * | |
299 win32_get_sitelib(const char *pl, STRLEN *const len) | |
300 { | |
301 return win32_get_xlib(pl, "sitelib", "site", len); | |
302 } | |
303 | |
304 #ifndef PERL_VENDORLIB_NAME | |
305 # define PERL_VENDORLIB_NAME "vendor" | |
306 #endif | |
307 | |
308 char * | |
309 win32_get_vendorlib(const char *pl, STRLEN *const len) | |
310 { | |
311 return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len); | |
312 } | |
313 | |
314 static BOOL | |
315 has_shell_metachars(char *ptr) | |
316 { | |
317 int inquote = 0; | |
318 char quote = '\0'; | |
319 | |
320 /* | |
321 * Scan string looking for redirection (< or >) or pipe | |
322 * characters (|) that are not in a quoted string. | |
323 * Shell variable interpolation (%VAR%) can also happen inside strings. | |
324 */ | |
325 while (*ptr) { | |
326 switch(*ptr) { | |
327 case '%': | |
328 return TRUE; | |
329 case '\'': | |
330 case '\"': | |
331 if (inquote) { | |
332 if (quote == *ptr) { | |
333 inquote = 0; | |
334 quote = '\0'; | |
335 } | |
336 } | |
337 else { | |
338 quote = *ptr; | |
339 inquote++; | |
340 } | |
341 break; | |
342 case '>': | |
343 case '<': | |
344 case '|': | |
345 if (!inquote) | |
346 return TRUE; | |
347 default: | |
348 break; | |
349 } | |
350 ++ptr; | |
351 } | |
352 return FALSE; | |
353 } | |
354 | |
355 #if !defined(PERL_IMPLICIT_SYS) | |
356 /* since the current process environment is being updated in util.c | |
357 * the library functions will get the correct environment | |
358 */ | |
359 PerlIO * | |
360 Perl_my_popen(pTHX_ const char *cmd, const char *mode) | |
361 { | |
362 printf("popen(%s)\n", cmd); | |
363 | |
364 Perl_croak(aTHX_ PL_no_func, "popen"); | |
365 return NULL; | |
366 } | |
367 | |
368 long | |
369 Perl_my_pclose(pTHX_ PerlIO *fp) | |
370 { | |
371 Perl_croak(aTHX_ PL_no_func, "pclose"); | |
372 return -1; | |
373 } | |
374 #endif | |
375 | |
376 DllExport unsigned long | |
377 win32_os_id(void) | |
378 { | |
379 static OSVERSIONINFOA osver; | |
380 | |
381 if (osver.dwPlatformId != w32_platform) { | |
382 memset(&osver, 0, sizeof(OSVERSIONINFOA)); | |
383 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); | |
384 XCEGetVersionExA(&osver); | |
385 w32_platform = osver.dwPlatformId; | |
386 } | |
387 return (unsigned long)w32_platform; | |
388 } | |
389 | |
390 DllExport int | |
391 win32_getpid(void) | |
392 { | |
393 int pid; | |
394 #ifdef USE_ITHREADS | |
395 dTHX; | |
396 if (w32_pseudo_id) | |
397 return -((int)w32_pseudo_id); | |
398 #endif | |
399 pid = xcegetpid(); | |
400 return pid; | |
401 } | |
402 | |
403 /* Tokenize a string. Words are null-separated, and the list | |
404 * ends with a doubled null. Any character (except null and | |
405 * including backslash) may be escaped by preceding it with a | |
406 * backslash (the backslash will be stripped). | |
407 * Returns number of words in result buffer. | |
408 */ | |
409 static long | |
410 tokenize(const char *str, char **dest, char ***destv) | |
411 { | |
412 char *retstart = NULL; | |
413 char **retvstart = 0; | |
414 int items = -1; | |
415 if (str) { | |
416 dTHX; | |
417 int slen = strlen(str); | |
418 char *ret; | |
419 char **retv; | |
420 Newx(ret, slen+2, char); | |
421 Newx(retv, (slen+3)/2, char*); | |
422 | |
423 retstart = ret; | |
424 retvstart = retv; | |
425 *retv = ret; | |
426 items = 0; | |
427 while (*str) { | |
428 *ret = *str++; | |
429 if (*ret == '\\' && *str) | |
430 *ret = *str++; | |
431 else if (*ret == ' ') { | |
432 while (*str == ' ') | |
433 str++; | |
434 if (ret == retstart) | |
435 ret--; | |
436 else { | |
437 *ret = '\0'; | |
438 ++items; | |
439 if (*str) | |
440 *++retv = ret+1; | |
441 } | |
442 } | |
443 else if (!*str) | |
444 ++items; | |
445 ret++; | |
446 } | |
447 retvstart[items] = NULL; | |
448 *ret++ = '\0'; | |
449 *ret = '\0'; | |
450 } | |
451 *dest = retstart; | |
452 *destv = retvstart; | |
453 return items; | |
454 } | |
455 | |
456 DllExport int | |
457 win32_pipe(int *pfd, unsigned int size, int mode) | |
458 { | |
459 dTHX; | |
460 Perl_croak(aTHX_ PL_no_func, "pipe"); | |
461 return -1; | |
462 } | |
463 | |
464 DllExport int | |
465 win32_times(struct tms *timebuf) | |
466 { | |
467 dTHX; | |
468 Perl_croak(aTHX_ PL_no_func, "times"); | |
469 return -1; | |
470 } | |
471 | |
472 Sighandler_t | |
473 win32_signal(int sig, Sighandler_t subcode) | |
474 { | |
475 return xcesignal(sig, subcode); | |
476 } | |
477 | |
478 static void | |
479 get_shell(void) | |
480 { | |
481 dTHX; | |
482 if (!w32_perlshell_tokens) { | |
483 /* we don't use COMSPEC here for two reasons: | |
484 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and | |
485 * uncontrolled unportability of the ensuing scripts. | |
486 * 2. PERL5SHELL could be set to a shell that may not be fit for | |
487 * interactive use (which is what most programs look in COMSPEC | |
488 * for). | |
489 */ | |
490 const char* defaultshell = (IsWinNT() | |
491 ? "cmd.exe /x/d/c" : "command.com /c"); | |
492 const char *usershell = PerlEnv_getenv("PERL5SHELL"); | |
493 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, | |
494 &w32_perlshell_tokens, | |
495 &w32_perlshell_vec); | |
496 } | |
497 } | |
498 | |
499 int | |
500 Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) | |
501 { | |
502 PERL_ARGS_ASSERT_DO_ASPAWN; | |
503 | |
504 Perl_croak(aTHX_ PL_no_func, "aspawn"); | |
505 return -1; | |
506 } | |
507 | |
508 /* returns pointer to the next unquoted space or the end of the string */ | |
509 static char* | |
510 find_next_space(const char *s) | |
511 { | |
512 bool in_quotes = FALSE; | |
513 while (*s) { | |
514 /* ignore doubled backslashes, or backslash+quote */ | |
515 if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) { | |
516 s += 2; | |
517 } | |
518 /* keep track of when we're within quotes */ | |
519 else if (*s == '"') { | |
520 s++; | |
521 in_quotes = !in_quotes; | |
522 } | |
523 /* break it up only at spaces that aren't in quotes */ | |
524 else if (!in_quotes && isSPACE(*s)) | |
525 return (char*)s; | |
526 else | |
527 s++; | |
528 } | |
529 return (char*)s; | |
530 } | |
531 | |
532 #if 1 | |
533 static int | |
534 do_spawn2(pTHX_ char *cmd, int exectype) | |
535 { | |
536 char **a; | |
537 char *s; | |
538 char **argv; | |
539 int status = -1; | |
540 BOOL needToTry = TRUE; | |
541 char *cmd2; | |
542 | |
543 /* Save an extra exec if possible. See if there are shell | |
544 * metacharacters in it */ | |
545 if (!has_shell_metachars(cmd)) { | |
546 Newx(argv, strlen(cmd) / 2 + 2, char*); | |
547 Newx(cmd2, strlen(cmd) + 1, char); | |
548 strcpy(cmd2, cmd); | |
549 a = argv; | |
550 for (s = cmd2; *s;) { | |
551 while (*s && isSPACE(*s)) | |
552 s++; | |
553 if (*s) | |
554 *(a++) = s; | |
555 s = find_next_space(s); | |
556 if (*s) | |
557 *s++ = '\0'; | |
558 } | |
559 *a = NULL; | |
560 if (argv[0]) { | |
561 switch (exectype) { | |
562 case EXECF_SPAWN: | |
563 status = win32_spawnvp(P_WAIT, argv[0], | |
564 (const char* const*)argv); | |
565 break; | |
566 case EXECF_SPAWN_NOWAIT: | |
567 status = win32_spawnvp(P_NOWAIT, argv[0], | |
568 (const char* const*)argv); | |
569 break; | |
570 case EXECF_EXEC: | |
571 status = win32_execvp(argv[0], (const char* const*)argv); | |
572 break; | |
573 } | |
574 if (status != -1 || errno == 0) | |
575 needToTry = FALSE; | |
576 } | |
577 Safefree(argv); | |
578 Safefree(cmd2); | |
579 } | |
580 if (needToTry) { | |
581 char **argv; | |
582 int i = -1; | |
583 get_shell(); | |
584 Newx(argv, w32_perlshell_items + 2, char*); | |
585 while (++i < w32_perlshell_items) | |
586 argv[i] = w32_perlshell_vec[i]; | |
587 argv[i++] = cmd; | |
588 argv[i] = NULL; | |
589 switch (exectype) { | |
590 case EXECF_SPAWN: | |
591 status = win32_spawnvp(P_WAIT, argv[0], | |
592 (const char* const*)argv); | |
593 break; | |
594 case EXECF_SPAWN_NOWAIT: | |
595 status = win32_spawnvp(P_NOWAIT, argv[0], | |
596 (const char* const*)argv); | |
597 break; | |
598 case EXECF_EXEC: | |
599 status = win32_execvp(argv[0], (const char* const*)argv); | |
600 break; | |
601 } | |
602 cmd = argv[0]; | |
603 Safefree(argv); | |
604 } | |
605 if (exectype == EXECF_SPAWN_NOWAIT) { | |
606 if (IsWin95()) | |
607 PL_statusvalue = -1; /* >16bits hint for pp_system() */ | |
608 } | |
609 else { | |
610 if (status < 0) { | |
611 if (ckWARN(WARN_EXEC)) | |
612 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", | |
613 (exectype == EXECF_EXEC ? "exec" : "spawn"), | |
614 cmd, strerror(errno)); | |
615 status = 255 * 256; | |
616 } | |
617 else | |
618 status *= 256; | |
619 PL_statusvalue = status; | |
620 } | |
621 return (status); | |
622 } | |
623 | |
624 int | |
625 Perl_do_spawn(pTHX_ char *cmd) | |
626 { | |
627 PERL_ARGS_ASSERT_DO_SPAWN; | |
628 | |
629 return do_spawn2(aTHX_ cmd, EXECF_SPAWN); | |
630 } | |
631 | |
632 int | |
633 Perl_do_spawn_nowait(pTHX_ char *cmd) | |
634 { | |
635 PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT; | |
636 | |
637 return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT); | |
638 } | |
639 | |
640 bool | |
641 Perl_do_exec(pTHX_ const char *cmd) | |
642 { | |
643 PERL_ARGS_ASSERT_DO_EXEC; | |
644 | |
645 do_spawn2(aTHX_ cmd, EXECF_EXEC); | |
646 return FALSE; | |
647 } | |
648 | |
649 /* The idea here is to read all the directory names into a string table | |
650 * (separated by nulls) and when one of the other dir functions is called | |
651 * return the pointer to the current file name. | |
652 */ | |
653 DllExport DIR * | |
654 win32_opendir(const char *filename) | |
655 { | |
656 dTHX; | |
657 DIR *dirp; | |
658 long len; | |
659 long idx; | |
660 char scanname[MAX_PATH+3]; | |
661 Stat_t sbuf; | |
662 WIN32_FIND_DATAA aFindData; | |
663 WIN32_FIND_DATAW wFindData; | |
664 HANDLE fh; | |
665 char buffer[MAX_PATH*2]; | |
666 WCHAR wbuffer[MAX_PATH+1]; | |
667 char* ptr; | |
668 | |
669 len = strlen(filename); | |
670 if (len > MAX_PATH) | |
671 return NULL; | |
672 | |
673 /* check to see if filename is a directory */ | |
674 if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode)) | |
675 return NULL; | |
676 | |
677 /* Get us a DIR structure */ | |
678 Newxz(dirp, 1, DIR); | |
679 | |
680 /* Create the search pattern */ | |
681 strcpy(scanname, filename); | |
682 | |
683 /* bare drive name means look in cwd for drive */ | |
684 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') { | |
685 scanname[len++] = '.'; | |
686 scanname[len++] = '/'; | |
687 } | |
688 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') { | |
689 scanname[len++] = '/'; | |
690 } | |
691 scanname[len++] = '*'; | |
692 scanname[len] = '\0'; | |
693 | |
694 /* do the FindFirstFile call */ | |
695 fh = FindFirstFile(PerlDir_mapA(scanname), &aFindData); | |
696 dirp->handle = fh; | |
697 if (fh == INVALID_HANDLE_VALUE) { | |
698 DWORD err = GetLastError(); | |
699 /* FindFirstFile() fails on empty drives! */ | |
700 switch (err) { | |
701 case ERROR_FILE_NOT_FOUND: | |
702 return dirp; | |
703 case ERROR_NO_MORE_FILES: | |
704 case ERROR_PATH_NOT_FOUND: | |
705 errno = ENOENT; | |
706 break; | |
707 case ERROR_NOT_ENOUGH_MEMORY: | |
708 errno = ENOMEM; | |
709 break; | |
710 default: | |
711 errno = EINVAL; | |
712 break; | |
713 } | |
714 Safefree(dirp); | |
715 return NULL; | |
716 } | |
717 | |
718 /* now allocate the first part of the string table for | |
719 * the filenames that we find. | |
720 */ | |
721 ptr = aFindData.cFileName; | |
722 idx = strlen(ptr)+1; | |
723 if (idx < 256) | |
724 dirp->size = 128; | |
725 else | |
726 dirp->size = idx; | |
727 Newx(dirp->start, dirp->size, char); | |
728 strcpy(dirp->start, ptr); | |
729 dirp->nfiles++; | |
730 dirp->end = dirp->curr = dirp->start; | |
731 dirp->end += idx; | |
732 return dirp; | |
733 } | |
734 | |
735 | |
736 /* Readdir just returns the current string pointer and bumps the | |
737 * string pointer to the nDllExport entry. | |
738 */ | |
739 DllExport struct direct * | |
740 win32_readdir(DIR *dirp) | |
741 { | |
742 long len; | |
743 | |
744 if (dirp->curr) { | |
745 /* first set up the structure to return */ | |
746 len = strlen(dirp->curr); | |
747 strcpy(dirp->dirstr.d_name, dirp->curr); | |
748 dirp->dirstr.d_namlen = len; | |
749 | |
750 /* Fake an inode */ | |
751 dirp->dirstr.d_ino = dirp->curr - dirp->start; | |
752 | |
753 /* Now set up for the next call to readdir */ | |
754 dirp->curr += len + 1; | |
755 if (dirp->curr >= dirp->end) { | |
756 dTHX; | |
757 char* ptr; | |
758 BOOL res; | |
759 WIN32_FIND_DATAW wFindData; | |
760 WIN32_FIND_DATAA aFindData; | |
761 char buffer[MAX_PATH*2]; | |
762 | |
763 /* finding the next file that matches the wildcard | |
764 * (which should be all of them in this directory!). | |
765 */ | |
766 res = FindNextFile(dirp->handle, &aFindData); | |
767 if (res) | |
768 ptr = aFindData.cFileName; | |
769 if (res) { | |
770 long endpos = dirp->end - dirp->start; | |
771 long newsize = endpos + strlen(ptr) + 1; | |
772 /* bump the string table size by enough for the | |
773 * new name and its null terminator */ | |
774 while (newsize > dirp->size) { | |
775 long curpos = dirp->curr - dirp->start; | |
776 dirp->size *= 2; | |
777 Renew(dirp->start, dirp->size, char); | |
778 dirp->curr = dirp->start + curpos; | |
779 } | |
780 strcpy(dirp->start + endpos, ptr); | |
781 dirp->end = dirp->start + newsize; | |
782 dirp->nfiles++; | |
783 } | |
784 else | |
785 dirp->curr = NULL; | |
786 } | |
787 return &(dirp->dirstr); | |
788 } | |
789 else | |
790 return NULL; | |
791 } | |
792 | |
793 /* Telldir returns the current string pointer position */ | |
794 DllExport long | |
795 win32_telldir(DIR *dirp) | |
796 { | |
797 return (dirp->curr - dirp->start); | |
798 } | |
799 | |
800 | |
801 /* Seekdir moves the string pointer to a previously saved position | |
802 * (returned by telldir). | |
803 */ | |
804 DllExport void | |
805 win32_seekdir(DIR *dirp, long loc) | |
806 { | |
807 dirp->curr = dirp->start + loc; | |
808 } | |
809 | |
810 /* Rewinddir resets the string pointer to the start */ | |
811 DllExport void | |
812 win32_rewinddir(DIR *dirp) | |
813 { | |
814 dirp->curr = dirp->start; | |
815 } | |
816 | |
817 /* free the memory allocated by opendir */ | |
818 DllExport int | |
819 win32_closedir(DIR *dirp) | |
820 { | |
821 dTHX; | |
822 if (dirp->handle != INVALID_HANDLE_VALUE) | |
823 FindClose(dirp->handle); | |
824 Safefree(dirp->start); | |
825 Safefree(dirp); | |
826 return 1; | |
827 } | |
828 | |
829 #else | |
830 /////!!!!!!!!!!! return here and do right stuff!!!! | |
831 | |
832 DllExport DIR * | |
833 win32_opendir(const char *filename) | |
834 { | |
835 return opendir(filename); | |
836 } | |
837 | |
838 DllExport struct direct * | |
839 win32_readdir(DIR *dirp) | |
840 { | |
841 return readdir(dirp); | |
842 } | |
843 | |
844 DllExport long | |
845 win32_telldir(DIR *dirp) | |
846 { | |
847 dTHX; | |
848 Perl_croak(aTHX_ PL_no_func, "telldir"); | |
849 return -1; | |
850 } | |
851 | |
852 DllExport void | |
853 win32_seekdir(DIR *dirp, long loc) | |
854 { | |
855 dTHX; | |
856 Perl_croak(aTHX_ PL_no_func, "seekdir"); | |
857 } | |
858 | |
859 DllExport void | |
860 win32_rewinddir(DIR *dirp) | |
861 { | |
862 dTHX; | |
863 Perl_croak(aTHX_ PL_no_func, "rewinddir"); | |
864 } | |
865 | |
866 DllExport int | |
867 win32_closedir(DIR *dirp) | |
868 { | |
869 closedir(dirp); | |
870 return 0; | |
871 } | |
872 #endif // 1 | |
873 | |
874 DllExport int | |
875 win32_kill(int pid, int sig) | |
876 { | |
877 dTHX; | |
878 Perl_croak(aTHX_ PL_no_func, "kill"); | |
879 return -1; | |
880 } | |
881 | |
882 DllExport int | |
883 win32_stat(const char *path, struct stat *sbuf) | |
884 { | |
885 return xcestat(path, sbuf); | |
886 } | |
887 | |
888 DllExport char * | |
889 win32_longpath(char *path) | |
890 { | |
891 return path; | |
892 } | |
893 | |
894 static void | |
895 out_of_memory(void) | |
896 { | |
897 if (PL_curinterp) { | |
898 dTHX; | |
899 /* Can't use PerlIO to write as it allocates memory */ | |
900 PerlLIO_write(PerlIO_fileno(Perl_error_log), | |
901 PL_no_mem, strlen(PL_no_mem)); | |
902 my_exit(1); | |
903 } | |
904 exit(1); | |
905 } | |
906 | |
907 /* The win32_ansipath() function takes a Unicode filename and converts it | |
908 * into the current Windows codepage. If some characters cannot be mapped, | |
909 * then it will convert the short name instead. | |
910 * | |
911 * The buffer to the ansi pathname must be freed with win32_free() when it | |
912 * it no longer needed. | |
913 * | |
914 * The argument to win32_ansipath() must exist before this function is | |
915 * called; otherwise there is no way to determine the short path name. | |
916 * | |
917 * Ideas for future refinement: | |
918 * - Only convert those segments of the path that are not in the current | |
919 * codepage, but leave the other segments in their long form. | |
920 * - If the resulting name is longer than MAX_PATH, start converting | |
921 * additional path segments into short names until the full name | |
922 * is shorter than MAX_PATH. Shorten the filename part last! | |
923 */ | |
924 DllExport char * | |
925 win32_ansipath(const WCHAR *widename) | |
926 { | |
927 char *name; | |
928 size_t widelen = wcslen(widename)+1; | |
929 int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen, | |
930 NULL, 0, NULL, NULL); | |
931 name = win32_malloc(len); | |
932 if (!name) | |
933 out_of_memory(); | |
934 | |
935 WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen, | |
936 name, len, NULL, NULL); | |
937 return name; | |
938 } | |
939 | |
940 DllExport char * | |
941 win32_getenv(const char *name) | |
942 { | |
943 return xcegetenv(name); | |
944 } | |
945 | |
946 DllExport int | |
947 win32_putenv(const char *name) | |
948 { | |
949 return xceputenv(name); | |
950 } | |
951 | |
952 static long | |
953 filetime_to_clock(PFILETIME ft) | |
954 { | |
955 __int64 qw = ft->dwHighDateTime; | |
956 qw <<= 32; | |
957 qw |= ft->dwLowDateTime; | |
958 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ | |
959 return (long) qw; | |
960 } | |
961 | |
962 /* fix utime() so it works on directories in NT */ | |
963 static BOOL | |
964 filetime_from_time(PFILETIME pFileTime, time_t Time) | |
965 { | |
966 struct tm *pTM = localtime(&Time); | |
967 SYSTEMTIME SystemTime; | |
968 FILETIME LocalTime; | |
969 | |
970 if (pTM == NULL) | |
971 return FALSE; | |
972 | |
973 SystemTime.wYear = pTM->tm_year + 1900; | |
974 SystemTime.wMonth = pTM->tm_mon + 1; | |
975 SystemTime.wDay = pTM->tm_mday; | |
976 SystemTime.wHour = pTM->tm_hour; | |
977 SystemTime.wMinute = pTM->tm_min; | |
978 SystemTime.wSecond = pTM->tm_sec; | |
979 SystemTime.wMilliseconds = 0; | |
980 | |
981 return SystemTimeToFileTime(&SystemTime, &LocalTime) && | |
982 LocalFileTimeToFileTime(&LocalTime, pFileTime); | |
983 } | |
984 | |
985 DllExport int | |
986 win32_unlink(const char *filename) | |
987 { | |
988 return xceunlink(filename); | |
989 } | |
990 | |
991 DllExport int | |
992 win32_utime(const char *filename, struct utimbuf *times) | |
993 { | |
994 return xceutime(filename, (struct _utimbuf *) times); | |
995 } | |
996 | |
997 DllExport int | |
998 win32_gettimeofday(struct timeval *tp, void *not_used) | |
999 { | |
1000 return xcegettimeofday(tp,not_used); | |
1001 } | |
1002 | |
1003 DllExport int | |
1004 win32_uname(struct utsname *name) | |
1005 { | |
1006 struct hostent *hep; | |
1007 STRLEN nodemax = sizeof(name->nodename)-1; | |
1008 OSVERSIONINFOA osver; | |
1009 | |
1010 memset(&osver, 0, sizeof(OSVERSIONINFOA)); | |
1011 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); | |
1012 if (XCEGetVersionExA(&osver)) { | |
1013 /* sysname */ | |
1014 switch (osver.dwPlatformId) { | |
1015 case VER_PLATFORM_WIN32_CE: | |
1016 strcpy(name->sysname, "Windows CE"); | |
1017 break; | |
1018 case VER_PLATFORM_WIN32_WINDOWS: | |
1019 strcpy(name->sysname, "Windows"); | |
1020 break; | |
1021 case VER_PLATFORM_WIN32_NT: | |
1022 strcpy(name->sysname, "Windows NT"); | |
1023 break; | |
1024 case VER_PLATFORM_WIN32s: | |
1025 strcpy(name->sysname, "Win32s"); | |
1026 break; | |
1027 default: | |
1028 strcpy(name->sysname, "Win32 Unknown"); | |
1029 break; | |
1030 } | |
1031 | |
1032 /* release */ | |
1033 sprintf(name->release, "%d.%d", | |
1034 osver.dwMajorVersion, osver.dwMinorVersion); | |
1035 | |
1036 /* version */ | |
1037 sprintf(name->version, "Build %d", | |
1038 osver.dwPlatformId == VER_PLATFORM_WIN32_NT | |
1039 ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff)); | |
1040 if (osver.szCSDVersion[0]) { | |
1041 char *buf = name->version + strlen(name->version); | |
1042 sprintf(buf, " (%s)", osver.szCSDVersion); | |
1043 } | |
1044 } | |
1045 else { | |
1046 *name->sysname = '\0'; | |
1047 *name->version = '\0'; | |
1048 *name->release = '\0'; | |
1049 } | |
1050 | |
1051 /* nodename */ | |
1052 hep = win32_gethostbyname("localhost"); | |
1053 if (hep) { | |
1054 STRLEN len = strlen(hep->h_name); | |
1055 if (len <= nodemax) { | |
1056 strcpy(name->nodename, hep->h_name); | |
1057 } | |
1058 else { | |
1059 strncpy(name->nodename, hep->h_name, nodemax); | |
1060 name->nodename[nodemax] = '\0'; | |
1061 } | |
1062 } | |
1063 else { | |
1064 DWORD sz = nodemax; | |
1065 if (!XCEGetComputerNameA(name->nodename, &sz)) | |
1066 *name->nodename = '\0'; | |
1067 } | |
1068 | |
1069 /* machine (architecture) */ | |
1070 { | |
1071 SYSTEM_INFO info; | |
1072 char *arch; | |
1073 GetSystemInfo(&info); | |
1074 | |
1075 switch (info.wProcessorArchitecture) { | |
1076 case PROCESSOR_ARCHITECTURE_INTEL: | |
1077 arch = "x86"; break; | |
1078 case PROCESSOR_ARCHITECTURE_MIPS: | |
1079 arch = "mips"; break; | |
1080 case PROCESSOR_ARCHITECTURE_ALPHA: | |
1081 arch = "alpha"; break; | |
1082 case PROCESSOR_ARCHITECTURE_PPC: | |
1083 arch = "ppc"; break; | |
1084 case PROCESSOR_ARCHITECTURE_ARM: | |
1085 arch = "arm"; break; | |
1086 case PROCESSOR_HITACHI_SH3: | |
1087 arch = "sh3"; break; | |
1088 case PROCESSOR_SHx_SH3: | |
1089 arch = "sh3"; break; | |
1090 | |
1091 default: | |
1092 arch = "unknown"; break; | |
1093 } | |
1094 strcpy(name->machine, arch); | |
1095 } | |
1096 return 0; | |
1097 } | |
1098 | |
1099 /* Timing related stuff */ | |
1100 | |
1101 int | |
1102 do_raise(pTHX_ int sig) | |
1103 { | |
1104 if (sig < SIG_SIZE) { | |
1105 Sighandler_t handler = w32_sighandler[sig]; | |
1106 if (handler == SIG_IGN) { | |
1107 return 0; | |
1108 } | |
1109 else if (handler != SIG_DFL) { | |
1110 (*handler)(sig); | |
1111 return 0; | |
1112 } | |
1113 else { | |
1114 /* Choose correct default behaviour */ | |
1115 switch (sig) { | |
1116 #ifdef SIGCLD | |
1117 case SIGCLD: | |
1118 #endif | |
1119 #ifdef SIGCHLD | |
1120 case SIGCHLD: | |
1121 #endif | |
1122 case 0: | |
1123 return 0; | |
1124 case SIGTERM: | |
1125 default: | |
1126 break; | |
1127 } | |
1128 } | |
1129 } | |
1130 /* Tell caller to exit thread/process as appropriate */ | |
1131 return 1; | |
1132 } | |
1133 | |
1134 void | |
1135 sig_terminate(pTHX_ int sig) | |
1136 { | |
1137 Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig); | |
1138 /* exit() seems to be safe, my_exit() or die() is a problem in ^C | |
1139 thread | |
1140 */ | |
1141 exit(sig); | |
1142 } | |
1143 | |
1144 DllExport int | |
1145 win32_async_check(pTHX) | |
1146 { | |
1147 MSG msg; | |
1148 int ours = 1; | |
1149 /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages | |
1150 * and ignores window messages - should co-exist better with windows apps e.g. Tk | |
1151 */ | |
1152 while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) { | |
1153 int sig; | |
1154 switch(msg.message) { | |
1155 | |
1156 #if 0 | |
1157 /* Perhaps some other messages could map to signals ? ... */ | |
1158 case WM_CLOSE: | |
1159 case WM_QUIT: | |
1160 /* Treat WM_QUIT like SIGHUP? */ | |
1161 sig = SIGHUP; | |
1162 goto Raise; | |
1163 break; | |
1164 #endif | |
1165 | |
1166 /* We use WM_USER to fake kill() with other signals */ | |
1167 case WM_USER: { | |
1168 sig = msg.wParam; | |
1169 Raise: | |
1170 if (do_raise(aTHX_ sig)) { | |
1171 sig_terminate(aTHX_ sig); | |
1172 } | |
1173 break; | |
1174 } | |
1175 | |
1176 case WM_TIMER: { | |
1177 /* alarm() is a one-shot but SetTimer() repeats so kill it */ | |
1178 if (w32_timerid) { | |
1179 KillTimer(NULL,w32_timerid); | |
1180 w32_timerid=0; | |
1181 } | |
1182 /* Now fake a call to signal handler */ | |
1183 if (do_raise(aTHX_ 14)) { | |
1184 sig_terminate(aTHX_ 14); | |
1185 } | |
1186 break; | |
1187 } | |
1188 | |
1189 /* Otherwise do normal Win32 thing - in case it is useful */ | |
1190 default: | |
1191 TranslateMessage(&msg); | |
1192 DispatchMessage(&msg); | |
1193 ours = 0; | |
1194 break; | |
1195 } | |
1196 } | |
1197 w32_poll_count = 0; | |
1198 | |
1199 /* Above or other stuff may have set a signal flag */ | |
1200 if (PL_sig_pending) { | |
1201 despatch_signals(); | |
1202 } | |
1203 return ours; | |
1204 } | |
1205 | |
1206 /* This function will not return until the timeout has elapsed, or until | |
1207 * one of the handles is ready. */ | |
1208 DllExport DWORD | |
1209 win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp) | |
1210 { | |
1211 /* We may need several goes at this - so compute when we stop */ | |
1212 DWORD ticks = 0; | |
1213 if (timeout != INFINITE) { | |
1214 ticks = GetTickCount(); | |
1215 timeout += ticks; | |
1216 } | |
1217 while (1) { | |
1218 DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS); | |
1219 if (resultp) | |
1220 *resultp = result; | |
1221 if (result == WAIT_TIMEOUT) { | |
1222 /* Ran out of time - explicit return of zero to avoid -ve if we | |
1223 have scheduling issues | |
1224 */ | |
1225 return 0; | |
1226 } | |
1227 if (timeout != INFINITE) { | |
1228 ticks = GetTickCount(); | |
1229 } | |
1230 if (result == WAIT_OBJECT_0 + count) { | |
1231 /* Message has arrived - check it */ | |
1232 (void)win32_async_check(aTHX); | |
1233 } | |
1234 else { | |
1235 /* Not timeout or message - one of handles is ready */ | |
1236 break; | |
1237 } | |
1238 } | |
1239 /* compute time left to wait */ | |
1240 ticks = timeout - ticks; | |
1241 /* If we are past the end say zero */ | |
1242 return (ticks > 0) ? ticks : 0; | |
1243 } | |
1244 | |
1245 static UINT timerid = 0; | |
1246 | |
1247 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) | |
1248 { | |
1249 dTHX; | |
1250 KillTimer(NULL,timerid); | |
1251 timerid=0; | |
1252 sighandler(14); | |
1253 } | |
1254 | |
1255 DllExport unsigned int | |
1256 win32_sleep(unsigned int t) | |
1257 { | |
1258 return xcesleep(t); | |
1259 } | |
1260 | |
1261 DllExport unsigned int | |
1262 win32_alarm(unsigned int sec) | |
1263 { | |
1264 /* | |
1265 * the 'obvious' implentation is SetTimer() with a callback | |
1266 * which does whatever receiving SIGALRM would do | |
1267 * we cannot use SIGALRM even via raise() as it is not | |
1268 * one of the supported codes in <signal.h> | |
1269 * | |
1270 * Snag is unless something is looking at the message queue | |
1271 * nothing happens :-( | |
1272 */ | |
1273 dTHX; | |
1274 if (sec) | |
1275 { | |
1276 timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc); | |
1277 if (!timerid) | |
1278 Perl_croak_nocontext("Cannot set timer"); | |
1279 } | |
1280 else | |
1281 { | |
1282 if (timerid) | |
1283 { | |
1284 KillTimer(NULL,timerid); | |
1285 timerid=0; | |
1286 } | |
1287 } | |
1288 return 0; | |
1289 } | |
1290 | |
1291 #ifdef HAVE_DES_FCRYPT | |
1292 extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf); | |
1293 #endif | |
1294 | |
1295 DllExport char * | |
1296 win32_crypt(const char *txt, const char *salt) | |
1297 { | |
1298 dTHX; | |
1299 #ifdef HAVE_DES_FCRYPT | |
1300 dTHR; | |
1301 return des_fcrypt(txt, salt, w32_crypt_buffer); | |
1302 #else | |
1303 Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); | |
1304 return NULL; | |
1305 #endif | |
1306 } | |
1307 | |
1308 | |
1309 /* | |
1310 * redirected io subsystem for all XS modules | |
1311 * | |
1312 */ | |
1313 | |
1314 DllExport int * | |
1315 win32_errno(void) | |
1316 { | |
1317 return (&errno); | |
1318 } | |
1319 | |
1320 DllExport char *** | |
1321 win32_environ(void) | |
1322 { | |
1323 return (&(environ)); | |
1324 } | |
1325 | |
1326 /* the rest are the remapped stdio routines */ | |
1327 DllExport FILE * | |
1328 win32_stderr(void) | |
1329 { | |
1330 return (stderr); | |
1331 } | |
1332 | |
1333 char *g_getlogin() { | |
1334 return "no-getlogin"; | |
1335 } | |
1336 | |
1337 DllExport FILE * | |
1338 win32_stdin(void) | |
1339 { | |
1340 return (stdin); | |
1341 } | |
1342 | |
1343 DllExport FILE * | |
1344 win32_stdout() | |
1345 { | |
1346 return (stdout); | |
1347 } | |
1348 | |
1349 DllExport int | |
1350 win32_ferror(FILE *fp) | |
1351 { | |
1352 return (ferror(fp)); | |
1353 } | |
1354 | |
1355 | |
1356 DllExport int | |
1357 win32_feof(FILE *fp) | |
1358 { | |
1359 return (feof(fp)); | |
1360 } | |
1361 | |
1362 /* | |
1363 * Since the errors returned by the socket error function | |
1364 * WSAGetLastError() are not known by the library routine strerror | |
1365 * we have to roll our own. | |
1366 */ | |
1367 | |
1368 DllExport char * | |
1369 win32_strerror(int e) | |
1370 { | |
1371 return xcestrerror(e); | |
1372 } | |
1373 | |
1374 DllExport void | |
1375 win32_str_os_error(void *sv, DWORD dwErr) | |
1376 { | |
1377 dTHX; | |
1378 | |
1379 sv_setpvn((SV*)sv, "Error", 5); | |
1380 } | |
1381 | |
1382 | |
1383 DllExport int | |
1384 win32_fprintf(FILE *fp, const char *format, ...) | |
1385 { | |
1386 va_list marker; | |
1387 va_start(marker, format); /* Initialize variable arguments. */ | |
1388 | |
1389 return (vfprintf(fp, format, marker)); | |
1390 } | |
1391 | |
1392 DllExport int | |
1393 win32_printf(const char *format, ...) | |
1394 { | |
1395 va_list marker; | |
1396 va_start(marker, format); /* Initialize variable arguments. */ | |
1397 | |
1398 return (vprintf(format, marker)); | |
1399 } | |
1400 | |
1401 DllExport int | |
1402 win32_vfprintf(FILE *fp, const char *format, va_list args) | |
1403 { | |
1404 return (vfprintf(fp, format, args)); | |
1405 } | |
1406 | |
1407 DllExport int | |
1408 win32_vprintf(const char *format, va_list args) | |
1409 { | |
1410 return (vprintf(format, args)); | |
1411 } | |
1412 | |
1413 DllExport size_t | |
1414 win32_fread(void *buf, size_t size, size_t count, FILE *fp) | |
1415 { | |
1416 return fread(buf, size, count, fp); | |
1417 } | |
1418 | |
1419 DllExport size_t | |
1420 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) | |
1421 { | |
1422 return fwrite(buf, size, count, fp); | |
1423 } | |
1424 | |
1425 DllExport FILE * | |
1426 win32_fopen(const char *filename, const char *mode) | |
1427 { | |
1428 return xcefopen(filename, mode); | |
1429 } | |
1430 | |
1431 DllExport FILE * | |
1432 win32_fdopen(int handle, const char *mode) | |
1433 { | |
1434 return palm_fdopen(handle, mode); | |
1435 } | |
1436 | |
1437 DllExport FILE * | |
1438 win32_freopen(const char *path, const char *mode, FILE *stream) | |
1439 { | |
1440 return xcefreopen(path, mode, stream); | |
1441 } | |
1442 | |
1443 DllExport int | |
1444 win32_fclose(FILE *pf) | |
1445 { | |
1446 return xcefclose(pf); | |
1447 } | |
1448 | |
1449 DllExport int | |
1450 win32_fputs(const char *s,FILE *pf) | |
1451 { | |
1452 return fputs(s, pf); | |
1453 } | |
1454 | |
1455 DllExport int | |
1456 win32_fputc(int c,FILE *pf) | |
1457 { | |
1458 return fputc(c,pf); | |
1459 } | |
1460 | |
1461 DllExport int | |
1462 win32_ungetc(int c,FILE *pf) | |
1463 { | |
1464 return ungetc(c,pf); | |
1465 } | |
1466 | |
1467 DllExport int | |
1468 win32_getc(FILE *pf) | |
1469 { | |
1470 return getc(pf); | |
1471 } | |
1472 | |
1473 DllExport int | |
1474 win32_fileno(FILE *pf) | |
1475 { | |
1476 return palm_fileno(pf); | |
1477 } | |
1478 | |
1479 DllExport void | |
1480 win32_clearerr(FILE *pf) | |
1481 { | |
1482 clearerr(pf); | |
1483 return; | |
1484 } | |
1485 | |
1486 DllExport int | |
1487 win32_fflush(FILE *pf) | |
1488 { | |
1489 return fflush(pf); | |
1490 } | |
1491 | |
1492 DllExport long | |
1493 win32_ftell(FILE *pf) | |
1494 { | |
1495 return ftell(pf); | |
1496 } | |
1497 | |
1498 DllExport int | |
1499 win32_fseek(FILE *pf, Off_t offset,int origin) | |
1500 { | |
1501 return fseek(pf, offset, origin); | |
1502 } | |
1503 | |
1504 /* fpos_t seems to be int64 on hpc pro! Really stupid. */ | |
1505 /* But maybe someday there will be such large disks in a hpc... */ | |
1506 DllExport int | |
1507 win32_fgetpos(FILE *pf, fpos_t *p) | |
1508 { | |
1509 return fgetpos(pf, p); | |
1510 } | |
1511 | |
1512 DllExport int | |
1513 win32_fsetpos(FILE *pf, const fpos_t *p) | |
1514 { | |
1515 return fsetpos(pf, p); | |
1516 } | |
1517 | |
1518 DllExport void | |
1519 win32_rewind(FILE *pf) | |
1520 { | |
1521 fseek(pf, 0, SEEK_SET); | |
1522 return; | |
1523 } | |
1524 | |
1525 DllExport int | |
1526 win32_tmpfd(void) | |
1527 { | |
1528 dTHX; | |
1529 char prefix[MAX_PATH+1]; | |
1530 char filename[MAX_PATH+1]; | |
1531 DWORD len = GetTempPath(MAX_PATH, prefix); | |
1532 if (len && len < MAX_PATH) { | |
1533 if (GetTempFileName(prefix, "plx", 0, filename)) { | |
1534 HANDLE fh = CreateFile(filename, | |
1535 DELETE | GENERIC_READ | GENERIC_WRITE, | |
1536 0, | |
1537 NULL, | |
1538 CREATE_ALWAYS, | |
1539 FILE_ATTRIBUTE_NORMAL | |
1540 | FILE_FLAG_DELETE_ON_CLOSE, | |
1541 NULL); | |
1542 if (fh != INVALID_HANDLE_VALUE) { | |
1543 int fd = win32_open_osfhandle((intptr_t)fh, 0); | |
1544 if (fd >= 0) { | |
1545 DEBUG_p(PerlIO_printf(Perl_debug_log, | |
1546 "Created tmpfile=%s\n",filename)); | |
1547 return fd; | |
1548 } | |
1549 } | |
1550 } | |
1551 } | |
1552 return -1; | |
1553 } | |
1554 | |
1555 DllExport FILE* | |
1556 win32_tmpfile(void) | |
1557 { | |
1558 int fd = win32_tmpfd(); | |
1559 if (fd >= 0) | |
1560 return win32_fdopen(fd, "w+b"); | |
1561 return NULL; | |
1562 } | |
1563 | |
1564 DllExport void | |
1565 win32_abort(void) | |
1566 { | |
1567 xceabort(); | |
1568 | |
1569 return; | |
1570 } | |
1571 | |
1572 DllExport int | |
1573 win32_fstat(int fd, struct stat *sbufptr) | |
1574 { | |
1575 return xcefstat(fd, sbufptr); | |
1576 } | |
1577 | |
1578 DllExport int | |
1579 win32_link(const char *oldname, const char *newname) | |
1580 { | |
1581 dTHX; | |
1582 Perl_croak(aTHX_ PL_no_func, "link"); | |
1583 | |
1584 return -1; | |
1585 } | |
1586 | |
1587 DllExport int | |
1588 win32_rename(const char *oname, const char *newname) | |
1589 { | |
1590 return xcerename(oname, newname); | |
1591 } | |
1592 | |
1593 DllExport int | |
1594 win32_setmode(int fd, int mode) | |
1595 { | |
1596 /* currently 'celib' seem to have this function in src, but not | |
1597 * exported. When it will be, we'll uncomment following line. | |
1598 */ | |
1599 /* return xcesetmode(fd, mode); */ | |
1600 return 0; | |
1601 } | |
1602 | |
1603 DllExport int | |
1604 win32_chsize(int fd, Off_t size) | |
1605 { | |
1606 return chsize(fd, size); | |
1607 } | |
1608 | |
1609 DllExport long | |
1610 win32_lseek(int fd, Off_t offset, int origin) | |
1611 { | |
1612 return xcelseek(fd, offset, origin); | |
1613 } | |
1614 | |
1615 DllExport long | |
1616 win32_tell(int fd) | |
1617 { | |
1618 return xcelseek(fd, 0, SEEK_CUR); | |
1619 } | |
1620 | |
1621 DllExport int | |
1622 win32_open(const char *path, int flag, ...) | |
1623 { | |
1624 int pmode; | |
1625 va_list ap; | |
1626 | |
1627 va_start(ap, flag); | |
1628 pmode = va_arg(ap, int); | |
1629 va_end(ap); | |
1630 | |
1631 return xceopen(path, flag, pmode); | |
1632 } | |
1633 | |
1634 DllExport int | |
1635 win32_close(int fd) | |
1636 { | |
1637 return xceclose(fd); | |
1638 } | |
1639 | |
1640 DllExport int | |
1641 win32_eof(int fd) | |
1642 { | |
1643 dTHX; | |
1644 Perl_croak(aTHX_ PL_no_func, "eof"); | |
1645 return -1; | |
1646 } | |
1647 | |
1648 DllExport int | |
1649 win32_dup(int fd) | |
1650 { | |
1651 return xcedup(fd); /* from celib/ceio.c; requires some more work on it */ | |
1652 } | |
1653 | |
1654 DllExport int | |
1655 win32_dup2(int fd1,int fd2) | |
1656 { | |
1657 return xcedup2(fd1,fd2); | |
1658 } | |
1659 | |
1660 DllExport int | |
1661 win32_read(int fd, void *buf, unsigned int cnt) | |
1662 { | |
1663 return xceread(fd, buf, cnt); | |
1664 } | |
1665 | |
1666 DllExport int | |
1667 win32_write(int fd, const void *buf, unsigned int cnt) | |
1668 { | |
1669 return xcewrite(fd, (void *) buf, cnt); | |
1670 } | |
1671 | |
1672 DllExport int | |
1673 win32_mkdir(const char *dir, int mode) | |
1674 { | |
1675 return xcemkdir(dir); | |
1676 } | |
1677 | |
1678 DllExport int | |
1679 win32_rmdir(const char *dir) | |
1680 { | |
1681 return xcermdir(dir); | |
1682 } | |
1683 | |
1684 DllExport int | |
1685 win32_chdir(const char *dir) | |
1686 { | |
1687 return xcechdir(dir); | |
1688 } | |
1689 | |
1690 DllExport int | |
1691 win32_access(const char *path, int mode) | |
1692 { | |
1693 return xceaccess(path, mode); | |
1694 } | |
1695 | |
1696 DllExport int | |
1697 win32_chmod(const char *path, int mode) | |
1698 { | |
1699 return xcechmod(path, mode); | |
1700 } | |
1701 | |
1702 static char * | |
1703 create_command_line(char *cname, STRLEN clen, const char * const *args) | |
1704 { | |
1705 dTHX; | |
1706 int index, argc; | |
1707 char *cmd, *ptr; | |
1708 const char *arg; | |
1709 STRLEN len = 0; | |
1710 bool bat_file = FALSE; | |
1711 bool cmd_shell = FALSE; | |
1712 bool dumb_shell = FALSE; | |
1713 bool extra_quotes = FALSE; | |
1714 bool quote_next = FALSE; | |
1715 | |
1716 if (!cname) | |
1717 cname = (char*)args[0]; | |
1718 | |
1719 /* The NT cmd.exe shell has the following peculiarity that needs to be | |
1720 * worked around. It strips a leading and trailing dquote when any | |
1721 * of the following is true: | |
1722 * 1. the /S switch was used | |
1723 * 2. there are more than two dquotes | |
1724 * 3. there is a special character from this set: &<>()@^| | |
1725 * 4. no whitespace characters within the two dquotes | |
1726 * 5. string between two dquotes isn't an executable file | |
1727 * To work around this, we always add a leading and trailing dquote | |
1728 * to the string, if the first argument is either "cmd.exe" or "cmd", | |
1729 * and there were at least two or more arguments passed to cmd.exe | |
1730 * (not including switches). | |
1731 * XXX the above rules (from "cmd /?") don't seem to be applied | |
1732 * always, making for the convolutions below :-( | |
1733 */ | |
1734 if (cname) { | |
1735 if (!clen) | |
1736 clen = strlen(cname); | |
1737 | |
1738 if (clen > 4 | |
1739 && (stricmp(&cname[clen-4], ".bat") == 0 | |
1740 || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0))) | |
1741 { | |
1742 bat_file = TRUE; | |
1743 len += 3; | |
1744 } | |
1745 else { | |
1746 char *exe = strrchr(cname, '/'); | |
1747 char *exe2 = strrchr(cname, '\\'); | |
1748 if (exe2 > exe) | |
1749 exe = exe2; | |
1750 if (exe) | |
1751 ++exe; | |
1752 else | |
1753 exe = cname; | |
1754 if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) { | |
1755 cmd_shell = TRUE; | |
1756 len += 3; | |
1757 } | |
1758 else if (stricmp(exe, "command.com") == 0 | |
1759 || stricmp(exe, "command") == 0) | |
1760 { | |
1761 dumb_shell = TRUE; | |
1762 } | |
1763 } | |
1764 } | |
1765 | |
1766 DEBUG_p(PerlIO_printf(Perl_debug_log, "Args ")); | |
1767 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { | |
1768 STRLEN curlen = strlen(arg); | |
1769 if (!(arg[0] == '"' && arg[curlen-1] == '"')) | |
1770 len += 2; /* assume quoting needed (worst case) */ | |
1771 len += curlen + 1; | |
1772 DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg)); | |
1773 } | |
1774 DEBUG_p(PerlIO_printf(Perl_debug_log, "\n")); | |
1775 | |
1776 argc = index; | |
1777 Newx(cmd, len, char); | |
1778 ptr = cmd; | |
1779 | |
1780 if (bat_file) { | |
1781 *ptr++ = '"'; | |
1782 extra_quotes = TRUE; | |
1783 } | |
1784 | |
1785 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { | |
1786 bool do_quote = 0; | |
1787 STRLEN curlen = strlen(arg); | |
1788 | |
1789 /* we want to protect empty arguments and ones with spaces with | |
1790 * dquotes, but only if they aren't already there */ | |
1791 if (!dumb_shell) { | |
1792 if (!curlen) { | |
1793 do_quote = 1; | |
1794 } | |
1795 else if (quote_next) { | |
1796 /* see if it really is multiple arguments pretending to | |
1797 * be one and force a set of quotes around it */ | |
1798 if (*find_next_space(arg)) | |
1799 do_quote = 1; | |
1800 } | |
1801 else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) { | |
1802 STRLEN i = 0; | |
1803 while (i < curlen) { | |
1804 if (isSPACE(arg[i])) { | |
1805 do_quote = 1; | |
1806 } | |
1807 else if (arg[i] == '"') { | |
1808 do_quote = 0; | |
1809 break; | |
1810 } | |
1811 i++; | |
1812 } | |
1813 } | |
1814 } | |
1815 | |
1816 if (do_quote) | |
1817 *ptr++ = '"'; | |
1818 | |
1819 strcpy(ptr, arg); | |
1820 ptr += curlen; | |
1821 | |
1822 if (do_quote) | |
1823 *ptr++ = '"'; | |
1824 | |
1825 if (args[index+1]) | |
1826 *ptr++ = ' '; | |
1827 | |
1828 if (!extra_quotes | |
1829 && cmd_shell | |
1830 && curlen >= 2 | |
1831 && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */ | |
1832 && stricmp(arg+curlen-2, "/c") == 0) | |
1833 { | |
1834 /* is there a next argument? */ | |
1835 if (args[index+1]) { | |
1836 /* are there two or more next arguments? */ | |
1837 if (args[index+2]) { | |
1838 *ptr++ = '"'; | |
1839 extra_quotes = TRUE; | |
1840 } | |
1841 else { | |
1842 /* single argument, force quoting if it has spaces */ | |
1843 quote_next = TRUE; | |
1844 } | |
1845 } | |
1846 } | |
1847 } | |
1848 | |
1849 if (extra_quotes) | |
1850 *ptr++ = '"'; | |
1851 | |
1852 *ptr = '\0'; | |
1853 | |
1854 return cmd; | |
1855 } | |
1856 | |
1857 static char * | |
1858 qualified_path(const char *cmd) | |
1859 { | |
1860 dTHX; | |
1861 char *pathstr; | |
1862 char *fullcmd, *curfullcmd; | |
1863 STRLEN cmdlen = 0; | |
1864 int has_slash = 0; | |
1865 | |
1866 if (!cmd) | |
1867 return NULL; | |
1868 fullcmd = (char*)cmd; | |
1869 while (*fullcmd) { | |
1870 if (*fullcmd == '/' || *fullcmd == '\\') | |
1871 has_slash++; | |
1872 fullcmd++; | |
1873 cmdlen++; | |
1874 } | |
1875 | |
1876 /* look in PATH */ | |
1877 pathstr = PerlEnv_getenv("PATH"); | |
1878 Newx(fullcmd, MAX_PATH+1, char); | |
1879 curfullcmd = fullcmd; | |
1880 | |
1881 while (1) { | |
1882 DWORD res; | |
1883 | |
1884 /* start by appending the name to the current prefix */ | |
1885 strcpy(curfullcmd, cmd); | |
1886 curfullcmd += cmdlen; | |
1887 | |
1888 /* if it doesn't end with '.', or has no extension, try adding | |
1889 * a trailing .exe first */ | |
1890 if (cmd[cmdlen-1] != '.' | |
1891 && (cmdlen < 4 || cmd[cmdlen-4] != '.')) | |
1892 { | |
1893 strcpy(curfullcmd, ".exe"); | |
1894 res = GetFileAttributes(fullcmd); | |
1895 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) | |
1896 return fullcmd; | |
1897 *curfullcmd = '\0'; | |
1898 } | |
1899 | |
1900 /* that failed, try the bare name */ | |
1901 res = GetFileAttributes(fullcmd); | |
1902 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) | |
1903 return fullcmd; | |
1904 | |
1905 /* quit if no other path exists, or if cmd already has path */ | |
1906 if (!pathstr || !*pathstr || has_slash) | |
1907 break; | |
1908 | |
1909 /* skip leading semis */ | |
1910 while (*pathstr == ';') | |
1911 pathstr++; | |
1912 | |
1913 /* build a new prefix from scratch */ | |
1914 curfullcmd = fullcmd; | |
1915 while (*pathstr && *pathstr != ';') { | |
1916 if (*pathstr == '"') { /* foo;"baz;etc";bar */ | |
1917 pathstr++; /* skip initial '"' */ | |
1918 while (*pathstr && *pathstr != '"') { | |
1919 if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5) | |
1920 *curfullcmd++ = *pathstr; | |
1921 pathstr++; | |
1922 } | |
1923 if (*pathstr) | |
1924 pathstr++; /* skip trailing '"' */ | |
1925 } | |
1926 else { | |
1927 if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5) | |
1928 *curfullcmd++ = *pathstr; | |
1929 pathstr++; | |
1930 } | |
1931 } | |
1932 if (*pathstr) | |
1933 pathstr++; /* skip trailing semi */ | |
1934 if (curfullcmd > fullcmd /* append a dir separator */ | |
1935 && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\') | |
1936 { | |
1937 *curfullcmd++ = '\\'; | |
1938 } | |
1939 } | |
1940 | |
1941 Safefree(fullcmd); | |
1942 return NULL; | |
1943 } | |
1944 | |
1945 /* The following are just place holders. | |
1946 * Some hosts may provide and environment that the OS is | |
1947 * not tracking, therefore, these host must provide that | |
1948 * environment and the current directory to CreateProcess | |
1949 */ | |
1950 | |
1951 DllExport void* | |
1952 win32_get_childenv(void) | |
1953 { | |
1954 return NULL; | |
1955 } | |
1956 | |
1957 DllExport void | |
1958 win32_free_childenv(void* d) | |
1959 { | |
1960 } | |
1961 | |
1962 DllExport void | |
1963 win32_clearenv(void) | |
1964 { | |
1965 char *envv = GetEnvironmentStrings(); | |
1966 char *cur = envv; | |
1967 STRLEN len; | |
1968 while (*cur) { | |
1969 char *end = strchr(cur,'='); | |
1970 if (end && end != cur) { | |
1971 *end = '\0'; | |
1972 xcesetenv(cur, "", 0); | |
1973 *end = '='; | |
1974 cur = end + strlen(end+1)+2; | |
1975 } | |
1976 else if ((len = strlen(cur))) | |
1977 cur += len+1; | |
1978 } | |
1979 FreeEnvironmentStrings(envv); | |
1980 } | |
1981 | |
1982 DllExport char* | |
1983 win32_get_childdir(void) | |
1984 { | |
1985 dTHX; | |
1986 char* ptr; | |
1987 char szfilename[MAX_PATH+1]; | |
1988 GetCurrentDirectoryA(MAX_PATH+1, szfilename); | |
1989 | |
1990 Newx(ptr, strlen(szfilename)+1, char); | |
1991 strcpy(ptr, szfilename); | |
1992 return ptr; | |
1993 } | |
1994 | |
1995 DllExport void | |
1996 win32_free_childdir(char* d) | |
1997 { | |
1998 dTHX; | |
1999 Safefree(d); | |
2000 } | |
2001 | |
2002 /* XXX this needs to be made more compatible with the spawnvp() | |
2003 * provided by the various RTLs. In particular, searching for | |
2004 * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented. | |
2005 * This doesn't significantly affect perl itself, because we | |
2006 * always invoke things using PERL5SHELL if a direct attempt to | |
2007 * spawn the executable fails. | |
2008 * | |
2009 * XXX splitting and rejoining the commandline between do_aspawn() | |
2010 * and win32_spawnvp() could also be avoided. | |
2011 */ | |
2012 | |
2013 DllExport int | |
2014 win32_spawnvp(int mode, const char *cmdname, const char *const *argv) | |
2015 { | |
2016 #ifdef USE_RTL_SPAWNVP | |
2017 return spawnvp(mode, cmdname, (char * const *)argv); | |
2018 #else | |
2019 dTHX; | |
2020 int ret; | |
2021 void* env; | |
2022 char* dir; | |
2023 child_IO_table tbl; | |
2024 STARTUPINFO StartupInfo; | |
2025 PROCESS_INFORMATION ProcessInformation; | |
2026 DWORD create = 0; | |
2027 char *cmd; | |
2028 char *fullcmd = NULL; | |
2029 char *cname = (char *)cmdname; | |
2030 STRLEN clen = 0; | |
2031 | |
2032 if (cname) { | |
2033 clen = strlen(cname); | |
2034 /* if command name contains dquotes, must remove them */ | |
2035 if (strchr(cname, '"')) { | |
2036 cmd = cname; | |
2037 Newx(cname,clen+1,char); | |
2038 clen = 0; | |
2039 while (*cmd) { | |
2040 if (*cmd != '"') { | |
2041 cname[clen] = *cmd; | |
2042 ++clen; | |
2043 } | |
2044 ++cmd; | |
2045 } | |
2046 cname[clen] = '\0'; | |
2047 } | |
2048 } | |
2049 | |
2050 cmd = create_command_line(cname, clen, argv); | |
2051 | |
2052 env = PerlEnv_get_childenv(); | |
2053 dir = PerlEnv_get_childdir(); | |
2054 | |
2055 switch(mode) { | |
2056 case P_NOWAIT: /* asynch + remember result */ | |
2057 if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) { | |
2058 errno = EAGAIN; | |
2059 ret = -1; | |
2060 goto RETVAL; | |
2061 } | |
2062 /* Create a new process group so we can use GenerateConsoleCtrlEvent() | |
2063 * in win32_kill() | |
2064 */ | |
2065 /* not supported on CE create |= CREATE_NEW_PROCESS_GROUP; */ | |
2066 /* FALL THROUGH */ | |
2067 | |
2068 case P_WAIT: /* synchronous execution */ | |
2069 break; | |
2070 default: /* invalid mode */ | |
2071 errno = EINVAL; | |
2072 ret = -1; | |
2073 goto RETVAL; | |
2074 } | |
2075 memset(&StartupInfo,0,sizeof(StartupInfo)); | |
2076 StartupInfo.cb = sizeof(StartupInfo); | |
2077 memset(&tbl,0,sizeof(tbl)); | |
2078 PerlEnv_get_child_IO(&tbl); | |
2079 StartupInfo.dwFlags = tbl.dwFlags; | |
2080 StartupInfo.dwX = tbl.dwX; | |
2081 StartupInfo.dwY = tbl.dwY; | |
2082 StartupInfo.dwXSize = tbl.dwXSize; | |
2083 StartupInfo.dwYSize = tbl.dwYSize; | |
2084 StartupInfo.dwXCountChars = tbl.dwXCountChars; | |
2085 StartupInfo.dwYCountChars = tbl.dwYCountChars; | |
2086 StartupInfo.dwFillAttribute = tbl.dwFillAttribute; | |
2087 StartupInfo.wShowWindow = tbl.wShowWindow; | |
2088 StartupInfo.hStdInput = tbl.childStdIn; | |
2089 StartupInfo.hStdOutput = tbl.childStdOut; | |
2090 StartupInfo.hStdError = tbl.childStdErr; | |
2091 if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE && | |
2092 StartupInfo.hStdOutput == INVALID_HANDLE_VALUE && | |
2093 StartupInfo.hStdError == INVALID_HANDLE_VALUE) | |
2094 { | |
2095 create |= CREATE_NEW_CONSOLE; | |
2096 } | |
2097 else { | |
2098 StartupInfo.dwFlags |= STARTF_USESTDHANDLES; | |
2099 } | |
2100 if (w32_use_showwindow) { | |
2101 StartupInfo.dwFlags |= STARTF_USESHOWWINDOW; | |
2102 StartupInfo.wShowWindow = w32_showwindow; | |
2103 } | |
2104 | |
2105 DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n", | |
2106 cname,cmd)); | |
2107 RETRY: | |
2108 if (!CreateProcess(cname, /* search PATH to find executable */ | |
2109 cmd, /* executable, and its arguments */ | |
2110 NULL, /* process attributes */ | |
2111 NULL, /* thread attributes */ | |
2112 TRUE, /* inherit handles */ | |
2113 create, /* creation flags */ | |
2114 (LPVOID)env, /* inherit environment */ | |
2115 dir, /* inherit cwd */ | |
2116 &StartupInfo, | |
2117 &ProcessInformation)) | |
2118 { | |
2119 /* initial NULL argument to CreateProcess() does a PATH | |
2120 * search, but it always first looks in the directory | |
2121 * where the current process was started, which behavior | |
2122 * is undesirable for backward compatibility. So we | |
2123 * jump through our own hoops by picking out the path | |
2124 * we really want it to use. */ | |
2125 if (!fullcmd) { | |
2126 fullcmd = qualified_path(cname); | |
2127 if (fullcmd) { | |
2128 if (cname != cmdname) | |
2129 Safefree(cname); | |
2130 cname = fullcmd; | |
2131 DEBUG_p(PerlIO_printf(Perl_debug_log, | |
2132 "Retrying [%s] with same args\n", | |
2133 cname)); | |
2134 goto RETRY; | |
2135 } | |
2136 } | |
2137 errno = ENOENT; | |
2138 ret = -1; | |
2139 goto RETVAL; | |
2140 } | |
2141 | |
2142 if (mode == P_NOWAIT) { | |
2143 /* asynchronous spawn -- store handle, return PID */ | |
2144 ret = (int)ProcessInformation.dwProcessId; | |
2145 if (IsWin95() && ret < 0) | |
2146 ret = -ret; | |
2147 | |
2148 w32_child_handles[w32_num_children] = ProcessInformation.hProcess; | |
2149 w32_child_pids[w32_num_children] = (DWORD)ret; | |
2150 ++w32_num_children; | |
2151 } | |
2152 else { | |
2153 DWORD status; | |
2154 win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL); | |
2155 /* FIXME: if msgwait returned due to message perhaps forward the | |
2156 "signal" to the process | |
2157 */ | |
2158 GetExitCodeProcess(ProcessInformation.hProcess, &status); | |
2159 ret = (int)status; | |
2160 CloseHandle(ProcessInformation.hProcess); | |
2161 } | |
2162 | |
2163 CloseHandle(ProcessInformation.hThread); | |
2164 | |
2165 RETVAL: | |
2166 PerlEnv_free_childenv(env); | |
2167 PerlEnv_free_childdir(dir); | |
2168 Safefree(cmd); | |
2169 if (cname != cmdname) | |
2170 Safefree(cname); | |
2171 return ret; | |
2172 #endif | |
2173 } | |
2174 | |
2175 DllExport int | |
2176 win32_execv(const char *cmdname, const char *const *argv) | |
2177 { | |
2178 dTHX; | |
2179 Perl_croak(aTHX_ PL_no_func, "execv"); | |
2180 return -1; | |
2181 } | |
2182 | |
2183 DllExport int | |
2184 win32_execvp(const char *cmdname, const char *const *argv) | |
2185 { | |
2186 dTHX; | |
2187 Perl_croak(aTHX_ PL_no_func, "execvp"); | |
2188 return -1; | |
2189 } | |
2190 | |
2191 DllExport void | |
2192 win32_perror(const char *str) | |
2193 { | |
2194 xceperror(str); | |
2195 } | |
2196 | |
2197 DllExport void | |
2198 win32_setbuf(FILE *pf, char *buf) | |
2199 { | |
2200 dTHX; | |
2201 Perl_croak(aTHX_ PL_no_func, "setbuf"); | |
2202 } | |
2203 | |
2204 DllExport int | |
2205 win32_setvbuf(FILE *pf, char *buf, int type, size_t size) | |
2206 { | |
2207 return setvbuf(pf, buf, type, size); | |
2208 } | |
2209 | |
2210 DllExport int | |
2211 win32_flushall(void) | |
2212 { | |
2213 return flushall(); | |
2214 } | |
2215 | |
2216 DllExport int | |
2217 win32_fcloseall(void) | |
2218 { | |
2219 return fcloseall(); | |
2220 } | |
2221 | |
2222 DllExport char* | |
2223 win32_fgets(char *s, int n, FILE *pf) | |
2224 { | |
2225 return fgets(s, n, pf); | |
2226 } | |
2227 | |
2228 DllExport char* | |
2229 win32_gets(char *s) | |
2230 { | |
2231 return gets(s); | |
2232 } | |
2233 | |
2234 DllExport int | |
2235 win32_fgetc(FILE *pf) | |
2236 { | |
2237 return fgetc(pf); | |
2238 } | |
2239 | |
2240 DllExport int | |
2241 win32_putc(int c, FILE *pf) | |
2242 { | |
2243 return putc(c,pf); | |
2244 } | |
2245 | |
2246 DllExport int | |
2247 win32_puts(const char *s) | |
2248 { | |
2249 return puts(s); | |
2250 } | |
2251 | |
2252 DllExport int | |
2253 win32_getchar(void) | |
2254 { | |
2255 return getchar(); | |
2256 } | |
2257 | |
2258 DllExport int | |
2259 win32_putchar(int c) | |
2260 { | |
2261 return putchar(c); | |
2262 } | |
2263 | |
2264 #ifdef MYMALLOC | |
2265 | |
2266 #ifndef USE_PERL_SBRK | |
2267 | |
2268 static char *committed = NULL; | |
2269 static char *base = NULL; | |
2270 static char *reserved = NULL; | |
2271 static char *brk = NULL; | |
2272 static DWORD pagesize = 0; | |
2273 static DWORD allocsize = 0; | |
2274 | |
2275 void * | |
2276 sbrk(int need) | |
2277 { | |
2278 void *result; | |
2279 if (!pagesize) | |
2280 {SYSTEM_INFO info; | |
2281 GetSystemInfo(&info); | |
2282 /* Pretend page size is larger so we don't perpetually | |
2283 * call the OS to commit just one page ... | |
2284 */ | |
2285 pagesize = info.dwPageSize << 3; | |
2286 allocsize = info.dwAllocationGranularity; | |
2287 } | |
2288 /* This scheme fails eventually if request for contiguous | |
2289 * block is denied so reserve big blocks - this is only | |
2290 * address space not memory ... | |
2291 */ | |
2292 if (brk+need >= reserved) | |
2293 { | |
2294 DWORD size = 64*1024*1024; | |
2295 char *addr; | |
2296 if (committed && reserved && committed < reserved) | |
2297 { | |
2298 /* Commit last of previous chunk cannot span allocations */ | |
2299 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE); | |
2300 if (addr) | |
2301 committed = reserved; | |
2302 } | |
2303 /* Reserve some (more) space | |
2304 * Note this is a little sneaky, 1st call passes NULL as reserved | |
2305 * so lets system choose where we start, subsequent calls pass | |
2306 * the old end address so ask for a contiguous block | |
2307 */ | |
2308 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS); | |
2309 if (addr) | |
2310 { | |
2311 reserved = addr+size; | |
2312 if (!base) | |
2313 base = addr; | |
2314 if (!committed) | |
2315 committed = base; | |
2316 if (!brk) | |
2317 brk = committed; | |
2318 } | |
2319 else | |
2320 { | |
2321 return (void *) -1; | |
2322 } | |
2323 } | |
2324 result = brk; | |
2325 brk += need; | |
2326 if (brk > committed) | |
2327 { | |
2328 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize; | |
2329 char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); | |
2330 if (addr) | |
2331 { | |
2332 committed += size; | |
2333 } | |
2334 else | |
2335 return (void *) -1; | |
2336 } | |
2337 return result; | |
2338 } | |
2339 | |
2340 #endif | |
2341 #endif | |
2342 | |
2343 DllExport void* | |
2344 win32_malloc(size_t size) | |
2345 { | |
2346 return malloc(size); | |
2347 } | |
2348 | |
2349 DllExport void* | |
2350 win32_calloc(size_t numitems, size_t size) | |
2351 { | |
2352 return calloc(numitems,size); | |
2353 } | |
2354 | |
2355 DllExport void* | |
2356 win32_realloc(void *block, size_t size) | |
2357 { | |
2358 return realloc(block,size); | |
2359 } | |
2360 | |
2361 DllExport void | |
2362 win32_free(void *block) | |
2363 { | |
2364 free(block); | |
2365 } | |
2366 | |
2367 int | |
2368 win32_open_osfhandle(intptr_t osfhandle, int flags) | |
2369 { | |
2370 int fh; | |
2371 char fileflags=0; /* _osfile flags */ | |
2372 | |
2373 Perl_croak_nocontext("win32_open_osfhandle() TBD on this platform"); | |
2374 return 0; | |
2375 } | |
2376 | |
2377 int | |
2378 win32_get_osfhandle(int fd) | |
2379 { | |
2380 int fh; | |
2381 char fileflags=0; /* _osfile flags */ | |
2382 | |
2383 Perl_croak_nocontext("win32_get_osfhandle() TBD on this platform"); | |
2384 return 0; | |
2385 } | |
2386 | |
2387 FILE * | |
2388 win32_fdupopen(FILE *pf) | |
2389 { | |
2390 FILE* pfdup; | |
2391 fpos_t pos; | |
2392 char mode[3]; | |
2393 int fileno = win32_dup(win32_fileno(pf)); | |
2394 int fmode = palm_fgetmode(pfdup); | |
2395 | |
2396 fprintf(stderr,"DEBUG for win32_fdupopen()\n"); | |
2397 | |
2398 /* open the file in the same mode */ | |
2399 if(fmode & O_RDONLY) { | |
2400 mode[0] = 'r'; | |
2401 mode[1] = 0; | |
2402 } | |
2403 else if(fmode & O_APPEND) { | |
2404 mode[0] = 'a'; | |
2405 mode[1] = 0; | |
2406 } | |
2407 else if(fmode & O_RDWR) { | |
2408 mode[0] = 'r'; | |
2409 mode[1] = '+'; | |
2410 mode[2] = 0; | |
2411 } | |
2412 | |
2413 /* it appears that the binmode is attached to the | |
2414 * file descriptor so binmode files will be handled | |
2415 * correctly | |
2416 */ | |
2417 pfdup = win32_fdopen(fileno, mode); | |
2418 | |
2419 /* move the file pointer to the same position */ | |
2420 if (!fgetpos(pf, &pos)) { | |
2421 fsetpos(pfdup, &pos); | |
2422 } | |
2423 return pfdup; | |
2424 } | |
2425 | |
2426 DllExport void* | |
2427 win32_dynaload(const char* filename) | |
2428 { | |
2429 dTHX; | |
2430 HMODULE hModule; | |
2431 | |
2432 hModule = XCELoadLibraryA(filename); | |
2433 | |
2434 return hModule; | |
2435 } | |
2436 | |
2437 /* this is needed by Cwd.pm... */ | |
2438 | |
2439 static | |
2440 XS(w32_GetCwd) | |
2441 { | |
2442 dXSARGS; | |
2443 char buf[MAX_PATH]; | |
2444 SV *sv = sv_newmortal(); | |
2445 | |
2446 xcegetcwd(buf, sizeof(buf)); | |
2447 | |
2448 sv_setpv(sv, xcestrdup(buf)); | |
2449 EXTEND(SP,1); | |
2450 SvPOK_on(sv); | |
2451 ST(0) = sv; | |
2452 SvTAINTED_on(ST(0)); | |
2453 XSRETURN(1); | |
2454 } | |
2455 | |
2456 static | |
2457 XS(w32_SetCwd) | |
2458 { | |
2459 dXSARGS; | |
2460 | |
2461 if (items != 1) | |
2462 Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)"); | |
2463 | |
2464 if (!xcechdir(SvPV_nolen(ST(0)))) | |
2465 XSRETURN_YES; | |
2466 | |
2467 XSRETURN_NO; | |
2468 } | |
2469 | |
2470 static | |
2471 XS(w32_GetTickCount) | |
2472 { | |
2473 dXSARGS; | |
2474 DWORD msec = GetTickCount(); | |
2475 EXTEND(SP,1); | |
2476 if ((IV)msec > 0) | |
2477 XSRETURN_IV(msec); | |
2478 XSRETURN_NV(msec); | |
2479 } | |
2480 | |
2481 static | |
2482 XS(w32_GetOSVersion) | |
2483 { | |
2484 dXSARGS; | |
2485 OSVERSIONINFOA osver; | |
2486 | |
2487 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); | |
2488 if (!XCEGetVersionExA(&osver)) { | |
2489 XSRETURN_EMPTY; | |
2490 } | |
2491 mXPUSHp(osver.szCSDVersion, strlen(osver.szCSDVersion)); | |
2492 mXPUSHi(osver.dwMajorVersion); | |
2493 mXPUSHi(osver.dwMinorVersion); | |
2494 mXPUSHi(osver.dwBuildNumber); | |
2495 /* WINCE = 3 */ | |
2496 mXPUSHi(osver.dwPlatformId); | |
2497 PUTBACK; | |
2498 } | |
2499 | |
2500 static | |
2501 XS(w32_IsWinNT) | |
2502 { | |
2503 dXSARGS; | |
2504 EXTEND(SP,1); | |
2505 XSRETURN_IV(IsWinNT()); | |
2506 } | |
2507 | |
2508 static | |
2509 XS(w32_IsWin95) | |
2510 { | |
2511 dXSARGS; | |
2512 EXTEND(SP,1); | |
2513 XSRETURN_IV(IsWin95()); | |
2514 } | |
2515 | |
2516 static | |
2517 XS(w32_IsWinCE) | |
2518 { | |
2519 dXSARGS; | |
2520 EXTEND(SP,1); | |
2521 XSRETURN_IV(IsWinCE()); | |
2522 } | |
2523 | |
2524 static | |
2525 XS(w32_GetOemInfo) | |
2526 { | |
2527 dXSARGS; | |
2528 wchar_t wbuf[126]; | |
2529 char buf[126]; | |
2530 | |
2531 if(SystemParametersInfoW(SPI_GETOEMINFO, sizeof(wbuf), wbuf, FALSE)) | |
2532 WideCharToMultiByte(CP_ACP, 0, wbuf, -1, buf, sizeof(buf), 0, 0); | |
2533 else | |
2534 sprintf(buf, "SystemParametersInfo failed: %d", GetLastError()); | |
2535 | |
2536 EXTEND(SP,1); | |
2537 XSRETURN_PV(buf); | |
2538 } | |
2539 | |
2540 static | |
2541 XS(w32_Sleep) | |
2542 { | |
2543 dXSARGS; | |
2544 if (items != 1) | |
2545 Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)"); | |
2546 Sleep(SvIV(ST(0))); | |
2547 XSRETURN_YES; | |
2548 } | |
2549 | |
2550 static | |
2551 XS(w32_CopyFile) | |
2552 { | |
2553 dXSARGS; | |
2554 BOOL bResult; | |
2555 if (items != 3) | |
2556 Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)"); | |
2557 | |
2558 { | |
2559 char szSourceFile[MAX_PATH+1]; | |
2560 strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0)))); | |
2561 bResult = XCECopyFileA(szSourceFile, SvPV_nolen(ST(1)), | |
2562 !SvTRUE(ST(2))); | |
2563 } | |
2564 | |
2565 if (bResult) | |
2566 XSRETURN_YES; | |
2567 | |
2568 XSRETURN_NO; | |
2569 } | |
2570 | |
2571 static | |
2572 XS(w32_MessageBox) | |
2573 { | |
2574 dXSARGS; | |
2575 | |
2576 char *txt; | |
2577 unsigned int res; | |
2578 unsigned int flags = MB_OK; | |
2579 | |
2580 txt = SvPV_nolen(ST(0)); | |
2581 | |
2582 if (items < 1 || items > 2) | |
2583 Perl_croak(aTHX_ "usage: Win32::MessageBox($txt, [$flags])"); | |
2584 | |
2585 if(items == 2) | |
2586 flags = SvIV(ST(1)); | |
2587 | |
2588 res = XCEMessageBoxA(NULL, txt, "Perl", flags); | |
2589 | |
2590 XSRETURN_IV(res); | |
2591 } | |
2592 | |
2593 static | |
2594 XS(w32_GetPowerStatus) | |
2595 { | |
2596 dXSARGS; | |
2597 | |
2598 SYSTEM_POWER_STATUS_EX sps; | |
2599 | |
2600 if(GetSystemPowerStatusEx(&sps, TRUE) == FALSE) | |
2601 { | |
2602 XSRETURN_EMPTY; | |
2603 } | |
2604 | |
2605 mXPUSHi(sps.ACLineStatus); | |
2606 mXPUSHi(sps.BatteryFlag); | |
2607 mXPUSHi(sps.BatteryLifePercent); | |
2608 mXPUSHi(sps.BatteryLifeTime); | |
2609 mXPUSHi(sps.BatteryFullLifeTime); | |
2610 mXPUSHi(sps.BackupBatteryFlag); | |
2611 mXPUSHi(sps.BackupBatteryLifePercent); | |
2612 mXPUSHi(sps.BackupBatteryLifeTime); | |
2613 mXPUSHi(sps.BackupBatteryFullLifeTime); | |
2614 | |
2615 PUTBACK; | |
2616 } | |
2617 | |
2618 #if UNDER_CE > 200 | |
2619 static | |
2620 XS(w32_ShellEx) | |
2621 { | |
2622 dXSARGS; | |
2623 | |
2624 char buf[126]; | |
2625 SHELLEXECUTEINFO si; | |
2626 char *file, *verb; | |
2627 wchar_t wfile[MAX_PATH]; | |
2628 wchar_t wverb[20]; | |
2629 | |
2630 if (items != 2) | |
2631 Perl_croak(aTHX_ "usage: Win32::ShellEx($file, $verb)"); | |
2632 | |
2633 file = SvPV_nolen(ST(0)); | |
2634 verb = SvPV_nolen(ST(1)); | |
2635 | |
2636 memset(&si, 0, sizeof(si)); | |
2637 si.cbSize = sizeof(si); | |
2638 si.fMask = SEE_MASK_FLAG_NO_UI; | |
2639 | |
2640 MultiByteToWideChar(CP_ACP, 0, verb, -1, | |
2641 wverb, sizeof(wverb)/2); | |
2642 si.lpVerb = (TCHAR *)wverb; | |
2643 | |
2644 MultiByteToWideChar(CP_ACP, 0, file, -1, | |
2645 wfile, sizeof(wfile)/2); | |
2646 si.lpFile = (TCHAR *)wfile; | |
2647 | |
2648 if(ShellExecuteEx(&si) == FALSE) | |
2649 { | |
2650 XSRETURN_NO; | |
2651 } | |
2652 XSRETURN_YES; | |
2653 } | |
2654 #endif | |
2655 | |
2656 void | |
2657 Perl_init_os_extras(void) | |
2658 { | |
2659 dTHX; | |
2660 char *file = __FILE__; | |
2661 dXSUB_SYS; | |
2662 | |
2663 w32_perlshell_tokens = NULL; | |
2664 w32_perlshell_items = -1; | |
2665 w32_fdpid = newAV(); /* XX needs to be in Perl_win32_init()? */ | |
2666 Newx(w32_children, 1, child_tab); | |
2667 w32_num_children = 0; | |
2668 | |
2669 newXS("Win32::GetCwd", w32_GetCwd, file); | |
2670 newXS("Win32::SetCwd", w32_SetCwd, file); | |
2671 newXS("Win32::GetTickCount", w32_GetTickCount, file); | |
2672 newXS("Win32::GetOSVersion", w32_GetOSVersion, file); | |
2673 #if UNDER_CE > 200 | |
2674 newXS("Win32::ShellEx", w32_ShellEx, file); | |
2675 #endif | |
2676 newXS("Win32::IsWinNT", w32_IsWinNT, file); | |
2677 newXS("Win32::IsWin95", w32_IsWin95, file); | |
2678 newXS("Win32::IsWinCE", w32_IsWinCE, file); | |
2679 newXS("Win32::CopyFile", w32_CopyFile, file); | |
2680 newXS("Win32::Sleep", w32_Sleep, file); | |
2681 newXS("Win32::MessageBox", w32_MessageBox, file); | |
2682 newXS("Win32::GetPowerStatus", w32_GetPowerStatus, file); | |
2683 newXS("Win32::GetOemInfo", w32_GetOemInfo, file); | |
2684 } | |
2685 | |
2686 void | |
2687 myexit(void) | |
2688 { | |
2689 char buf[126]; | |
2690 | |
2691 puts("Hit return"); | |
2692 fgets(buf, sizeof(buf), stdin); | |
2693 } | |
2694 | |
2695 void | |
2696 Perl_win32_init(int *argcp, char ***argvp) | |
2697 { | |
2698 #ifdef UNDER_CE | |
2699 char *p; | |
2700 | |
2701 if((p = xcegetenv("PERLDEBUG")) && (p[0] == 'y' || p[0] == 'Y')) | |
2702 atexit(myexit); | |
2703 #endif | |
2704 | |
2705 MALLOC_INIT; | |
2706 } | |
2707 | |
2708 DllExport void | |
2709 Perl_win32_term(void) | |
2710 { | |
2711 dTHX; | |
2712 HINTS_REFCNT_TERM; | |
2713 OP_REFCNT_TERM; | |
2714 PERLIO_TERM; | |
2715 MALLOC_TERM; | |
2716 } | |
2717 | |
2718 void | |
2719 win32_get_child_IO(child_IO_table* ptbl) | |
2720 { | |
2721 ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE); | |
2722 ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE); | |
2723 ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE); | |
2724 } | |
2725 | |
2726 win32_flock(int fd, int oper) | |
2727 { | |
2728 dTHX; | |
2729 Perl_croak(aTHX_ PL_no_func, "flock"); | |
2730 return -1; | |
2731 } | |
2732 | |
2733 DllExport int | |
2734 win32_waitpid(int pid, int *status, int flags) | |
2735 { | |
2736 dTHX; | |
2737 Perl_croak(aTHX_ PL_no_func, "waitpid"); | |
2738 return -1; | |
2739 } | |
2740 | |
2741 DllExport int | |
2742 win32_wait(int *status) | |
2743 { | |
2744 dTHX; | |
2745 Perl_croak(aTHX_ PL_no_func, "wait"); | |
2746 return -1; | |
2747 } | |
2748 | |
2749 int | |
2750 wce_reopen_stdout(char *fname) | |
2751 { | |
2752 if(xcefreopen(fname, "w", stdout) == NULL) | |
2753 return -1; | |
2754 | |
2755 return 0; | |
2756 } | |
2757 | |
2758 void | |
2759 wce_hitreturn() | |
2760 { | |
2761 char buf[126]; | |
2762 | |
2763 printf("Hit RETURN"); | |
2764 fflush(stdout); | |
2765 fgets(buf, sizeof(buf), stdin); | |
2766 return; | |
2767 } | |
2768 | |
2769 /* //////////////////////////////////////////////////////////////////// */ | |
2770 | |
2771 #undef getcwd | |
2772 | |
2773 char * | |
2774 getcwd(char *buf, size_t size) | |
2775 { | |
2776 return xcegetcwd(buf, size); | |
2777 } | |
2778 | |
2779 | |
2780 DllExport PerlIO* | |
2781 win32_popenlist(const char *mode, IV narg, SV **args) | |
2782 { | |
2783 dTHX; | |
2784 Perl_croak(aTHX_ "List form of pipe open not implemented"); | |
2785 return NULL; | |
2786 } | |
2787 | |
2788 /* | |
2789 * a popen() clone that respects PERL5SHELL | |
2790 * | |
2791 * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000 | |
2792 */ | |
2793 | |
2794 DllExport PerlIO* | |
2795 win32_popen(const char *command, const char *mode) | |
2796 { | |
2797 return _popen(command, mode); | |
2798 } | |
2799 | |
2800 /* | |
2801 * pclose() clone | |
2802 */ | |
2803 | |
2804 DllExport int | |
2805 win32_pclose(PerlIO *pf) | |
2806 { | |
2807 return _pclose(pf); | |
2808 } | |
2809 | |
2810 #ifdef HAVE_INTERP_INTERN | |
2811 | |
2812 | |
2813 static void | |
2814 win32_csighandler(int sig) | |
2815 { | |
2816 #if 0 | |
2817 dTHXa(PERL_GET_SIG_CONTEXT); | |
2818 Perl_warn(aTHX_ "Got signal %d",sig); | |
2819 #endif | |
2820 /* Does nothing */ | |
2821 } | |
2822 | |
2823 void | |
2824 Perl_sys_intern_init(pTHX) | |
2825 { | |
2826 int i; | |
2827 w32_perlshell_tokens = NULL; | |
2828 w32_perlshell_vec = (char**)NULL; | |
2829 w32_perlshell_items = 0; | |
2830 w32_fdpid = newAV(); | |
2831 Newx(w32_children, 1, child_tab); | |
2832 w32_num_children = 0; | |
2833 # ifdef USE_ITHREADS | |
2834 w32_pseudo_id = 0; | |
2835 Newx(w32_pseudo_children, 1, child_tab); | |
2836 w32_num_pseudo_children = 0; | |
2837 # endif | |
2838 w32_init_socktype = 0; | |
2839 w32_timerid = 0; | |
2840 w32_poll_count = 0; | |
2841 } | |
2842 | |
2843 void | |
2844 Perl_sys_intern_clear(pTHX) | |
2845 { | |
2846 Safefree(w32_perlshell_tokens); | |
2847 Safefree(w32_perlshell_vec); | |
2848 /* NOTE: w32_fdpid is freed by sv_clean_all() */ | |
2849 Safefree(w32_children); | |
2850 if (w32_timerid) { | |
2851 KillTimer(NULL,w32_timerid); | |
2852 w32_timerid=0; | |
2853 } | |
2854 # ifdef USE_ITHREADS | |
2855 Safefree(w32_pseudo_children); | |
2856 # endif | |
2857 } | |
2858 | |
2859 # ifdef USE_ITHREADS | |
2860 | |
2861 void | |
2862 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) | |
2863 { | |
2864 dst->perlshell_tokens = NULL; | |
2865 dst->perlshell_vec = (char**)NULL; | |
2866 dst->perlshell_items = 0; | |
2867 dst->fdpid = newAV(); | |
2868 Newxz(dst->children, 1, child_tab); | |
2869 dst->pseudo_id = 0; | |
2870 Newxz(dst->pseudo_children, 1, child_tab); | |
2871 dst->thr_intern.Winit_socktype = 0; | |
2872 dst->timerid = 0; | |
2873 dst->poll_count = 0; | |
2874 Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t); | |
2875 } | |
2876 # endif /* USE_ITHREADS */ | |
2877 #endif /* HAVE_INTERP_INTERN */ | |
2878 | |
2879 // added to remove undefied symbol error in CodeWarrior compilation | |
2880 int | |
2881 Perl_Ireentrant_buffer_ptr(aTHX) | |
2882 { | |
2883 return 0; | |
2884 } |