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