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 */ 10 11 #define WIN32_LEAN_AND_MEAN 12 #define WIN32IO_IS_STDIO 13 #include <tchar.h> 14 #ifdef __GNUC__ 15 #define Win32_Winsock 16 #endif 17 #include <windows.h> 18 #ifndef __MINGW32__ /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */ 19 # include <shellapi.h> 20 #else 21 LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs); 22 #endif 23 #include <winnt.h> 24 #include <io.h> 25 26 /* #include "config.h" */ 27 28 #define PERLIO_NOT_STDIO 0 29 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) 30 #define PerlIO FILE 31 #endif 32 33 #include <sys/stat.h> 34 #include "EXTERN.h" 35 #include "perl.h" 36 37 #define NO_XSLOCKS 38 #define PERL_NO_GET_CONTEXT 39 #include "XSUB.h" 40 41 #include "Win32iop.h" 42 #include <fcntl.h> 43 #ifndef __GNUC__ 44 /* assert.h conflicts with #define of assert in perl.h */ 45 #include <assert.h> 46 #endif 47 #include <string.h> 48 #include <stdarg.h> 49 #include <float.h> 50 #include <time.h> 51 #if defined(_MSC_VER) || defined(__MINGW32__) 52 #include <sys/utime.h> 53 #else 54 #include <utime.h> 55 #endif 56 #ifdef __GNUC__ 57 /* Mingw32 defaults to globing command line 58 * So we turn it off like this: 59 */ 60 int _CRT_glob = 0; 61 #endif 62 63 #if defined(__MINGW32__) 64 /* Mingw32 is missing some prototypes */ 65 FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode); 66 FILE * _wfdopen(int nFd, LPCWSTR wszMode); 67 FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream); 68 int _flushall(); 69 int _fcloseall(); 70 #endif 71 72 #if defined(__BORLANDC__) 73 # define _stat stat 74 # define _utimbuf utimbuf 75 #endif 76 77 #define EXECF_EXEC 1 78 #define EXECF_SPAWN 2 79 #define EXECF_SPAWN_NOWAIT 3 80 81 #if defined(PERL_IMPLICIT_SYS) 82 # undef win32_get_privlib 83 # define win32_get_privlib g_win32_get_privlib 84 # undef win32_get_sitelib 85 # define win32_get_sitelib g_win32_get_sitelib 86 # undef win32_get_vendorlib 87 # define win32_get_vendorlib g_win32_get_vendorlib 88 # undef do_spawn 89 # define do_spawn g_do_spawn 90 # undef getlogin 91 # define getlogin g_getlogin 92 #endif 93 94 #if defined(PERL_OBJECT) 95 # undef do_aspawn 96 # define do_aspawn g_do_aspawn 97 # undef Perl_do_exec 98 # define Perl_do_exec g_do_exec 99 #endif 100 101 static void get_shell(void); 102 static long tokenize(const char *str, char **dest, char ***destv); 103 int do_spawn2(char *cmd, int exectype); 104 static BOOL has_shell_metachars(char *ptr); 105 static long filetime_to_clock(PFILETIME ft); 106 static BOOL filetime_from_time(PFILETIME ft, time_t t); 107 static char * get_emd_part(SV **leading, char *trailing, ...); 108 static void remove_dead_process(long deceased); 109 static long find_pid(int pid); 110 static char * qualified_path(const char *cmd); 111 static char * win32_get_xlib(const char *pl, const char *xlib, 112 const char *libname); 113 114 #ifdef USE_ITHREADS 115 static void remove_dead_pseudo_process(long child); 116 static long find_pseudo_pid(int pid); 117 #endif 118 119 START_EXTERN_C 120 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; 121 char w32_module_name[MAX_PATH+1]; 122 END_EXTERN_C 123 124 static DWORD w32_platform = (DWORD)-1; 125 126 #define ONE_K_BUFSIZE 1024 127 128 int 129 IsWin95(void) 130 { 131 return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS); 132 } 133 134 int 135 IsWinNT(void) 136 { 137 return (win32_os_id() == VER_PLATFORM_WIN32_NT); 138 } 139 140 EXTERN_C void 141 set_w32_module_name(void) 142 { 143 char* ptr; 144 GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE) 145 ? GetModuleHandle(NULL) 146 : w32_perldll_handle), 147 w32_module_name, sizeof(w32_module_name)); 148 149 /* try to get full path to binary (which may be mangled when perl is 150 * run from a 16-bit app) */ 151 /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/ 152 (void)win32_longpath(w32_module_name); 153 /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/ 154 155 /* normalize to forward slashes */ 156 ptr = w32_module_name; 157 while (*ptr) { 158 if (*ptr == '\\') 159 *ptr = '/'; 160 ++ptr; 161 } 162 } 163 164 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ 165 static char* 166 get_regstr_from(HKEY hkey, const char *valuename, SV **svp) 167 { 168 /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */ 169 HKEY handle; 170 DWORD type; 171 const char *subkey = "Software\\Perl"; 172 char *str = Nullch; 173 long retval; 174 175 retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle); 176 if (retval == ERROR_SUCCESS) { 177 DWORD datalen; 178 retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen); 179 if (retval == ERROR_SUCCESS 180 && (type == REG_SZ || type == REG_EXPAND_SZ)) 181 { 182 dTHXo; 183 if (!*svp) 184 *svp = sv_2mortal(newSVpvn("",0)); 185 SvGROW(*svp, datalen); 186 retval = RegQueryValueEx(handle, valuename, 0, NULL, 187 (PBYTE)SvPVX(*svp), &datalen); 188 if (retval == ERROR_SUCCESS) { 189 str = SvPVX(*svp); 190 SvCUR_set(*svp,datalen-1); 191 } 192 } 193 RegCloseKey(handle); 194 } 195 return str; 196 } 197 198 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ 199 static char* 200 get_regstr(const char *valuename, SV **svp) 201 { 202 char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp); 203 if (!str) 204 str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp); 205 return str; 206 } 207 208 /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ 209 static char * 210 get_emd_part(SV **prev_pathp, char *trailing_path, ...) 211 { 212 char base[10]; 213 va_list ap; 214 char mod_name[MAX_PATH+1]; 215 char *ptr; 216 char *optr; 217 char *strip; 218 int oldsize, newsize; 219 STRLEN baselen; 220 221 va_start(ap, trailing_path); 222 strip = va_arg(ap, char *); 223 224 sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION); 225 baselen = strlen(base); 226 227 if (!*w32_module_name) { 228 set_w32_module_name(); 229 } 230 strcpy(mod_name, w32_module_name); 231 ptr = strrchr(mod_name, '/'); 232 while (ptr && strip) { 233 /* look for directories to skip back */ 234 optr = ptr; 235 *ptr = '\0'; 236 ptr = strrchr(mod_name, '/'); 237 /* avoid stripping component if there is no slash, 238 * or it doesn't match ... */ 239 if (!ptr || stricmp(ptr+1, strip) != 0) { 240 /* ... but not if component matches m|5\.$patchlevel.*| */ 241 if (!ptr || !(*strip == '5' && *(ptr+1) == '5' 242 && strncmp(strip, base, baselen) == 0 243 && strncmp(ptr+1, base, baselen) == 0)) 244 { 245 *optr = '/'; 246 ptr = optr; 247 } 248 } 249 strip = va_arg(ap, char *); 250 } 251 if (!ptr) { 252 ptr = mod_name; 253 *ptr++ = '.'; 254 *ptr = '/'; 255 } 256 va_end(ap); 257 strcpy(++ptr, trailing_path); 258 259 /* only add directory if it exists */ 260 if (GetFileAttributes(mod_name) != (DWORD) -1) { 261 /* directory exists */ 262 dTHXo; 263 if (!*prev_pathp) 264 *prev_pathp = sv_2mortal(newSVpvn("",0)); 265 sv_catpvn(*prev_pathp, ";", 1); 266 sv_catpv(*prev_pathp, mod_name); 267 return SvPVX(*prev_pathp); 268 } 269 270 return Nullch; 271 } 272 273 char * 274 win32_get_privlib(const char *pl) 275 { 276 dTHXo; 277 char *stdlib = "lib"; 278 char buffer[MAX_PATH+1]; 279 SV *sv = Nullsv; 280 281 /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */ 282 sprintf(buffer, "%s-%s", stdlib, pl); 283 if (!get_regstr(buffer, &sv)) 284 (void)get_regstr(stdlib, &sv); 285 286 /* $stdlib .= ";$EMD/../../lib" */ 287 return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch); 288 } 289 290 static char * 291 win32_get_xlib(const char *pl, const char *xlib, const char *libname) 292 { 293 dTHXo; 294 char regstr[40]; 295 char pathstr[MAX_PATH+1]; 296 DWORD datalen; 297 int len, newsize; 298 SV *sv1 = Nullsv; 299 SV *sv2 = Nullsv; 300 301 /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */ 302 sprintf(regstr, "%s-%s", xlib, pl); 303 (void)get_regstr(regstr, &sv1); 304 305 /* $xlib .= 306 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */ 307 sprintf(pathstr, "%s/%s/lib", libname, pl); 308 (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); 309 310 /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */ 311 (void)get_regstr(xlib, &sv2); 312 313 /* $xlib .= 314 * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */ 315 sprintf(pathstr, "%s/lib", libname); 316 (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch); 317 318 if (!sv1 && !sv2) 319 return Nullch; 320 if (!sv1) 321 return SvPVX(sv2); 322 if (!sv2) 323 return SvPVX(sv1); 324 325 sv_catpvn(sv1, ";", 1); 326 sv_catsv(sv1, sv2); 327 328 return SvPVX(sv1); 329 } 330 331 char * 332 win32_get_sitelib(const char *pl) 333 { 334 return win32_get_xlib(pl, "sitelib", "site"); 335 } 336 337 #ifndef PERL_VENDORLIB_NAME 338 # define PERL_VENDORLIB_NAME "vendor" 339 #endif 340 341 char * 342 win32_get_vendorlib(const char *pl) 343 { 344 return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME); 345 } 346 347 static BOOL 348 has_shell_metachars(char *ptr) 349 { 350 int inquote = 0; 351 char quote = '\0'; 352 353 /* 354 * Scan string looking for redirection (< or >) or pipe 355 * characters (|) that are not in a quoted string. 356 * Shell variable interpolation (%VAR%) can also happen inside strings. 357 */ 358 while (*ptr) { 359 switch(*ptr) { 360 case '%': 361 return TRUE; 362 case '\'': 363 case '\"': 364 if (inquote) { 365 if (quote == *ptr) { 366 inquote = 0; 367 quote = '\0'; 368 } 369 } 370 else { 371 quote = *ptr; 372 inquote++; 373 } 374 break; 375 case '>': 376 case '<': 377 case '|': 378 if (!inquote) 379 return TRUE; 380 default: 381 break; 382 } 383 ++ptr; 384 } 385 return FALSE; 386 } 387 388 #if !defined(PERL_IMPLICIT_SYS) 389 /* since the current process environment is being updated in util.c 390 * the library functions will get the correct environment 391 */ 392 PerlIO * 393 Perl_my_popen(pTHX_ char *cmd, char *mode) 394 { 395 #ifdef FIXCMD 396 #define fixcmd(x) { \ 397 char *pspace = strchr((x),' '); \ 398 if (pspace) { \ 399 char *p = (x); \ 400 while (p < pspace) { \ 401 if (*p == '/') \ 402 *p = '\\'; \ 403 p++; \ 404 } \ 405 } \ 406 } 407 #else 408 #define fixcmd(x) 409 #endif 410 fixcmd(cmd); 411 PERL_FLUSHALL_FOR_CHILD; 412 return win32_popen(cmd, mode); 413 } 414 415 long 416 Perl_my_pclose(pTHX_ PerlIO *fp) 417 { 418 return win32_pclose(fp); 419 } 420 #endif 421 422 DllExport unsigned long 423 win32_os_id(void) 424 { 425 static OSVERSIONINFO osver; 426 427 if (osver.dwPlatformId != w32_platform) { 428 memset(&osver, 0, sizeof(OSVERSIONINFO)); 429 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); 430 GetVersionEx(&osver); 431 w32_platform = osver.dwPlatformId; 432 } 433 return (unsigned long)w32_platform; 434 } 435 436 DllExport int 437 win32_getpid(void) 438 { 439 int pid; 440 #ifdef USE_ITHREADS 441 dTHXo; 442 if (w32_pseudo_id) 443 return -((int)w32_pseudo_id); 444 #endif 445 pid = _getpid(); 446 /* Windows 9x appears to always reports a pid for threads and processes 447 * that has the high bit set. So we treat the lower 31 bits as the 448 * "real" PID for Perl's purposes. */ 449 if (IsWin95() && pid < 0) 450 pid = -pid; 451 return pid; 452 } 453 454 /* Tokenize a string. Words are null-separated, and the list 455 * ends with a doubled null. Any character (except null and 456 * including backslash) may be escaped by preceding it with a 457 * backslash (the backslash will be stripped). 458 * Returns number of words in result buffer. 459 */ 460 static long 461 tokenize(const char *str, char **dest, char ***destv) 462 { 463 char *retstart = Nullch; 464 char **retvstart = 0; 465 int items = -1; 466 if (str) { 467 dTHXo; 468 int slen = strlen(str); 469 register char *ret; 470 register char **retv; 471 New(1307, ret, slen+2, char); 472 New(1308, retv, (slen+3)/2, char*); 473 474 retstart = ret; 475 retvstart = retv; 476 *retv = ret; 477 items = 0; 478 while (*str) { 479 *ret = *str++; 480 if (*ret == '\\' && *str) 481 *ret = *str++; 482 else if (*ret == ' ') { 483 while (*str == ' ') 484 str++; 485 if (ret == retstart) 486 ret--; 487 else { 488 *ret = '\0'; 489 ++items; 490 if (*str) 491 *++retv = ret+1; 492 } 493 } 494 else if (!*str) 495 ++items; 496 ret++; 497 } 498 retvstart[items] = Nullch; 499 *ret++ = '\0'; 500 *ret = '\0'; 501 } 502 *dest = retstart; 503 *destv = retvstart; 504 return items; 505 } 506 507 static void 508 get_shell(void) 509 { 510 dTHXo; 511 if (!w32_perlshell_tokens) { 512 /* we don't use COMSPEC here for two reasons: 513 * 1. the same reason perl on UNIX doesn't use SHELL--rampant and 514 * uncontrolled unportability of the ensuing scripts. 515 * 2. PERL5SHELL could be set to a shell that may not be fit for 516 * interactive use (which is what most programs look in COMSPEC 517 * for). 518 */ 519 const char* defaultshell = (IsWinNT() 520 ? "cmd.exe /x/c" : "command.com /c"); 521 const char *usershell = getenv("PERL5SHELL"); 522 w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, 523 &w32_perlshell_tokens, 524 &w32_perlshell_vec); 525 } 526 } 527 528 int 529 do_aspawn(void *vreally, void **vmark, void **vsp) 530 { 531 dTHXo; 532 SV *really = (SV*)vreally; 533 SV **mark = (SV**)vmark; 534 SV **sp = (SV**)vsp; 535 char **argv; 536 char *str; 537 int status; 538 int flag = P_WAIT; 539 int index = 0; 540 541 if (sp <= mark) 542 return -1; 543 544 get_shell(); 545 New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*); 546 547 if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { 548 ++mark; 549 flag = SvIVx(*mark); 550 } 551 552 while (++mark <= sp) { 553 if (*mark && (str = SvPV_nolen(*mark))) 554 argv[index++] = str; 555 else 556 argv[index++] = ""; 557 } 558 argv[index++] = 0; 559 560 status = win32_spawnvp(flag, 561 (const char*)(really ? SvPV_nolen(really) : argv[0]), 562 (const char* const*)argv); 563 564 if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) { 565 /* possible shell-builtin, invoke with shell */ 566 int sh_items; 567 sh_items = w32_perlshell_items; 568 while (--index >= 0) 569 argv[index+sh_items] = argv[index]; 570 while (--sh_items >= 0) 571 argv[sh_items] = w32_perlshell_vec[sh_items]; 572 573 status = win32_spawnvp(flag, 574 (const char*)(really ? SvPV_nolen(really) : argv[0]), 575 (const char* const*)argv); 576 } 577 578 if (flag == P_NOWAIT) { 579 if (IsWin95()) 580 PL_statusvalue = -1; /* >16bits hint for pp_system() */ 581 } 582 else { 583 if (status < 0) { 584 if (ckWARN(WARN_EXEC)) 585 Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno)); 586 status = 255 * 256; 587 } 588 else 589 status *= 256; 590 PL_statusvalue = status; 591 } 592 Safefree(argv); 593 return (status); 594 } 595 596 int 597 do_spawn2(char *cmd, int exectype) 598 { 599 dTHXo; 600 char **a; 601 char *s; 602 char **argv; 603 int status = -1; 604 BOOL needToTry = TRUE; 605 char *cmd2; 606 607 /* Save an extra exec if possible. See if there are shell 608 * metacharacters in it */ 609 if (!has_shell_metachars(cmd)) { 610 New(1301,argv, strlen(cmd) / 2 + 2, char*); 611 New(1302,cmd2, strlen(cmd) + 1, char); 612 strcpy(cmd2, cmd); 613 a = argv; 614 for (s = cmd2; *s;) { 615 while (*s && isSPACE(*s)) 616 s++; 617 if (*s) 618 *(a++) = s; 619 while (*s && !isSPACE(*s)) 620 s++; 621 if (*s) 622 *s++ = '\0'; 623 } 624 *a = Nullch; 625 if (argv[0]) { 626 switch (exectype) { 627 case EXECF_SPAWN: 628 status = win32_spawnvp(P_WAIT, argv[0], 629 (const char* const*)argv); 630 break; 631 case EXECF_SPAWN_NOWAIT: 632 status = win32_spawnvp(P_NOWAIT, argv[0], 633 (const char* const*)argv); 634 break; 635 case EXECF_EXEC: 636 status = win32_execvp(argv[0], (const char* const*)argv); 637 break; 638 } 639 if (status != -1 || errno == 0) 640 needToTry = FALSE; 641 } 642 Safefree(argv); 643 Safefree(cmd2); 644 } 645 if (needToTry) { 646 char **argv; 647 int i = -1; 648 get_shell(); 649 New(1306, argv, w32_perlshell_items + 2, char*); 650 while (++i < w32_perlshell_items) 651 argv[i] = w32_perlshell_vec[i]; 652 argv[i++] = cmd; 653 argv[i] = Nullch; 654 switch (exectype) { 655 case EXECF_SPAWN: 656 status = win32_spawnvp(P_WAIT, argv[0], 657 (const char* const*)argv); 658 break; 659 case EXECF_SPAWN_NOWAIT: 660 status = win32_spawnvp(P_NOWAIT, argv[0], 661 (const char* const*)argv); 662 break; 663 case EXECF_EXEC: 664 status = win32_execvp(argv[0], (const char* const*)argv); 665 break; 666 } 667 cmd = argv[0]; 668 Safefree(argv); 669 } 670 if (exectype == EXECF_SPAWN_NOWAIT) { 671 if (IsWin95()) 672 PL_statusvalue = -1; /* >16bits hint for pp_system() */ 673 } 674 else { 675 if (status < 0) { 676 if (ckWARN(WARN_EXEC)) 677 Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", 678 (exectype == EXECF_EXEC ? "exec" : "spawn"), 679 cmd, strerror(errno)); 680 status = 255 * 256; 681 } 682 else 683 status *= 256; 684 PL_statusvalue = status; 685 } 686 return (status); 687 } 688 689 int 690 do_spawn(char *cmd) 691 { 692 return do_spawn2(cmd, EXECF_SPAWN); 693 } 694 695 int 696 do_spawn_nowait(char *cmd) 697 { 698 return do_spawn2(cmd, EXECF_SPAWN_NOWAIT); 699 } 700 701 bool 702 Perl_do_exec(pTHX_ char *cmd) 703 { 704 do_spawn2(cmd, EXECF_EXEC); 705 return FALSE; 706 } 707 708 /* The idea here is to read all the directory names into a string table 709 * (separated by nulls) and when one of the other dir functions is called 710 * return the pointer to the current file name. 711 */ 712 DllExport DIR * 713 win32_opendir(char *filename) 714 { 715 dTHXo; 716 DIR *dirp; 717 long len; 718 long idx; 719 char scanname[MAX_PATH+3]; 720 struct stat sbuf; 721 WIN32_FIND_DATAA aFindData; 722 WIN32_FIND_DATAW wFindData; 723 HANDLE fh; 724 char buffer[MAX_PATH*2]; 725 WCHAR wbuffer[MAX_PATH+1]; 726 char* ptr; 727 728 len = strlen(filename); 729 if (len > MAX_PATH) 730 return NULL; 731 732 /* check to see if filename is a directory */ 733 if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode)) 734 return NULL; 735 736 /* Get us a DIR structure */ 737 Newz(1303, dirp, 1, DIR); 738 739 /* Create the search pattern */ 740 strcpy(scanname, filename); 741 742 /* bare drive name means look in cwd for drive */ 743 if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') { 744 scanname[len++] = '.'; 745 scanname[len++] = '/'; 746 } 747 else if (scanname[len-1] != '/' && scanname[len-1] != '\\') { 748 scanname[len++] = '/'; 749 } 750 scanname[len++] = '*'; 751 scanname[len] = '\0'; 752 753 /* do the FindFirstFile call */ 754 if (USING_WIDE()) { 755 A2WHELPER(scanname, wbuffer, sizeof(wbuffer)); 756 fh = FindFirstFileW(PerlDir_mapW(wbuffer), &wFindData); 757 } 758 else { 759 fh = FindFirstFileA(PerlDir_mapA(scanname), &aFindData); 760 } 761 dirp->handle = fh; 762 if (fh == INVALID_HANDLE_VALUE) { 763 DWORD err = GetLastError(); 764 /* FindFirstFile() fails on empty drives! */ 765 switch (err) { 766 case ERROR_FILE_NOT_FOUND: 767 return dirp; 768 case ERROR_NO_MORE_FILES: 769 case ERROR_PATH_NOT_FOUND: 770 errno = ENOENT; 771 break; 772 case ERROR_NOT_ENOUGH_MEMORY: 773 errno = ENOMEM; 774 break; 775 default: 776 errno = EINVAL; 777 break; 778 } 779 Safefree(dirp); 780 return NULL; 781 } 782 783 /* now allocate the first part of the string table for 784 * the filenames that we find. 785 */ 786 if (USING_WIDE()) { 787 W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); 788 ptr = buffer; 789 } 790 else { 791 ptr = aFindData.cFileName; 792 } 793 idx = strlen(ptr)+1; 794 if (idx < 256) 795 dirp->size = 128; 796 else 797 dirp->size = idx; 798 New(1304, dirp->start, dirp->size, char); 799 strcpy(dirp->start, ptr); 800 dirp->nfiles++; 801 dirp->end = dirp->curr = dirp->start; 802 dirp->end += idx; 803 return dirp; 804 } 805 806 807 /* Readdir just returns the current string pointer and bumps the 808 * string pointer to the nDllExport entry. 809 */ 810 DllExport struct direct * 811 win32_readdir(DIR *dirp) 812 { 813 long len; 814 815 if (dirp->curr) { 816 /* first set up the structure to return */ 817 len = strlen(dirp->curr); 818 strcpy(dirp->dirstr.d_name, dirp->curr); 819 dirp->dirstr.d_namlen = len; 820 821 /* Fake an inode */ 822 dirp->dirstr.d_ino = dirp->curr - dirp->start; 823 824 /* Now set up for the next call to readdir */ 825 dirp->curr += len + 1; 826 if (dirp->curr >= dirp->end) { 827 dTHXo; 828 char* ptr; 829 BOOL res; 830 WIN32_FIND_DATAW wFindData; 831 WIN32_FIND_DATAA aFindData; 832 char buffer[MAX_PATH*2]; 833 834 /* finding the next file that matches the wildcard 835 * (which should be all of them in this directory!). 836 */ 837 if (USING_WIDE()) { 838 res = FindNextFileW(dirp->handle, &wFindData); 839 if (res) { 840 W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); 841 ptr = buffer; 842 } 843 } 844 else { 845 res = FindNextFileA(dirp->handle, &aFindData); 846 if (res) 847 ptr = aFindData.cFileName; 848 } 849 if (res) { 850 long endpos = dirp->end - dirp->start; 851 long newsize = endpos + strlen(ptr) + 1; 852 /* bump the string table size by enough for the 853 * new name and it's null terminator */ 854 while (newsize > dirp->size) { 855 long curpos = dirp->curr - dirp->start; 856 dirp->size *= 2; 857 Renew(dirp->start, dirp->size, char); 858 dirp->curr = dirp->start + curpos; 859 } 860 strcpy(dirp->start + endpos, ptr); 861 dirp->end = dirp->start + newsize; 862 dirp->nfiles++; 863 } 864 else 865 dirp->curr = NULL; 866 } 867 return &(dirp->dirstr); 868 } 869 else 870 return NULL; 871 } 872 873 /* Telldir returns the current string pointer position */ 874 DllExport long 875 win32_telldir(DIR *dirp) 876 { 877 return (dirp->curr - dirp->start); 878 } 879 880 881 /* Seekdir moves the string pointer to a previously saved position 882 * (returned by telldir). 883 */ 884 DllExport void 885 win32_seekdir(DIR *dirp, long loc) 886 { 887 dirp->curr = dirp->start + loc; 888 } 889 890 /* Rewinddir resets the string pointer to the start */ 891 DllExport void 892 win32_rewinddir(DIR *dirp) 893 { 894 dirp->curr = dirp->start; 895 } 896 897 /* free the memory allocated by opendir */ 898 DllExport int 899 win32_closedir(DIR *dirp) 900 { 901 dTHXo; 902 if (dirp->handle != INVALID_HANDLE_VALUE) 903 FindClose(dirp->handle); 904 Safefree(dirp->start); 905 Safefree(dirp); 906 return 1; 907 } 908 909 910 /* 911 * various stubs 912 */ 913 914 915 /* Ownership 916 * 917 * Just pretend that everyone is a superuser. NT will let us know if 918 * we don\'t really have permission to do something. 919 */ 920 921 #define ROOT_UID ((uid_t)0) 922 #define ROOT_GID ((gid_t)0) 923 924 uid_t 925 getuid(void) 926 { 927 return ROOT_UID; 928 } 929 930 uid_t 931 geteuid(void) 932 { 933 return ROOT_UID; 934 } 935 936 gid_t 937 getgid(void) 938 { 939 return ROOT_GID; 940 } 941 942 gid_t 943 getegid(void) 944 { 945 return ROOT_GID; 946 } 947 948 int 949 setuid(uid_t auid) 950 { 951 return (auid == ROOT_UID ? 0 : -1); 952 } 953 954 int 955 setgid(gid_t agid) 956 { 957 return (agid == ROOT_GID ? 0 : -1); 958 } 959 960 char * 961 getlogin(void) 962 { 963 dTHXo; 964 char *buf = w32_getlogin_buffer; 965 DWORD size = sizeof(w32_getlogin_buffer); 966 if (GetUserName(buf,&size)) 967 return buf; 968 return (char*)NULL; 969 } 970 971 int 972 chown(const char *path, uid_t owner, gid_t group) 973 { 974 /* XXX noop */ 975 return 0; 976 } 977 978 static long 979 find_pid(int pid) 980 { 981 dTHXo; 982 long child = w32_num_children; 983 while (--child >= 0) { 984 if (w32_child_pids[child] == pid) 985 return child; 986 } 987 return -1; 988 } 989 990 static void 991 remove_dead_process(long child) 992 { 993 if (child >= 0) { 994 dTHXo; 995 CloseHandle(w32_child_handles[child]); 996 Move(&w32_child_handles[child+1], &w32_child_handles[child], 997 (w32_num_children-child-1), HANDLE); 998 Move(&w32_child_pids[child+1], &w32_child_pids[child], 999 (w32_num_children-child-1), DWORD); 1000 w32_num_children--; 1001 } 1002 } 1003 1004 #ifdef USE_ITHREADS 1005 static long 1006 find_pseudo_pid(int pid) 1007 { 1008 dTHXo; 1009 long child = w32_num_pseudo_children; 1010 while (--child >= 0) { 1011 if (w32_pseudo_child_pids[child] == pid) 1012 return child; 1013 } 1014 return -1; 1015 } 1016 1017 static void 1018 remove_dead_pseudo_process(long child) 1019 { 1020 if (child >= 0) { 1021 dTHXo; 1022 CloseHandle(w32_pseudo_child_handles[child]); 1023 Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child], 1024 (w32_num_pseudo_children-child-1), HANDLE); 1025 Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child], 1026 (w32_num_pseudo_children-child-1), DWORD); 1027 w32_num_pseudo_children--; 1028 } 1029 } 1030 #endif 1031 1032 DllExport int 1033 win32_kill(int pid, int sig) 1034 { 1035 dTHXo; 1036 HANDLE hProcess; 1037 long child; 1038 #ifdef USE_ITHREADS 1039 if (pid < 0) { 1040 /* it is a pseudo-forked child */ 1041 child = find_pseudo_pid(-pid); 1042 if (child >= 0) { 1043 if (!sig) 1044 return 0; 1045 hProcess = w32_pseudo_child_handles[child]; 1046 if (TerminateThread(hProcess, sig)) { 1047 remove_dead_pseudo_process(child); 1048 return 0; 1049 } 1050 } 1051 else if (IsWin95()) { 1052 pid = -pid; 1053 goto alien_process; 1054 } 1055 } 1056 else 1057 #endif 1058 { 1059 child = find_pid(pid); 1060 if (child >= 0) { 1061 if (!sig) 1062 return 0; 1063 hProcess = w32_child_handles[child]; 1064 if (TerminateProcess(hProcess, sig)) { 1065 remove_dead_process(child); 1066 return 0; 1067 } 1068 } 1069 else { 1070 alien_process: 1071 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, 1072 (IsWin95() ? -pid : pid)); 1073 if (hProcess) { 1074 if (!sig) 1075 return 0; 1076 if (TerminateProcess(hProcess, sig)) { 1077 CloseHandle(hProcess); 1078 return 0; 1079 } 1080 } 1081 } 1082 } 1083 errno = EINVAL; 1084 return -1; 1085 } 1086 1087 /* 1088 * File system stuff 1089 */ 1090 1091 DllExport unsigned int 1092 win32_sleep(unsigned int t) 1093 { 1094 Sleep(t*1000); 1095 return 0; 1096 } 1097 1098 DllExport int 1099 win32_stat(const char *path, struct stat *sbuf) 1100 { 1101 dTHXo; 1102 char buffer[MAX_PATH+1]; 1103 int l = strlen(path); 1104 int res; 1105 WCHAR wbuffer[MAX_PATH+1]; 1106 WCHAR* pwbuffer; 1107 HANDLE handle; 1108 int nlink = 1; 1109 1110 if (l > 1) { 1111 switch(path[l - 1]) { 1112 /* FindFirstFile() and stat() are buggy with a trailing 1113 * backslash, so change it to a forward slash :-( */ 1114 case '\\': 1115 strncpy(buffer, path, l-1); 1116 buffer[l - 1] = '/'; 1117 buffer[l] = '\0'; 1118 path = buffer; 1119 break; 1120 /* FindFirstFile() is buggy with "x:", so add a dot :-( */ 1121 case ':': 1122 if (l == 2 && isALPHA(path[0])) { 1123 buffer[0] = path[0]; 1124 buffer[1] = ':'; 1125 buffer[2] = '.'; 1126 buffer[3] = '\0'; 1127 l = 3; 1128 path = buffer; 1129 } 1130 break; 1131 } 1132 } 1133 1134 /* We *must* open & close the file once; otherwise file attribute changes */ 1135 /* might not yet have propagated to "other" hard links of the same file. */ 1136 /* This also gives us an opportunity to determine the number of links. */ 1137 if (USING_WIDE()) { 1138 A2WHELPER(path, wbuffer, sizeof(wbuffer)); 1139 pwbuffer = PerlDir_mapW(wbuffer); 1140 handle = CreateFileW(pwbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); 1141 } 1142 else { 1143 path = PerlDir_mapA(path); 1144 l = strlen(path); 1145 handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); 1146 } 1147 if (handle != INVALID_HANDLE_VALUE) { 1148 BY_HANDLE_FILE_INFORMATION bhi; 1149 if (GetFileInformationByHandle(handle, &bhi)) 1150 nlink = bhi.nNumberOfLinks; 1151 CloseHandle(handle); 1152 } 1153 1154 /* pwbuffer or path will be mapped correctly above */ 1155 if (USING_WIDE()) { 1156 res = _wstat(pwbuffer, (struct _stat *)sbuf); 1157 } 1158 else { 1159 res = stat(path, sbuf); 1160 } 1161 sbuf->st_nlink = nlink; 1162 1163 if (res < 0) { 1164 /* CRT is buggy on sharenames, so make sure it really isn't. 1165 * XXX using GetFileAttributesEx() will enable us to set 1166 * sbuf->st_*time (but note that's not available on the 1167 * Windows of 1995) */ 1168 DWORD r; 1169 if (USING_WIDE()) { 1170 r = GetFileAttributesW(pwbuffer); 1171 } 1172 else { 1173 r = GetFileAttributesA(path); 1174 } 1175 if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { 1176 /* sbuf may still contain old garbage since stat() failed */ 1177 Zero(sbuf, 1, struct stat); 1178 sbuf->st_mode = S_IFDIR | S_IREAD; 1179 errno = 0; 1180 if (!(r & FILE_ATTRIBUTE_READONLY)) 1181 sbuf->st_mode |= S_IWRITE | S_IEXEC; 1182 return 0; 1183 } 1184 } 1185 else { 1186 if (l == 3 && isALPHA(path[0]) && path[1] == ':' 1187 && (path[2] == '\\' || path[2] == '/')) 1188 { 1189 /* The drive can be inaccessible, some _stat()s are buggy */ 1190 if (USING_WIDE() 1191 ? !GetVolumeInformationW(pwbuffer,NULL,0,NULL,NULL,NULL,NULL,0) 1192 : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { 1193 errno = ENOENT; 1194 return -1; 1195 } 1196 } 1197 #ifdef __BORLANDC__ 1198 if (S_ISDIR(sbuf->st_mode)) 1199 sbuf->st_mode |= S_IWRITE | S_IEXEC; 1200 else if (S_ISREG(sbuf->st_mode)) { 1201 int perms; 1202 if (l >= 4 && path[l-4] == '.') { 1203 const char *e = path + l - 3; 1204 if (strnicmp(e,"exe",3) 1205 && strnicmp(e,"bat",3) 1206 && strnicmp(e,"com",3) 1207 && (IsWin95() || strnicmp(e,"cmd",3))) 1208 sbuf->st_mode &= ~S_IEXEC; 1209 else 1210 sbuf->st_mode |= S_IEXEC; 1211 } 1212 else 1213 sbuf->st_mode &= ~S_IEXEC; 1214 /* Propagate permissions to _group_ and _others_ */ 1215 perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC); 1216 sbuf->st_mode |= (perms>>3) | (perms>>6); 1217 } 1218 #endif 1219 } 1220 return res; 1221 } 1222 1223 /* Find the longname of a given path. path is destructively modified. 1224 * It should have space for at least MAX_PATH characters. */ 1225 DllExport char * 1226 win32_longpath(char *path) 1227 { 1228 WIN32_FIND_DATA fdata; 1229 HANDLE fhand; 1230 char tmpbuf[MAX_PATH+1]; 1231 char *tmpstart = tmpbuf; 1232 char *start = path; 1233 char sep; 1234 if (!path) 1235 return Nullch; 1236 1237 /* drive prefix */ 1238 if (isALPHA(path[0]) && path[1] == ':' && 1239 (path[2] == '/' || path[2] == '\\')) 1240 { 1241 start = path + 2; 1242 *tmpstart++ = path[0]; 1243 *tmpstart++ = ':'; 1244 } 1245 /* UNC prefix */ 1246 else if ((path[0] == '/' || path[0] == '\\') && 1247 (path[1] == '/' || path[1] == '\\')) 1248 { 1249 start = path + 2; 1250 *tmpstart++ = path[0]; 1251 *tmpstart++ = path[1]; 1252 /* copy machine name */ 1253 while (*start && *start != '/' && *start != '\\') 1254 *tmpstart++ = *start++; 1255 if (*start) { 1256 *tmpstart++ = *start; 1257 start++; 1258 /* copy share name */ 1259 while (*start && *start != '/' && *start != '\\') 1260 *tmpstart++ = *start++; 1261 } 1262 } 1263 sep = *start++; 1264 if (sep == '/' || sep == '\\') 1265 *tmpstart++ = sep; 1266 *tmpstart = '\0'; 1267 while (sep) { 1268 /* walk up to slash */ 1269 while (*start && *start != '/' && *start != '\\') 1270 ++start; 1271 1272 /* discard doubled slashes */ 1273 while (*start && (start[1] == '/' || start[1] == '\\')) 1274 ++start; 1275 sep = *start; 1276 1277 /* stop and find full name of component */ 1278 *start = '\0'; 1279 fhand = FindFirstFile(path,&fdata); 1280 if (fhand != INVALID_HANDLE_VALUE) { 1281 strcpy(tmpstart, fdata.cFileName); 1282 tmpstart += strlen(fdata.cFileName); 1283 if (sep) 1284 *tmpstart++ = sep; 1285 *tmpstart = '\0'; 1286 *start++ = sep; 1287 FindClose(fhand); 1288 } 1289 else { 1290 /* failed a step, just return without side effects */ 1291 /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ 1292 *start = sep; 1293 return Nullch; 1294 } 1295 } 1296 strcpy(path,tmpbuf); 1297 return path; 1298 } 1299 1300 DllExport char * 1301 win32_getenv(const char *name) 1302 { 1303 dTHXo; 1304 WCHAR wBuffer[MAX_PATH+1]; 1305 DWORD needlen; 1306 SV *curitem = Nullsv; 1307 1308 if (USING_WIDE()) { 1309 A2WHELPER(name, wBuffer, sizeof(wBuffer)); 1310 needlen = GetEnvironmentVariableW(wBuffer, NULL, 0); 1311 } 1312 else 1313 needlen = GetEnvironmentVariableA(name,NULL,0); 1314 if (needlen != 0) { 1315 curitem = sv_2mortal(newSVpvn("", 0)); 1316 if (USING_WIDE()) { 1317 SV *acuritem; 1318 do { 1319 SvGROW(curitem, (needlen+1)*sizeof(WCHAR)); 1320 needlen = GetEnvironmentVariableW(wBuffer, 1321 (WCHAR*)SvPVX(curitem), 1322 needlen); 1323 } while (needlen >= SvLEN(curitem)/sizeof(WCHAR)); 1324 SvCUR_set(curitem, (needlen*sizeof(WCHAR))+1); 1325 acuritem = sv_2mortal(newSVsv(curitem)); 1326 W2AHELPER((WCHAR*)SvPVX(acuritem), SvPVX(curitem), SvCUR(curitem)); 1327 } 1328 else { 1329 do { 1330 SvGROW(curitem, needlen+1); 1331 needlen = GetEnvironmentVariableA(name,SvPVX(curitem), 1332 needlen); 1333 } while (needlen >= SvLEN(curitem)); 1334 SvCUR_set(curitem, needlen); 1335 } 1336 } 1337 else { 1338 /* allow any environment variables that begin with 'PERL' 1339 to be stored in the registry */ 1340 if (strncmp(name, "PERL", 4) == 0) 1341 (void)get_regstr(name, &curitem); 1342 } 1343 if (curitem && SvCUR(curitem)) 1344 return SvPVX(curitem); 1345 1346 return Nullch; 1347 } 1348 1349 DllExport int 1350 win32_putenv(const char *name) 1351 { 1352 dTHXo; 1353 char* curitem; 1354 char* val; 1355 WCHAR* wCuritem; 1356 WCHAR* wVal; 1357 int length, relval = -1; 1358 1359 if (name) { 1360 if (USING_WIDE()) { 1361 length = strlen(name)+1; 1362 New(1309,wCuritem,length,WCHAR); 1363 A2WHELPER(name, wCuritem, length*sizeof(WCHAR)); 1364 wVal = wcschr(wCuritem, '='); 1365 if (wVal) { 1366 *wVal++ = '\0'; 1367 if (SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL)) 1368 relval = 0; 1369 } 1370 Safefree(wCuritem); 1371 } 1372 else { 1373 New(1309,curitem,strlen(name)+1,char); 1374 strcpy(curitem, name); 1375 val = strchr(curitem, '='); 1376 if (val) { 1377 /* The sane way to deal with the environment. 1378 * Has these advantages over putenv() & co.: 1379 * * enables us to store a truly empty value in the 1380 * environment (like in UNIX). 1381 * * we don't have to deal with RTL globals, bugs and leaks. 1382 * * Much faster. 1383 * Why you may want to enable USE_WIN32_RTL_ENV: 1384 * * environ[] and RTL functions will not reflect changes, 1385 * which might be an issue if extensions want to access 1386 * the env. via RTL. This cuts both ways, since RTL will 1387 * not see changes made by extensions that call the Win32 1388 * functions directly, either. 1389 * GSAR 97-06-07 1390 */ 1391 *val++ = '\0'; 1392 if (SetEnvironmentVariableA(curitem, *val ? val : NULL)) 1393 relval = 0; 1394 } 1395 Safefree(curitem); 1396 } 1397 } 1398 return relval; 1399 } 1400 1401 static long 1402 filetime_to_clock(PFILETIME ft) 1403 { 1404 __int64 qw = ft->dwHighDateTime; 1405 qw <<= 32; 1406 qw |= ft->dwLowDateTime; 1407 qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ 1408 return (long) qw; 1409 } 1410 1411 DllExport int 1412 win32_times(struct tms *timebuf) 1413 { 1414 FILETIME user; 1415 FILETIME kernel; 1416 FILETIME dummy; 1417 if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, 1418 &kernel,&user)) { 1419 timebuf->tms_utime = filetime_to_clock(&user); 1420 timebuf->tms_stime = filetime_to_clock(&kernel); 1421 timebuf->tms_cutime = 0; 1422 timebuf->tms_cstime = 0; 1423 1424 } else { 1425 /* That failed - e.g. Win95 fallback to clock() */ 1426 clock_t t = clock(); 1427 timebuf->tms_utime = t; 1428 timebuf->tms_stime = 0; 1429 timebuf->tms_cutime = 0; 1430 timebuf->tms_cstime = 0; 1431 } 1432 return 0; 1433 } 1434 1435 /* fix utime() so it works on directories in NT */ 1436 static BOOL 1437 filetime_from_time(PFILETIME pFileTime, time_t Time) 1438 { 1439 struct tm *pTM = localtime(&Time); 1440 SYSTEMTIME SystemTime; 1441 FILETIME LocalTime; 1442 1443 if (pTM == NULL) 1444 return FALSE; 1445 1446 SystemTime.wYear = pTM->tm_year + 1900; 1447 SystemTime.wMonth = pTM->tm_mon + 1; 1448 SystemTime.wDay = pTM->tm_mday; 1449 SystemTime.wHour = pTM->tm_hour; 1450 SystemTime.wMinute = pTM->tm_min; 1451 SystemTime.wSecond = pTM->tm_sec; 1452 SystemTime.wMilliseconds = 0; 1453 1454 return SystemTimeToFileTime(&SystemTime, &LocalTime) && 1455 LocalFileTimeToFileTime(&LocalTime, pFileTime); 1456 } 1457 1458 DllExport int 1459 win32_unlink(const char *filename) 1460 { 1461 dTHXo; 1462 int ret; 1463 DWORD attrs; 1464 1465 if (USING_WIDE()) { 1466 WCHAR wBuffer[MAX_PATH+1]; 1467 WCHAR* pwBuffer; 1468 1469 A2WHELPER(filename, wBuffer, sizeof(wBuffer)); 1470 pwBuffer = PerlDir_mapW(wBuffer); 1471 attrs = GetFileAttributesW(pwBuffer); 1472 if (attrs == 0xFFFFFFFF) 1473 goto fail; 1474 if (attrs & FILE_ATTRIBUTE_READONLY) { 1475 (void)SetFileAttributesW(pwBuffer, attrs & ~FILE_ATTRIBUTE_READONLY); 1476 ret = _wunlink(pwBuffer); 1477 if (ret == -1) 1478 (void)SetFileAttributesW(pwBuffer, attrs); 1479 } 1480 else 1481 ret = _wunlink(pwBuffer); 1482 } 1483 else { 1484 filename = PerlDir_mapA(filename); 1485 attrs = GetFileAttributesA(filename); 1486 if (attrs == 0xFFFFFFFF) 1487 goto fail; 1488 if (attrs & FILE_ATTRIBUTE_READONLY) { 1489 (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY); 1490 ret = unlink(filename); 1491 if (ret == -1) 1492 (void)SetFileAttributesA(filename, attrs); 1493 } 1494 else 1495 ret = unlink(filename); 1496 } 1497 return ret; 1498 fail: 1499 errno = ENOENT; 1500 return -1; 1501 } 1502 1503 DllExport int 1504 win32_utime(const char *filename, struct utimbuf *times) 1505 { 1506 dTHXo; 1507 HANDLE handle; 1508 FILETIME ftCreate; 1509 FILETIME ftAccess; 1510 FILETIME ftWrite; 1511 struct utimbuf TimeBuffer; 1512 WCHAR wbuffer[MAX_PATH+1]; 1513 WCHAR* pwbuffer; 1514 1515 int rc; 1516 if (USING_WIDE()) { 1517 A2WHELPER(filename, wbuffer, sizeof(wbuffer)); 1518 pwbuffer = PerlDir_mapW(wbuffer); 1519 rc = _wutime(pwbuffer, (struct _utimbuf*)times); 1520 } 1521 else { 1522 filename = PerlDir_mapA(filename); 1523 rc = utime(filename, times); 1524 } 1525 /* EACCES: path specifies directory or readonly file */ 1526 if (rc == 0 || errno != EACCES /* || !IsWinNT() */) 1527 return rc; 1528 1529 if (times == NULL) { 1530 times = &TimeBuffer; 1531 time(×->actime); 1532 times->modtime = times->actime; 1533 } 1534 1535 /* This will (and should) still fail on readonly files */ 1536 if (USING_WIDE()) { 1537 handle = CreateFileW(pwbuffer, GENERIC_READ | GENERIC_WRITE, 1538 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, 1539 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); 1540 } 1541 else { 1542 handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE, 1543 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, 1544 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); 1545 } 1546 if (handle == INVALID_HANDLE_VALUE) 1547 return rc; 1548 1549 if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) && 1550 filetime_from_time(&ftAccess, times->actime) && 1551 filetime_from_time(&ftWrite, times->modtime) && 1552 SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite)) 1553 { 1554 rc = 0; 1555 } 1556 1557 CloseHandle(handle); 1558 return rc; 1559 } 1560 1561 DllExport int 1562 win32_uname(struct utsname *name) 1563 { 1564 struct hostent *hep; 1565 STRLEN nodemax = sizeof(name->nodename)-1; 1566 OSVERSIONINFO osver; 1567 1568 memset(&osver, 0, sizeof(OSVERSIONINFO)); 1569 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); 1570 if (GetVersionEx(&osver)) { 1571 /* sysname */ 1572 switch (osver.dwPlatformId) { 1573 case VER_PLATFORM_WIN32_WINDOWS: 1574 strcpy(name->sysname, "Windows"); 1575 break; 1576 case VER_PLATFORM_WIN32_NT: 1577 strcpy(name->sysname, "Windows NT"); 1578 break; 1579 case VER_PLATFORM_WIN32s: 1580 strcpy(name->sysname, "Win32s"); 1581 break; 1582 default: 1583 strcpy(name->sysname, "Win32 Unknown"); 1584 break; 1585 } 1586 1587 /* release */ 1588 sprintf(name->release, "%d.%d", 1589 osver.dwMajorVersion, osver.dwMinorVersion); 1590 1591 /* version */ 1592 sprintf(name->version, "Build %d", 1593 osver.dwPlatformId == VER_PLATFORM_WIN32_NT 1594 ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff)); 1595 if (osver.szCSDVersion[0]) { 1596 char *buf = name->version + strlen(name->version); 1597 sprintf(buf, " (%s)", osver.szCSDVersion); 1598 } 1599 } 1600 else { 1601 *name->sysname = '\0'; 1602 *name->version = '\0'; 1603 *name->release = '\0'; 1604 } 1605 1606 /* nodename */ 1607 hep = win32_gethostbyname("localhost"); 1608 if (hep) { 1609 STRLEN len = strlen(hep->h_name); 1610 if (len <= nodemax) { 1611 strcpy(name->nodename, hep->h_name); 1612 } 1613 else { 1614 strncpy(name->nodename, hep->h_name, nodemax); 1615 name->nodename[nodemax] = '\0'; 1616 } 1617 } 1618 else { 1619 DWORD sz = nodemax; 1620 if (!GetComputerName(name->nodename, &sz)) 1621 *name->nodename = '\0'; 1622 } 1623 1624 /* machine (architecture) */ 1625 { 1626 SYSTEM_INFO info; 1627 char *arch; 1628 GetSystemInfo(&info); 1629 1630 #if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) || defined(__MINGW32__) 1631 switch (info.u.s.wProcessorArchitecture) { 1632 #else 1633 switch (info.wProcessorArchitecture) { 1634 #endif 1635 case PROCESSOR_ARCHITECTURE_INTEL: 1636 arch = "x86"; break; 1637 case PROCESSOR_ARCHITECTURE_MIPS: 1638 arch = "mips"; break; 1639 case PROCESSOR_ARCHITECTURE_ALPHA: 1640 arch = "alpha"; break; 1641 case PROCESSOR_ARCHITECTURE_PPC: 1642 arch = "ppc"; break; 1643 default: 1644 arch = "unknown"; break; 1645 } 1646 strcpy(name->machine, arch); 1647 } 1648 return 0; 1649 } 1650 1651 DllExport int 1652 win32_waitpid(int pid, int *status, int flags) 1653 { 1654 dTHXo; 1655 DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE; 1656 int retval = -1; 1657 long child; 1658 if (pid == -1) /* XXX threadid == 1 ? */ 1659 return win32_wait(status); 1660 #ifdef USE_ITHREADS 1661 else if (pid < 0) { 1662 child = find_pseudo_pid(-pid); 1663 if (child >= 0) { 1664 HANDLE hThread = w32_pseudo_child_handles[child]; 1665 DWORD waitcode = WaitForSingleObject(hThread, timeout); 1666 if (waitcode == WAIT_TIMEOUT) { 1667 return 0; 1668 } 1669 else if (waitcode != WAIT_FAILED) { 1670 if (GetExitCodeThread(hThread, &waitcode)) { 1671 *status = (int)((waitcode & 0xff) << 8); 1672 retval = (int)w32_pseudo_child_pids[child]; 1673 remove_dead_pseudo_process(child); 1674 return -retval; 1675 } 1676 } 1677 else 1678 errno = ECHILD; 1679 } 1680 else if (IsWin95()) { 1681 pid = -pid; 1682 goto alien_process; 1683 } 1684 } 1685 #endif 1686 else { 1687 HANDLE hProcess; 1688 DWORD waitcode; 1689 child = find_pid(pid); 1690 if (child >= 0) { 1691 hProcess = w32_child_handles[child]; 1692 waitcode = WaitForSingleObject(hProcess, timeout); 1693 if (waitcode == WAIT_TIMEOUT) { 1694 return 0; 1695 } 1696 else if (waitcode != WAIT_FAILED) { 1697 if (GetExitCodeProcess(hProcess, &waitcode)) { 1698 *status = (int)((waitcode & 0xff) << 8); 1699 retval = (int)w32_child_pids[child]; 1700 remove_dead_process(child); 1701 return retval; 1702 } 1703 } 1704 else 1705 errno = ECHILD; 1706 } 1707 else { 1708 alien_process: 1709 hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, 1710 (IsWin95() ? -pid : pid)); 1711 if (hProcess) { 1712 waitcode = WaitForSingleObject(hProcess, timeout); 1713 if (waitcode == WAIT_TIMEOUT) { 1714 return 0; 1715 } 1716 else if (waitcode != WAIT_FAILED) { 1717 if (GetExitCodeProcess(hProcess, &waitcode)) { 1718 *status = (int)((waitcode & 0xff) << 8); 1719 CloseHandle(hProcess); 1720 return pid; 1721 } 1722 } 1723 CloseHandle(hProcess); 1724 } 1725 else 1726 errno = ECHILD; 1727 } 1728 } 1729 return retval >= 0 ? pid : retval; 1730 } 1731 1732 DllExport int 1733 win32_wait(int *status) 1734 { 1735 /* XXX this wait emulation only knows about processes 1736 * spawned via win32_spawnvp(P_NOWAIT, ...). 1737 */ 1738 dTHXo; 1739 int i, retval; 1740 DWORD exitcode, waitcode; 1741 1742 #ifdef USE_ITHREADS 1743 if (w32_num_pseudo_children) { 1744 waitcode = WaitForMultipleObjects(w32_num_pseudo_children, 1745 w32_pseudo_child_handles, 1746 FALSE, 1747 INFINITE); 1748 if (waitcode != WAIT_FAILED) { 1749 if (waitcode >= WAIT_ABANDONED_0 1750 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) 1751 i = waitcode - WAIT_ABANDONED_0; 1752 else 1753 i = waitcode - WAIT_OBJECT_0; 1754 if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { 1755 *status = (int)((exitcode & 0xff) << 8); 1756 retval = (int)w32_pseudo_child_pids[i]; 1757 remove_dead_pseudo_process(i); 1758 return -retval; 1759 } 1760 } 1761 } 1762 #endif 1763 1764 if (!w32_num_children) { 1765 errno = ECHILD; 1766 return -1; 1767 } 1768 1769 /* if a child exists, wait for it to die */ 1770 waitcode = WaitForMultipleObjects(w32_num_children, 1771 w32_child_handles, 1772 FALSE, 1773 INFINITE); 1774 if (waitcode != WAIT_FAILED) { 1775 if (waitcode >= WAIT_ABANDONED_0 1776 && waitcode < WAIT_ABANDONED_0 + w32_num_children) 1777 i = waitcode - WAIT_ABANDONED_0; 1778 else 1779 i = waitcode - WAIT_OBJECT_0; 1780 if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) { 1781 *status = (int)((exitcode & 0xff) << 8); 1782 retval = (int)w32_child_pids[i]; 1783 remove_dead_process(i); 1784 return retval; 1785 } 1786 } 1787 1788 FAILED: 1789 errno = GetLastError(); 1790 return -1; 1791 } 1792 1793 #ifndef PERL_OBJECT 1794 1795 static UINT timerid = 0; 1796 1797 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) 1798 { 1799 dTHXo; 1800 KillTimer(NULL,timerid); 1801 timerid=0; 1802 CALL_FPTR(PL_sighandlerp)(14); 1803 } 1804 #endif /* !PERL_OBJECT */ 1805 1806 DllExport unsigned int 1807 win32_alarm(unsigned int sec) 1808 { 1809 #ifndef PERL_OBJECT 1810 /* 1811 * the 'obvious' implentation is SetTimer() with a callback 1812 * which does whatever receiving SIGALRM would do 1813 * we cannot use SIGALRM even via raise() as it is not 1814 * one of the supported codes in <signal.h> 1815 * 1816 * Snag is unless something is looking at the message queue 1817 * nothing happens :-( 1818 */ 1819 dTHXo; 1820 if (sec) 1821 { 1822 timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc); 1823 if (!timerid) 1824 Perl_croak_nocontext("Cannot set timer"); 1825 } 1826 else 1827 { 1828 if (timerid) 1829 { 1830 KillTimer(NULL,timerid); 1831 timerid=0; 1832 } 1833 } 1834 #endif /* !PERL_OBJECT */ 1835 return 0; 1836 } 1837 1838 #ifdef HAVE_DES_FCRYPT 1839 extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf); 1840 #endif 1841 1842 DllExport char * 1843 win32_crypt(const char *txt, const char *salt) 1844 { 1845 dTHXo; 1846 #ifdef HAVE_DES_FCRYPT 1847 return des_fcrypt(txt, salt, w32_crypt_buffer); 1848 #else 1849 Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); 1850 return Nullch; 1851 #endif 1852 } 1853 1854 #ifdef USE_FIXED_OSFHANDLE 1855 1856 #define FOPEN 0x01 /* file handle open */ 1857 #define FNOINHERIT 0x10 /* file handle opened O_NOINHERIT */ 1858 #define FAPPEND 0x20 /* file handle opened O_APPEND */ 1859 #define FDEV 0x40 /* file handle refers to device */ 1860 #define FTEXT 0x80 /* file handle is in text mode */ 1861 1862 /*** 1863 *int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle 1864 * 1865 *Purpose: 1866 * This function allocates a free C Runtime file handle and associates 1867 * it with the Win32 HANDLE specified by the first parameter. This is a 1868 * temperary fix for WIN95's brain damage GetFileType() error on socket 1869 * we just bypass that call for socket 1870 * 1871 * This works with MSVC++ 4.0+ or GCC/Mingw32 1872 * 1873 *Entry: 1874 * long osfhandle - Win32 HANDLE to associate with C Runtime file handle. 1875 * int flags - flags to associate with C Runtime file handle. 1876 * 1877 *Exit: 1878 * returns index of entry in fh, if successful 1879 * return -1, if no free entry is found 1880 * 1881 *Exceptions: 1882 * 1883 *******************************************************************************/ 1884 1885 /* 1886 * we fake up some parts of the CRT that aren't exported by MSVCRT.dll 1887 * this lets sockets work on Win9X with GCC and should fix the problems 1888 * with perl95.exe 1889 * -- BKS, 1-23-2000 1890 */ 1891 1892 /* create an ioinfo entry, kill its handle, and steal the entry */ 1893 1894 static int 1895 _alloc_osfhnd(void) 1896 { 1897 HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL); 1898 int fh = _open_osfhandle((long)hF, 0); 1899 CloseHandle(hF); 1900 if (fh == -1) 1901 return fh; 1902 EnterCriticalSection(&(_pioinfo(fh)->lock)); 1903 return fh; 1904 } 1905 1906 static int 1907 my_open_osfhandle(long osfhandle, int flags) 1908 { 1909 int fh; 1910 char fileflags; /* _osfile flags */ 1911 1912 /* copy relevant flags from second parameter */ 1913 fileflags = FDEV; 1914 1915 if (flags & O_APPEND) 1916 fileflags |= FAPPEND; 1917 1918 if (flags & O_TEXT) 1919 fileflags |= FTEXT; 1920 1921 if (flags & O_NOINHERIT) 1922 fileflags |= FNOINHERIT; 1923 1924 /* attempt to allocate a C Runtime file handle */ 1925 if ((fh = _alloc_osfhnd()) == -1) { 1926 errno = EMFILE; /* too many open files */ 1927 _doserrno = 0L; /* not an OS error */ 1928 return -1; /* return error to caller */ 1929 } 1930 1931 /* the file is open. now, set the info in _osfhnd array */ 1932 _set_osfhnd(fh, osfhandle); 1933 1934 fileflags |= FOPEN; /* mark as open */ 1935 1936 _osfile(fh) = fileflags; /* set osfile entry */ 1937 LeaveCriticalSection(&_pioinfo(fh)->lock); 1938 1939 return fh; /* return handle */ 1940 } 1941 1942 #endif /* USE_FIXED_OSFHANDLE */ 1943 1944 /* simulate flock by locking a range on the file */ 1945 1946 #define LK_ERR(f,i) ((f) ? (i = 0) : (errno = GetLastError())) 1947 #define LK_LEN 0xffff0000 1948 1949 DllExport int 1950 win32_flock(int fd, int oper) 1951 { 1952 OVERLAPPED o; 1953 int i = -1; 1954 HANDLE fh; 1955 1956 if (!IsWinNT()) { 1957 dTHXo; 1958 Perl_croak_nocontext("flock() unimplemented on this platform"); 1959 return -1; 1960 } 1961 fh = (HANDLE)_get_osfhandle(fd); 1962 memset(&o, 0, sizeof(o)); 1963 1964 switch(oper) { 1965 case LOCK_SH: /* shared lock */ 1966 LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i); 1967 break; 1968 case LOCK_EX: /* exclusive lock */ 1969 LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i); 1970 break; 1971 case LOCK_SH|LOCK_NB: /* non-blocking shared lock */ 1972 LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i); 1973 break; 1974 case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */ 1975 LK_ERR(LockFileEx(fh, 1976 LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY, 1977 0, LK_LEN, 0, &o),i); 1978 break; 1979 case LOCK_UN: /* unlock lock */ 1980 LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i); 1981 break; 1982 default: /* unknown */ 1983 errno = EINVAL; 1984 break; 1985 } 1986 return i; 1987 } 1988 1989 #undef LK_ERR 1990 #undef LK_LEN 1991 1992 /* 1993 * redirected io subsystem for all XS modules 1994 * 1995 */ 1996 1997 DllExport int * 1998 win32_errno(void) 1999 { 2000 return (&errno); 2001 } 2002 2003 DllExport char *** 2004 win32_environ(void) 2005 { 2006 return (&(_environ)); 2007 } 2008 2009 /* the rest are the remapped stdio routines */ 2010 DllExport FILE * 2011 win32_stderr(void) 2012 { 2013 return (stderr); 2014 } 2015 2016 DllExport FILE * 2017 win32_stdin(void) 2018 { 2019 return (stdin); 2020 } 2021 2022 DllExport FILE * 2023 win32_stdout() 2024 { 2025 return (stdout); 2026 } 2027 2028 DllExport int 2029 win32_ferror(FILE *fp) 2030 { 2031 return (ferror(fp)); 2032 } 2033 2034 2035 DllExport int 2036 win32_feof(FILE *fp) 2037 { 2038 return (feof(fp)); 2039 } 2040 2041 /* 2042 * Since the errors returned by the socket error function 2043 * WSAGetLastError() are not known by the library routine strerror 2044 * we have to roll our own. 2045 */ 2046 2047 DllExport char * 2048 win32_strerror(int e) 2049 { 2050 #ifndef __BORLANDC__ /* Borland intolerance */ 2051 extern int sys_nerr; 2052 #endif 2053 DWORD source = 0; 2054 2055 if (e < 0 || e > sys_nerr) { 2056 dTHXo; 2057 if (e < 0) 2058 e = GetLastError(); 2059 2060 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, 2061 w32_strerror_buffer, 2062 sizeof(w32_strerror_buffer), NULL) == 0) 2063 strcpy(w32_strerror_buffer, "Unknown Error"); 2064 2065 return w32_strerror_buffer; 2066 } 2067 return strerror(e); 2068 } 2069 2070 DllExport void 2071 win32_str_os_error(void *sv, DWORD dwErr) 2072 { 2073 DWORD dwLen; 2074 char *sMsg; 2075 dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER 2076 |FORMAT_MESSAGE_IGNORE_INSERTS 2077 |FORMAT_MESSAGE_FROM_SYSTEM, NULL, 2078 dwErr, 0, (char *)&sMsg, 1, NULL); 2079 /* strip trailing whitespace and period */ 2080 if (0 < dwLen) { 2081 do { 2082 --dwLen; /* dwLen doesn't include trailing null */ 2083 } while (0 < dwLen && isSPACE(sMsg[dwLen])); 2084 if ('.' != sMsg[dwLen]) 2085 dwLen++; 2086 sMsg[dwLen] = '\0'; 2087 } 2088 if (0 == dwLen) { 2089 sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); 2090 if (sMsg) 2091 dwLen = sprintf(sMsg, 2092 "Unknown error #0x%lX (lookup 0x%lX)", 2093 dwErr, GetLastError()); 2094 } 2095 if (sMsg) { 2096 dTHXo; 2097 sv_setpvn((SV*)sv, sMsg, dwLen); 2098 LocalFree(sMsg); 2099 } 2100 } 2101 2102 2103 DllExport int 2104 win32_fprintf(FILE *fp, const char *format, ...) 2105 { 2106 va_list marker; 2107 va_start(marker, format); /* Initialize variable arguments. */ 2108 2109 return (vfprintf(fp, format, marker)); 2110 } 2111 2112 DllExport int 2113 win32_printf(const char *format, ...) 2114 { 2115 va_list marker; 2116 va_start(marker, format); /* Initialize variable arguments. */ 2117 2118 return (vprintf(format, marker)); 2119 } 2120 2121 DllExport int 2122 win32_vfprintf(FILE *fp, const char *format, va_list args) 2123 { 2124 return (vfprintf(fp, format, args)); 2125 } 2126 2127 DllExport int 2128 win32_vprintf(const char *format, va_list args) 2129 { 2130 return (vprintf(format, args)); 2131 } 2132 2133 DllExport size_t 2134 win32_fread(void *buf, size_t size, size_t count, FILE *fp) 2135 { 2136 return fread(buf, size, count, fp); 2137 } 2138 2139 DllExport size_t 2140 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) 2141 { 2142 return fwrite(buf, size, count, fp); 2143 } 2144 2145 #define MODE_SIZE 10 2146 2147 DllExport FILE * 2148 win32_fopen(const char *filename, const char *mode) 2149 { 2150 dTHXo; 2151 WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1]; 2152 FILE *f; 2153 2154 if (!*filename) 2155 return NULL; 2156 2157 if (stricmp(filename, "/dev/null")==0) 2158 filename = "NUL"; 2159 2160 if (USING_WIDE()) { 2161 A2WHELPER(mode, wMode, sizeof(wMode)); 2162 A2WHELPER(filename, wBuffer, sizeof(wBuffer)); 2163 f = _wfopen(PerlDir_mapW(wBuffer), wMode); 2164 } 2165 else 2166 f = fopen(PerlDir_mapA(filename), mode); 2167 /* avoid buffering headaches for child processes */ 2168 if (f && *mode == 'a') 2169 win32_fseek(f, 0, SEEK_END); 2170 return f; 2171 } 2172 2173 #ifndef USE_SOCKETS_AS_HANDLES 2174 #undef fdopen 2175 #define fdopen my_fdopen 2176 #endif 2177 2178 DllExport FILE * 2179 win32_fdopen(int handle, const char *mode) 2180 { 2181 dTHXo; 2182 WCHAR wMode[MODE_SIZE]; 2183 FILE *f; 2184 if (USING_WIDE()) { 2185 A2WHELPER(mode, wMode, sizeof(wMode)); 2186 f = _wfdopen(handle, wMode); 2187 } 2188 else 2189 f = fdopen(handle, (char *) mode); 2190 /* avoid buffering headaches for child processes */ 2191 if (f && *mode == 'a') 2192 win32_fseek(f, 0, SEEK_END); 2193 return f; 2194 } 2195 2196 DllExport FILE * 2197 win32_freopen(const char *path, const char *mode, FILE *stream) 2198 { 2199 dTHXo; 2200 WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1]; 2201 if (stricmp(path, "/dev/null")==0) 2202 path = "NUL"; 2203 2204 if (USING_WIDE()) { 2205 A2WHELPER(mode, wMode, sizeof(wMode)); 2206 A2WHELPER(path, wBuffer, sizeof(wBuffer)); 2207 return _wfreopen(PerlDir_mapW(wBuffer), wMode, stream); 2208 } 2209 return freopen(PerlDir_mapA(path), mode, stream); 2210 } 2211 2212 DllExport int 2213 win32_fclose(FILE *pf) 2214 { 2215 return my_fclose(pf); /* defined in win32sck.c */ 2216 } 2217 2218 DllExport int 2219 win32_fputs(const char *s,FILE *pf) 2220 { 2221 return fputs(s, pf); 2222 } 2223 2224 DllExport int 2225 win32_fputc(int c,FILE *pf) 2226 { 2227 return fputc(c,pf); 2228 } 2229 2230 DllExport int 2231 win32_ungetc(int c,FILE *pf) 2232 { 2233 return ungetc(c,pf); 2234 } 2235 2236 DllExport int 2237 win32_getc(FILE *pf) 2238 { 2239 return getc(pf); 2240 } 2241 2242 DllExport int 2243 win32_fileno(FILE *pf) 2244 { 2245 return fileno(pf); 2246 } 2247 2248 DllExport void 2249 win32_clearerr(FILE *pf) 2250 { 2251 clearerr(pf); 2252 return; 2253 } 2254 2255 DllExport int 2256 win32_fflush(FILE *pf) 2257 { 2258 return fflush(pf); 2259 } 2260 2261 DllExport long 2262 win32_ftell(FILE *pf) 2263 { 2264 return ftell(pf); 2265 } 2266 2267 DllExport int 2268 win32_fseek(FILE *pf,long offset,int origin) 2269 { 2270 return fseek(pf, offset, origin); 2271 } 2272 2273 DllExport int 2274 win32_fgetpos(FILE *pf,fpos_t *p) 2275 { 2276 return fgetpos(pf, p); 2277 } 2278 2279 DllExport int 2280 win32_fsetpos(FILE *pf,const fpos_t *p) 2281 { 2282 return fsetpos(pf, p); 2283 } 2284 2285 DllExport void 2286 win32_rewind(FILE *pf) 2287 { 2288 rewind(pf); 2289 return; 2290 } 2291 2292 DllExport FILE* 2293 win32_tmpfile(void) 2294 { 2295 return tmpfile(); 2296 } 2297 2298 DllExport void 2299 win32_abort(void) 2300 { 2301 abort(); 2302 return; 2303 } 2304 2305 DllExport int 2306 win32_fstat(int fd,struct stat *sbufptr) 2307 { 2308 #ifdef __BORLANDC__ 2309 /* A file designated by filehandle is not shown as accessible 2310 * for write operations, probably because it is opened for reading. 2311 * --Vadim Konovalov 2312 */ 2313 int rc = fstat(fd,sbufptr); 2314 BY_HANDLE_FILE_INFORMATION bhfi; 2315 if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) { 2316 sbufptr->st_mode &= 0xFE00; 2317 if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY) 2318 sbufptr->st_mode |= (S_IREAD + (S_IREAD >> 3) + (S_IREAD >> 6)); 2319 else 2320 sbufptr->st_mode |= ((S_IREAD|S_IWRITE) + ((S_IREAD|S_IWRITE) >> 3) 2321 + ((S_IREAD|S_IWRITE) >> 6)); 2322 } 2323 return rc; 2324 #else 2325 return my_fstat(fd,sbufptr); 2326 #endif 2327 } 2328 2329 DllExport int 2330 win32_pipe(int *pfd, unsigned int size, int mode) 2331 { 2332 return _pipe(pfd, size, mode); 2333 } 2334 2335 /* 2336 * a popen() clone that respects PERL5SHELL 2337 */ 2338 2339 DllExport FILE* 2340 win32_popen(const char *command, const char *mode) 2341 { 2342 #ifdef USE_RTL_POPEN 2343 return _popen(command, mode); 2344 #else 2345 int p[2]; 2346 int parent, child; 2347 int stdfd, oldfd; 2348 int ourmode; 2349 int childpid; 2350 2351 /* establish which ends read and write */ 2352 if (strchr(mode,'w')) { 2353 stdfd = 0; /* stdin */ 2354 parent = 1; 2355 child = 0; 2356 } 2357 else if (strchr(mode,'r')) { 2358 stdfd = 1; /* stdout */ 2359 parent = 0; 2360 child = 1; 2361 } 2362 else 2363 return NULL; 2364 2365 /* set the correct mode */ 2366 if (strchr(mode,'b')) 2367 ourmode = O_BINARY; 2368 else if (strchr(mode,'t')) 2369 ourmode = O_TEXT; 2370 else 2371 ourmode = _fmode & (O_TEXT | O_BINARY); 2372 2373 /* the child doesn't inherit handles */ 2374 ourmode |= O_NOINHERIT; 2375 2376 if (win32_pipe( p, 512, ourmode) == -1) 2377 return NULL; 2378 2379 /* save current stdfd */ 2380 if ((oldfd = win32_dup(stdfd)) == -1) 2381 goto cleanup; 2382 2383 /* make stdfd go to child end of pipe (implicitly closes stdfd) */ 2384 /* stdfd will be inherited by the child */ 2385 if (win32_dup2(p[child], stdfd) == -1) 2386 goto cleanup; 2387 2388 /* close the child end in parent */ 2389 win32_close(p[child]); 2390 2391 /* start the child */ 2392 { 2393 dTHXo; 2394 if ((childpid = do_spawn_nowait((char*)command)) == -1) 2395 goto cleanup; 2396 2397 /* revert stdfd to whatever it was before */ 2398 if (win32_dup2(oldfd, stdfd) == -1) 2399 goto cleanup; 2400 2401 /* close saved handle */ 2402 win32_close(oldfd); 2403 2404 LOCK_FDPID_MUTEX; 2405 sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); 2406 UNLOCK_FDPID_MUTEX; 2407 2408 /* set process id so that it can be returned by perl's open() */ 2409 PL_forkprocess = childpid; 2410 } 2411 2412 /* we have an fd, return a file stream */ 2413 return (win32_fdopen(p[parent], (char *)mode)); 2414 2415 cleanup: 2416 /* we don't need to check for errors here */ 2417 win32_close(p[0]); 2418 win32_close(p[1]); 2419 if (oldfd != -1) { 2420 win32_dup2(oldfd, stdfd); 2421 win32_close(oldfd); 2422 } 2423 return (NULL); 2424 2425 #endif /* USE_RTL_POPEN */ 2426 } 2427 2428 /* 2429 * pclose() clone 2430 */ 2431 2432 DllExport int 2433 win32_pclose(FILE *pf) 2434 { 2435 #ifdef USE_RTL_POPEN 2436 return _pclose(pf); 2437 #else 2438 dTHXo; 2439 int childpid, status; 2440 SV *sv; 2441 2442 LOCK_FDPID_MUTEX; 2443 sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); 2444 2445 if (SvIOK(sv)) 2446 childpid = SvIVX(sv); 2447 else 2448 childpid = 0; 2449 2450 if (!childpid) { 2451 errno = EBADF; 2452 return -1; 2453 } 2454 2455 win32_fclose(pf); 2456 SvIVX(sv) = 0; 2457 UNLOCK_FDPID_MUTEX; 2458 2459 if (win32_waitpid(childpid, &status, 0) == -1) 2460 return -1; 2461 2462 return status; 2463 2464 #endif /* USE_RTL_POPEN */ 2465 } 2466 2467 static BOOL WINAPI 2468 Nt4CreateHardLinkW( 2469 LPCWSTR lpFileName, 2470 LPCWSTR lpExistingFileName, 2471 LPSECURITY_ATTRIBUTES lpSecurityAttributes) 2472 { 2473 HANDLE handle; 2474 WCHAR wFullName[MAX_PATH+1]; 2475 LPVOID lpContext = NULL; 2476 WIN32_STREAM_ID StreamId; 2477 DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId; 2478 DWORD dwWritten; 2479 DWORD dwLen; 2480 BOOL bSuccess; 2481 2482 BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD, 2483 BOOL, BOOL, LPVOID*) = 2484 (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD, 2485 BOOL, BOOL, LPVOID*)) 2486 GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite"); 2487 if (pfnBackupWrite == NULL) 2488 return 0; 2489 2490 dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL); 2491 if (dwLen == 0) 2492 return 0; 2493 dwLen = (dwLen+1)*sizeof(WCHAR); 2494 2495 handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES, 2496 FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, 2497 NULL, OPEN_EXISTING, 0, NULL); 2498 if (handle == INVALID_HANDLE_VALUE) 2499 return 0; 2500 2501 StreamId.dwStreamId = BACKUP_LINK; 2502 StreamId.dwStreamAttributes = 0; 2503 StreamId.dwStreamNameSize = 0; 2504 #if defined(__BORLANDC__) || defined(__MINGW32__) 2505 StreamId.Size.u.HighPart = 0; 2506 StreamId.Size.u.LowPart = dwLen; 2507 #else 2508 StreamId.Size.HighPart = 0; 2509 StreamId.Size.LowPart = dwLen; 2510 #endif 2511 2512 bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten, 2513 FALSE, FALSE, &lpContext); 2514 if (bSuccess) { 2515 bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten, 2516 FALSE, FALSE, &lpContext); 2517 pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext); 2518 } 2519 2520 CloseHandle(handle); 2521 return bSuccess; 2522 } 2523 2524 DllExport int 2525 win32_link(const char *oldname, const char *newname) 2526 { 2527 dTHXo; 2528 BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES); 2529 WCHAR wOldName[MAX_PATH+1]; 2530 WCHAR wNewName[MAX_PATH+1]; 2531 2532 if (IsWin95()) 2533 Perl_croak(aTHX_ PL_no_func, "link"); 2534 2535 pfnCreateHardLinkW = 2536 (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES)) 2537 GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW"); 2538 if (pfnCreateHardLinkW == NULL) 2539 pfnCreateHardLinkW = Nt4CreateHardLinkW; 2540 2541 if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) && 2542 (A2WHELPER(newname, wNewName, sizeof(wNewName))) && 2543 (wcscpy(wOldName, PerlDir_mapW(wOldName)), 2544 pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL))) 2545 { 2546 return 0; 2547 } 2548 errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL; 2549 return -1; 2550 } 2551 2552 DllExport int 2553 win32_rename(const char *oname, const char *newname) 2554 { 2555 WCHAR wOldName[MAX_PATH+1]; 2556 WCHAR wNewName[MAX_PATH+1]; 2557 char szOldName[MAX_PATH+1]; 2558 char szNewName[MAX_PATH+1]; 2559 BOOL bResult; 2560 dTHXo; 2561 2562 /* XXX despite what the documentation says about MoveFileEx(), 2563 * it doesn't work under Windows95! 2564 */ 2565 if (IsWinNT()) { 2566 DWORD dwFlags = MOVEFILE_COPY_ALLOWED; 2567 if (USING_WIDE()) { 2568 A2WHELPER(oname, wOldName, sizeof(wOldName)); 2569 A2WHELPER(newname, wNewName, sizeof(wNewName)); 2570 if (wcsicmp(wNewName, wOldName)) 2571 dwFlags |= MOVEFILE_REPLACE_EXISTING; 2572 wcscpy(wOldName, PerlDir_mapW(wOldName)); 2573 bResult = MoveFileExW(wOldName,PerlDir_mapW(wNewName), dwFlags); 2574 } 2575 else { 2576 if (stricmp(newname, oname)) 2577 dwFlags |= MOVEFILE_REPLACE_EXISTING; 2578 strcpy(szOldName, PerlDir_mapA(oname)); 2579 bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags); 2580 } 2581 if (!bResult) { 2582 DWORD err = GetLastError(); 2583 switch (err) { 2584 case ERROR_BAD_NET_NAME: 2585 case ERROR_BAD_NETPATH: 2586 case ERROR_BAD_PATHNAME: 2587 case ERROR_FILE_NOT_FOUND: 2588 case ERROR_FILENAME_EXCED_RANGE: 2589 case ERROR_INVALID_DRIVE: 2590 case ERROR_NO_MORE_FILES: 2591 case ERROR_PATH_NOT_FOUND: 2592 errno = ENOENT; 2593 break; 2594 default: 2595 errno = EACCES; 2596 break; 2597 } 2598 return -1; 2599 } 2600 return 0; 2601 } 2602 else { 2603 int retval = 0; 2604 char szTmpName[MAX_PATH+1]; 2605 char dname[MAX_PATH+1]; 2606 char *endname = Nullch; 2607 STRLEN tmplen = 0; 2608 DWORD from_attr, to_attr; 2609 2610 strcpy(szOldName, PerlDir_mapA(oname)); 2611 strcpy(szNewName, PerlDir_mapA(newname)); 2612 2613 /* if oname doesn't exist, do nothing */ 2614 from_attr = GetFileAttributes(szOldName); 2615 if (from_attr == 0xFFFFFFFF) { 2616 errno = ENOENT; 2617 return -1; 2618 } 2619 2620 /* if newname exists, rename it to a temporary name so that we 2621 * don't delete it in case oname happens to be the same file 2622 * (but perhaps accessed via a different path) 2623 */ 2624 to_attr = GetFileAttributes(szNewName); 2625 if (to_attr != 0xFFFFFFFF) { 2626 /* if newname is a directory, we fail 2627 * XXX could overcome this with yet more convoluted logic */ 2628 if (to_attr & FILE_ATTRIBUTE_DIRECTORY) { 2629 errno = EACCES; 2630 return -1; 2631 } 2632 tmplen = strlen(szNewName); 2633 strcpy(szTmpName,szNewName); 2634 endname = szTmpName+tmplen; 2635 for (; endname > szTmpName ; --endname) { 2636 if (*endname == '/' || *endname == '\\') { 2637 *endname = '\0'; 2638 break; 2639 } 2640 } 2641 if (endname > szTmpName) 2642 endname = strcpy(dname,szTmpName); 2643 else 2644 endname = "."; 2645 2646 /* get a temporary filename in same directory 2647 * XXX is this really the best we can do? */ 2648 if (!GetTempFileName((LPCTSTR)endname, "plr", 0, szTmpName)) { 2649 errno = ENOENT; 2650 return -1; 2651 } 2652 DeleteFile(szTmpName); 2653 2654 retval = rename(szNewName, szTmpName); 2655 if (retval != 0) { 2656 errno = EACCES; 2657 return retval; 2658 } 2659 } 2660 2661 /* rename oname to newname */ 2662 retval = rename(szOldName, szNewName); 2663 2664 /* if we created a temporary file before ... */ 2665 if (endname != Nullch) { 2666 /* ...and rename succeeded, delete temporary file/directory */ 2667 if (retval == 0) 2668 DeleteFile(szTmpName); 2669 /* else restore it to what it was */ 2670 else 2671 (void)rename(szTmpName, szNewName); 2672 } 2673 return retval; 2674 } 2675 } 2676 2677 DllExport int 2678 win32_setmode(int fd, int mode) 2679 { 2680 return setmode(fd, mode); 2681 } 2682 2683 DllExport long 2684 win32_lseek(int fd, long offset, int origin) 2685 { 2686 return lseek(fd, offset, origin); 2687 } 2688 2689 DllExport long 2690 win32_tell(int fd) 2691 { 2692 return tell(fd); 2693 } 2694 2695 DllExport int 2696 win32_open(const char *path, int flag, ...) 2697 { 2698 dTHXo; 2699 va_list ap; 2700 int pmode; 2701 WCHAR wBuffer[MAX_PATH+1]; 2702 2703 va_start(ap, flag); 2704 pmode = va_arg(ap, int); 2705 va_end(ap); 2706 2707 if (stricmp(path, "/dev/null")==0) 2708 path = "NUL"; 2709 2710 if (USING_WIDE()) { 2711 A2WHELPER(path, wBuffer, sizeof(wBuffer)); 2712 return _wopen(PerlDir_mapW(wBuffer), flag, pmode); 2713 } 2714 return open(PerlDir_mapA(path), flag, pmode); 2715 } 2716 2717 DllExport int 2718 win32_close(int fd) 2719 { 2720 return close(fd); 2721 } 2722 2723 DllExport int 2724 win32_eof(int fd) 2725 { 2726 return eof(fd); 2727 } 2728 2729 DllExport int 2730 win32_dup(int fd) 2731 { 2732 return dup(fd); 2733 } 2734 2735 DllExport int 2736 win32_dup2(int fd1,int fd2) 2737 { 2738 return dup2(fd1,fd2); 2739 } 2740 2741 #ifdef PERL_MSVCRT_READFIX 2742 2743 #define LF 10 /* line feed */ 2744 #define CR 13 /* carriage return */ 2745 #define CTRLZ 26 /* ctrl-z means eof for text */ 2746 #define FOPEN 0x01 /* file handle open */ 2747 #define FEOFLAG 0x02 /* end of file has been encountered */ 2748 #define FCRLF 0x04 /* CR-LF across read buffer (in text mode) */ 2749 #define FPIPE 0x08 /* file handle refers to a pipe */ 2750 #define FAPPEND 0x20 /* file handle opened O_APPEND */ 2751 #define FDEV 0x40 /* file handle refers to device */ 2752 #define FTEXT 0x80 /* file handle is in text mode */ 2753 #define MAX_DESCRIPTOR_COUNT (64*32) /* this is the maximun that MSVCRT can handle */ 2754 2755 int __cdecl 2756 _fixed_read(int fh, void *buf, unsigned cnt) 2757 { 2758 int bytes_read; /* number of bytes read */ 2759 char *buffer; /* buffer to read to */ 2760 int os_read; /* bytes read on OS call */ 2761 char *p, *q; /* pointers into buffer */ 2762 char peekchr; /* peek-ahead character */ 2763 ULONG filepos; /* file position after seek */ 2764 ULONG dosretval; /* o.s. return value */ 2765 2766 /* validate handle */ 2767 if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) || 2768 !(_osfile(fh) & FOPEN)) 2769 { 2770 /* out of range -- return error */ 2771 errno = EBADF; 2772 _doserrno = 0; /* not o.s. error */ 2773 return -1; 2774 } 2775 2776 /* 2777 * If lockinitflag is FALSE, assume fd is device 2778 * lockinitflag is set to TRUE by open. 2779 */ 2780 if (_pioinfo(fh)->lockinitflag) 2781 EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */ 2782 2783 bytes_read = 0; /* nothing read yet */ 2784 buffer = (char*)buf; 2785 2786 if (cnt == 0 || (_osfile(fh) & FEOFLAG)) { 2787 /* nothing to read or at EOF, so return 0 read */ 2788 goto functionexit; 2789 } 2790 2791 if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) { 2792 /* a pipe/device and pipe lookahead non-empty: read the lookahead 2793 * char */ 2794 *buffer++ = _pipech(fh); 2795 ++bytes_read; 2796 --cnt; 2797 _pipech(fh) = LF; /* mark as empty */ 2798 } 2799 2800 /* read the data */ 2801 2802 if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL)) 2803 { 2804 /* ReadFile has reported an error. recognize two special cases. 2805 * 2806 * 1. map ERROR_ACCESS_DENIED to EBADF 2807 * 2808 * 2. just return 0 if ERROR_BROKEN_PIPE has occurred. it 2809 * means the handle is a read-handle on a pipe for which 2810 * all write-handles have been closed and all data has been 2811 * read. */ 2812 2813 if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) { 2814 /* wrong read/write mode should return EBADF, not EACCES */ 2815 errno = EBADF; 2816 _doserrno = dosretval; 2817 bytes_read = -1; 2818 goto functionexit; 2819 } 2820 else if (dosretval == ERROR_BROKEN_PIPE) { 2821 bytes_read = 0; 2822 goto functionexit; 2823 } 2824 else { 2825 bytes_read = -1; 2826 goto functionexit; 2827 } 2828 } 2829 2830 bytes_read += os_read; /* update bytes read */ 2831 2832 if (_osfile(fh) & FTEXT) { 2833 /* now must translate CR-LFs to LFs in the buffer */ 2834 2835 /* set CRLF flag to indicate LF at beginning of buffer */ 2836 /* if ((os_read != 0) && (*(char *)buf == LF)) */ 2837 /* _osfile(fh) |= FCRLF; */ 2838 /* else */ 2839 /* _osfile(fh) &= ~FCRLF; */ 2840 2841 _osfile(fh) &= ~FCRLF; 2842 2843 /* convert chars in the buffer: p is src, q is dest */ 2844 p = q = (char*)buf; 2845 while (p < (char *)buf + bytes_read) { 2846 if (*p == CTRLZ) { 2847 /* if fh is not a device, set ctrl-z flag */ 2848 if (!(_osfile(fh) & FDEV)) 2849 _osfile(fh) |= FEOFLAG; 2850 break; /* stop translating */ 2851 } 2852 else if (*p != CR) 2853 *q++ = *p++; 2854 else { 2855 /* *p is CR, so must check next char for LF */ 2856 if (p < (char *)buf + bytes_read - 1) { 2857 if (*(p+1) == LF) { 2858 p += 2; 2859 *q++ = LF; /* convert CR-LF to LF */ 2860 } 2861 else 2862 *q++ = *p++; /* store char normally */ 2863 } 2864 else { 2865 /* This is the hard part. We found a CR at end of 2866 buffer. We must peek ahead to see if next char 2867 is an LF. */ 2868 ++p; 2869 2870 dosretval = 0; 2871 if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1, 2872 (LPDWORD)&os_read, NULL)) 2873 dosretval = GetLastError(); 2874 2875 if (dosretval != 0 || os_read == 0) { 2876 /* couldn't read ahead, store CR */ 2877 *q++ = CR; 2878 } 2879 else { 2880 /* peekchr now has the extra character -- we now 2881 have several possibilities: 2882 1. disk file and char is not LF; just seek back 2883 and copy CR 2884 2. disk file and char is LF; store LF, don't seek back 2885 3. pipe/device and char is LF; store LF. 2886 4. pipe/device and char isn't LF, store CR and 2887 put char in pipe lookahead buffer. */ 2888 if (_osfile(fh) & (FDEV|FPIPE)) { 2889 /* non-seekable device */ 2890 if (peekchr == LF) 2891 *q++ = LF; 2892 else { 2893 *q++ = CR; 2894 _pipech(fh) = peekchr; 2895 } 2896 } 2897 else { 2898 /* disk file */ 2899 if (peekchr == LF) { 2900 /* nothing read yet; must make some 2901 progress */ 2902 *q++ = LF; 2903 /* turn on this flag for tell routine */ 2904 _osfile(fh) |= FCRLF; 2905 } 2906 else { 2907 HANDLE osHandle; /* o.s. handle value */ 2908 /* seek back */ 2909 if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1) 2910 { 2911 if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1) 2912 dosretval = GetLastError(); 2913 } 2914 if (peekchr != LF) 2915 *q++ = CR; 2916 } 2917 } 2918 } 2919 } 2920 } 2921 } 2922 2923 /* we now change bytes_read to reflect the true number of chars 2924 in the buffer */ 2925 bytes_read = q - (char *)buf; 2926 } 2927 2928 functionexit: 2929 if (_pioinfo(fh)->lockinitflag) 2930 LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ 2931 2932 return bytes_read; 2933 } 2934 2935 #endif /* PERL_MSVCRT_READFIX */ 2936 2937 DllExport int 2938 win32_read(int fd, void *buf, unsigned int cnt) 2939 { 2940 #ifdef PERL_MSVCRT_READFIX 2941 return _fixed_read(fd, buf, cnt); 2942 #else 2943 return read(fd, buf, cnt); 2944 #endif 2945 } 2946 2947 DllExport int 2948 win32_write(int fd, const void *buf, unsigned int cnt) 2949 { 2950 return write(fd, buf, cnt); 2951 } 2952 2953 DllExport int 2954 win32_mkdir(const char *dir, int mode) 2955 { 2956 dTHXo; 2957 if (USING_WIDE()) { 2958 WCHAR wBuffer[MAX_PATH+1]; 2959 A2WHELPER(dir, wBuffer, sizeof(wBuffer)); 2960 return _wmkdir(PerlDir_mapW(wBuffer)); 2961 } 2962 return mkdir(PerlDir_mapA(dir)); /* just ignore mode */ 2963 } 2964 2965 DllExport int 2966 win32_rmdir(const char *dir) 2967 { 2968 dTHXo; 2969 if (USING_WIDE()) { 2970 WCHAR wBuffer[MAX_PATH+1]; 2971 A2WHELPER(dir, wBuffer, sizeof(wBuffer)); 2972 return _wrmdir(PerlDir_mapW(wBuffer)); 2973 } 2974 return rmdir(PerlDir_mapA(dir)); 2975 } 2976 2977 DllExport int 2978 win32_chdir(const char *dir) 2979 { 2980 dTHXo; 2981 if (USING_WIDE()) { 2982 WCHAR wBuffer[MAX_PATH+1]; 2983 A2WHELPER(dir, wBuffer, sizeof(wBuffer)); 2984 return _wchdir(wBuffer); 2985 } 2986 return chdir(dir); 2987 } 2988 2989 DllExport int 2990 win32_access(const char *path, int mode) 2991 { 2992 dTHXo; 2993 if (USING_WIDE()) { 2994 WCHAR wBuffer[MAX_PATH+1]; 2995 A2WHELPER(path, wBuffer, sizeof(wBuffer)); 2996 return _waccess(PerlDir_mapW(wBuffer), mode); 2997 } 2998 return access(PerlDir_mapA(path), mode); 2999 } 3000 3001 DllExport int 3002 win32_chmod(const char *path, int mode) 3003 { 3004 dTHXo; 3005 if (USING_WIDE()) { 3006 WCHAR wBuffer[MAX_PATH+1]; 3007 A2WHELPER(path, wBuffer, sizeof(wBuffer)); 3008 return _wchmod(PerlDir_mapW(wBuffer), mode); 3009 } 3010 return chmod(PerlDir_mapA(path), mode); 3011 } 3012 3013 3014 static char * 3015 create_command_line(const char* command, const char * const *args) 3016 { 3017 dTHXo; 3018 int index; 3019 char *cmd, *ptr, *arg; 3020 STRLEN len = strlen(command) + 1; 3021 3022 for (index = 0; (ptr = (char*)args[index]) != NULL; ++index) 3023 len += strlen(ptr) + 1; 3024 3025 New(1310, cmd, len, char); 3026 ptr = cmd; 3027 strcpy(ptr, command); 3028 3029 for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { 3030 ptr += strlen(ptr); 3031 *ptr++ = ' '; 3032 strcpy(ptr, arg); 3033 } 3034 3035 return cmd; 3036 } 3037 3038 static char * 3039 qualified_path(const char *cmd) 3040 { 3041 dTHXo; 3042 char *pathstr; 3043 char *fullcmd, *curfullcmd; 3044 STRLEN cmdlen = 0; 3045 int has_slash = 0; 3046 3047 if (!cmd) 3048 return Nullch; 3049 fullcmd = (char*)cmd; 3050 while (*fullcmd) { 3051 if (*fullcmd == '/' || *fullcmd == '\\') 3052 has_slash++; 3053 fullcmd++; 3054 cmdlen++; 3055 } 3056 3057 /* look in PATH */ 3058 pathstr = win32_getenv("PATH"); 3059 New(0, fullcmd, MAX_PATH+1, char); 3060 curfullcmd = fullcmd; 3061 3062 while (1) { 3063 DWORD res; 3064 3065 /* start by appending the name to the current prefix */ 3066 strcpy(curfullcmd, cmd); 3067 curfullcmd += cmdlen; 3068 3069 /* if it doesn't end with '.', or has no extension, try adding 3070 * a trailing .exe first */ 3071 if (cmd[cmdlen-1] != '.' 3072 && (cmdlen < 4 || cmd[cmdlen-4] != '.')) 3073 { 3074 strcpy(curfullcmd, ".exe"); 3075 res = GetFileAttributes(fullcmd); 3076 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) 3077 return fullcmd; 3078 *curfullcmd = '\0'; 3079 } 3080 3081 /* that failed, try the bare name */ 3082 res = GetFileAttributes(fullcmd); 3083 if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) 3084 return fullcmd; 3085 3086 /* quit if no other path exists, or if cmd already has path */ 3087 if (!pathstr || !*pathstr || has_slash) 3088 break; 3089 3090 /* skip leading semis */ 3091 while (*pathstr == ';') 3092 pathstr++; 3093 3094 /* build a new prefix from scratch */ 3095 curfullcmd = fullcmd; 3096 while (*pathstr && *pathstr != ';') { 3097 if (*pathstr == '"') { /* foo;"baz;etc";bar */ 3098 pathstr++; /* skip initial '"' */ 3099 while (*pathstr && *pathstr != '"') { 3100 if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) 3101 *curfullcmd++ = *pathstr; 3102 pathstr++; 3103 } 3104 if (*pathstr) 3105 pathstr++; /* skip trailing '"' */ 3106 } 3107 else { 3108 if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) 3109 *curfullcmd++ = *pathstr; 3110 pathstr++; 3111 } 3112 } 3113 if (*pathstr) 3114 pathstr++; /* skip trailing semi */ 3115 if (curfullcmd > fullcmd /* append a dir separator */ 3116 && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\') 3117 { 3118 *curfullcmd++ = '\\'; 3119 } 3120 } 3121 GIVE_UP: 3122 Safefree(fullcmd); 3123 return Nullch; 3124 } 3125 3126 /* The following are just place holders. 3127 * Some hosts may provide and environment that the OS is 3128 * not tracking, therefore, these host must provide that 3129 * environment and the current directory to CreateProcess 3130 */ 3131 3132 void* 3133 get_childenv(void) 3134 { 3135 return NULL; 3136 } 3137 3138 void 3139 free_childenv(void* d) 3140 { 3141 } 3142 3143 char* 3144 get_childdir(void) 3145 { 3146 dTHXo; 3147 char* ptr; 3148 char szfilename[(MAX_PATH+1)*2]; 3149 if (USING_WIDE()) { 3150 WCHAR wfilename[MAX_PATH+1]; 3151 GetCurrentDirectoryW(MAX_PATH+1, wfilename); 3152 W2AHELPER(wfilename, szfilename, sizeof(szfilename)); 3153 } 3154 else { 3155 GetCurrentDirectoryA(MAX_PATH+1, szfilename); 3156 } 3157 3158 New(0, ptr, strlen(szfilename)+1, char); 3159 strcpy(ptr, szfilename); 3160 return ptr; 3161 } 3162 3163 void 3164 free_childdir(char* d) 3165 { 3166 dTHXo; 3167 Safefree(d); 3168 } 3169 3170 3171 /* XXX this needs to be made more compatible with the spawnvp() 3172 * provided by the various RTLs. In particular, searching for 3173 * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented. 3174 * This doesn't significantly affect perl itself, because we 3175 * always invoke things using PERL5SHELL if a direct attempt to 3176 * spawn the executable fails. 3177 * 3178 * XXX splitting and rejoining the commandline between do_aspawn() 3179 * and win32_spawnvp() could also be avoided. 3180 */ 3181 3182 DllExport int 3183 win32_spawnvp(int mode, const char *cmdname, const char *const *argv) 3184 { 3185 #ifdef USE_RTL_SPAWNVP 3186 return spawnvp(mode, cmdname, (char * const *)argv); 3187 #else 3188 dTHXo; 3189 int ret; 3190 void* env; 3191 char* dir; 3192 child_IO_table tbl; 3193 STARTUPINFO StartupInfo; 3194 PROCESS_INFORMATION ProcessInformation; 3195 DWORD create = 0; 3196 3197 char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0 3198 ? &argv[1] : argv); 3199 char *fullcmd = Nullch; 3200 3201 env = PerlEnv_get_childenv(); 3202 dir = PerlEnv_get_childdir(); 3203 3204 switch(mode) { 3205 case P_NOWAIT: /* asynch + remember result */ 3206 if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) { 3207 errno = EAGAIN; 3208 ret = -1; 3209 goto RETVAL; 3210 } 3211 /* FALL THROUGH */ 3212 case P_WAIT: /* synchronous execution */ 3213 break; 3214 default: /* invalid mode */ 3215 errno = EINVAL; 3216 ret = -1; 3217 goto RETVAL; 3218 } 3219 memset(&StartupInfo,0,sizeof(StartupInfo)); 3220 StartupInfo.cb = sizeof(StartupInfo); 3221 memset(&tbl,0,sizeof(tbl)); 3222 PerlEnv_get_child_IO(&tbl); 3223 StartupInfo.dwFlags = tbl.dwFlags; 3224 StartupInfo.dwX = tbl.dwX; 3225 StartupInfo.dwY = tbl.dwY; 3226 StartupInfo.dwXSize = tbl.dwXSize; 3227 StartupInfo.dwYSize = tbl.dwYSize; 3228 StartupInfo.dwXCountChars = tbl.dwXCountChars; 3229 StartupInfo.dwYCountChars = tbl.dwYCountChars; 3230 StartupInfo.dwFillAttribute = tbl.dwFillAttribute; 3231 StartupInfo.wShowWindow = tbl.wShowWindow; 3232 StartupInfo.hStdInput = tbl.childStdIn; 3233 StartupInfo.hStdOutput = tbl.childStdOut; 3234 StartupInfo.hStdError = tbl.childStdErr; 3235 if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE && 3236 StartupInfo.hStdOutput != INVALID_HANDLE_VALUE && 3237 StartupInfo.hStdError != INVALID_HANDLE_VALUE) 3238 { 3239 StartupInfo.dwFlags |= STARTF_USESTDHANDLES; 3240 } 3241 else { 3242 create |= CREATE_NEW_CONSOLE; 3243 } 3244 3245 RETRY: 3246 if (!CreateProcess(cmdname, /* search PATH to find executable */ 3247 cmd, /* executable, and its arguments */ 3248 NULL, /* process attributes */ 3249 NULL, /* thread attributes */ 3250 TRUE, /* inherit handles */ 3251 create, /* creation flags */ 3252 (LPVOID)env, /* inherit environment */ 3253 dir, /* inherit cwd */ 3254 &StartupInfo, 3255 &ProcessInformation)) 3256 { 3257 /* initial NULL argument to CreateProcess() does a PATH 3258 * search, but it always first looks in the directory 3259 * where the current process was started, which behavior 3260 * is undesirable for backward compatibility. So we 3261 * jump through our own hoops by picking out the path 3262 * we really want it to use. */ 3263 if (!fullcmd) { 3264 fullcmd = qualified_path(cmdname); 3265 if (fullcmd) { 3266 cmdname = fullcmd; 3267 goto RETRY; 3268 } 3269 } 3270 errno = ENOENT; 3271 ret = -1; 3272 goto RETVAL; 3273 } 3274 3275 if (mode == P_NOWAIT) { 3276 /* asynchronous spawn -- store handle, return PID */ 3277 ret = (int)ProcessInformation.dwProcessId; 3278 if (IsWin95() && ret < 0) 3279 ret = -ret; 3280 3281 w32_child_handles[w32_num_children] = ProcessInformation.hProcess; 3282 w32_child_pids[w32_num_children] = (DWORD)ret; 3283 ++w32_num_children; 3284 } 3285 else { 3286 DWORD status; 3287 WaitForSingleObject(ProcessInformation.hProcess, INFINITE); 3288 GetExitCodeProcess(ProcessInformation.hProcess, &status); 3289 ret = (int)status; 3290 CloseHandle(ProcessInformation.hProcess); 3291 } 3292 3293 CloseHandle(ProcessInformation.hThread); 3294 3295 RETVAL: 3296 PerlEnv_free_childenv(env); 3297 PerlEnv_free_childdir(dir); 3298 Safefree(cmd); 3299 Safefree(fullcmd); 3300 return ret; 3301 #endif 3302 } 3303 3304 DllExport int 3305 win32_execv(const char *cmdname, const char *const *argv) 3306 { 3307 #ifdef USE_ITHREADS 3308 dTHXo; 3309 /* if this is a pseudo-forked child, we just want to spawn 3310 * the new program, and return */ 3311 if (w32_pseudo_id) 3312 return spawnv(P_WAIT, cmdname, (char *const *)argv); 3313 #endif 3314 return execv(cmdname, (char *const *)argv); 3315 } 3316 3317 DllExport int 3318 win32_execvp(const char *cmdname, const char *const *argv) 3319 { 3320 #ifdef USE_ITHREADS 3321 dTHXo; 3322 /* if this is a pseudo-forked child, we just want to spawn 3323 * the new program, and return */ 3324 if (w32_pseudo_id) 3325 return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv); 3326 #endif 3327 return execvp(cmdname, (char *const *)argv); 3328 } 3329 3330 DllExport void 3331 win32_perror(const char *str) 3332 { 3333 perror(str); 3334 } 3335 3336 DllExport void 3337 win32_setbuf(FILE *pf, char *buf) 3338 { 3339 setbuf(pf, buf); 3340 } 3341 3342 DllExport int 3343 win32_setvbuf(FILE *pf, char *buf, int type, size_t size) 3344 { 3345 return setvbuf(pf, buf, type, size); 3346 } 3347 3348 DllExport int 3349 win32_flushall(void) 3350 { 3351 return flushall(); 3352 } 3353 3354 DllExport int 3355 win32_fcloseall(void) 3356 { 3357 return fcloseall(); 3358 } 3359 3360 DllExport char* 3361 win32_fgets(char *s, int n, FILE *pf) 3362 { 3363 return fgets(s, n, pf); 3364 } 3365 3366 DllExport char* 3367 win32_gets(char *s) 3368 { 3369 return gets(s); 3370 } 3371 3372 DllExport int 3373 win32_fgetc(FILE *pf) 3374 { 3375 return fgetc(pf); 3376 } 3377 3378 DllExport int 3379 win32_putc(int c, FILE *pf) 3380 { 3381 return putc(c,pf); 3382 } 3383 3384 DllExport int 3385 win32_puts(const char *s) 3386 { 3387 return puts(s); 3388 } 3389 3390 DllExport int 3391 win32_getchar(void) 3392 { 3393 return getchar(); 3394 } 3395 3396 DllExport int 3397 win32_putchar(int c) 3398 { 3399 return putchar(c); 3400 } 3401 3402 #ifdef MYMALLOC 3403 3404 #ifndef USE_PERL_SBRK 3405 3406 static char *committed = NULL; 3407 static char *base = NULL; 3408 static char *reserved = NULL; 3409 static char *brk = NULL; 3410 static DWORD pagesize = 0; 3411 static DWORD allocsize = 0; 3412 3413 void * 3414 sbrk(int need) 3415 { 3416 void *result; 3417 if (!pagesize) 3418 {SYSTEM_INFO info; 3419 GetSystemInfo(&info); 3420 /* Pretend page size is larger so we don't perpetually 3421 * call the OS to commit just one page ... 3422 */ 3423 pagesize = info.dwPageSize << 3; 3424 allocsize = info.dwAllocationGranularity; 3425 } 3426 /* This scheme fails eventually if request for contiguous 3427 * block is denied so reserve big blocks - this is only 3428 * address space not memory ... 3429 */ 3430 if (brk+need >= reserved) 3431 { 3432 DWORD size = 64*1024*1024; 3433 char *addr; 3434 if (committed && reserved && committed < reserved) 3435 { 3436 /* Commit last of previous chunk cannot span allocations */ 3437 addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE); 3438 if (addr) 3439 committed = reserved; 3440 } 3441 /* Reserve some (more) space 3442 * Note this is a little sneaky, 1st call passes NULL as reserved 3443 * so lets system choose where we start, subsequent calls pass 3444 * the old end address so ask for a contiguous block 3445 */ 3446 addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS); 3447 if (addr) 3448 { 3449 reserved = addr+size; 3450 if (!base) 3451 base = addr; 3452 if (!committed) 3453 committed = base; 3454 if (!brk) 3455 brk = committed; 3456 } 3457 else 3458 { 3459 return (void *) -1; 3460 } 3461 } 3462 result = brk; 3463 brk += need; 3464 if (brk > committed) 3465 { 3466 DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize; 3467 char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); 3468 if (addr) 3469 { 3470 committed += size; 3471 } 3472 else 3473 return (void *) -1; 3474 } 3475 return result; 3476 } 3477 3478 #endif 3479 #endif 3480 3481 DllExport void* 3482 win32_malloc(size_t size) 3483 { 3484 return malloc(size); 3485 } 3486 3487 DllExport void* 3488 win32_calloc(size_t numitems, size_t size) 3489 { 3490 return calloc(numitems,size); 3491 } 3492 3493 DllExport void* 3494 win32_realloc(void *block, size_t size) 3495 { 3496 return realloc(block,size); 3497 } 3498 3499 DllExport void 3500 win32_free(void *block) 3501 { 3502 free(block); 3503 } 3504 3505 3506 int 3507 win32_open_osfhandle(long handle, int flags) 3508 { 3509 #ifdef USE_FIXED_OSFHANDLE 3510 if (IsWin95()) 3511 return my_open_osfhandle(handle, flags); 3512 #endif 3513 return _open_osfhandle(handle, flags); 3514 } 3515 3516 long 3517 win32_get_osfhandle(int fd) 3518 { 3519 return _get_osfhandle(fd); 3520 } 3521 3522 DllExport void* 3523 win32_dynaload(const char* filename) 3524 { 3525 dTHXo; 3526 HMODULE hModule; 3527 char buf[MAX_PATH+1]; 3528 char *first; 3529 3530 /* LoadLibrary() doesn't recognize forward slashes correctly, 3531 * so turn 'em back. */ 3532 first = strchr(filename, '/'); 3533 if (first) { 3534 STRLEN len = strlen(filename); 3535 if (len <= MAX_PATH) { 3536 strcpy(buf, filename); 3537 filename = &buf[first - filename]; 3538 while (*filename) { 3539 if (*filename == '/') 3540 *(char*)filename = '\\'; 3541 ++filename; 3542 } 3543 filename = buf; 3544 } 3545 } 3546 if (USING_WIDE()) { 3547 WCHAR wfilename[MAX_PATH+1]; 3548 A2WHELPER(filename, wfilename, sizeof(wfilename)); 3549 hModule = LoadLibraryExW(PerlDir_mapW(wfilename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH); 3550 } 3551 else { 3552 hModule = LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH); 3553 } 3554 return hModule; 3555 } 3556 3557 /* 3558 * Extras. 3559 */ 3560 3561 static 3562 XS(w32_GetCwd) 3563 { 3564 dXSARGS; 3565 /* Make the host for current directory */ 3566 char* ptr = PerlEnv_get_childdir(); 3567 /* 3568 * If ptr != Nullch 3569 * then it worked, set PV valid, 3570 * else return 'undef' 3571 */ 3572 if (ptr) { 3573 SV *sv = sv_newmortal(); 3574 sv_setpv(sv, ptr); 3575 PerlEnv_free_childdir(ptr); 3576 3577 EXTEND(SP,1); 3578 SvPOK_on(sv); 3579 ST(0) = sv; 3580 XSRETURN(1); 3581 } 3582 XSRETURN_UNDEF; 3583 } 3584 3585 static 3586 XS(w32_SetCwd) 3587 { 3588 dXSARGS; 3589 if (items != 1) 3590 Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)"); 3591 if (!PerlDir_chdir(SvPV_nolen(ST(0)))) 3592 XSRETURN_YES; 3593 3594 XSRETURN_NO; 3595 } 3596 3597 static 3598 XS(w32_GetNextAvailDrive) 3599 { 3600 dXSARGS; 3601 char ix = 'C'; 3602 char root[] = "_:\\"; 3603 3604 EXTEND(SP,1); 3605 while (ix <= 'Z') { 3606 root[0] = ix++; 3607 if (GetDriveType(root) == 1) { 3608 root[2] = '\0'; 3609 XSRETURN_PV(root); 3610 } 3611 } 3612 XSRETURN_UNDEF; 3613 } 3614 3615 static 3616 XS(w32_GetLastError) 3617 { 3618 dXSARGS; 3619 EXTEND(SP,1); 3620 XSRETURN_IV(GetLastError()); 3621 } 3622 3623 static 3624 XS(w32_SetLastError) 3625 { 3626 dXSARGS; 3627 if (items != 1) 3628 Perl_croak(aTHX_ "usage: Win32::SetLastError($error)"); 3629 SetLastError(SvIV(ST(0))); 3630 XSRETURN_EMPTY; 3631 } 3632 3633 static 3634 XS(w32_LoginName) 3635 { 3636 dXSARGS; 3637 char *name = w32_getlogin_buffer; 3638 DWORD size = sizeof(w32_getlogin_buffer); 3639 EXTEND(SP,1); 3640 if (GetUserName(name,&size)) { 3641 /* size includes NULL */ 3642 ST(0) = sv_2mortal(newSVpvn(name,size-1)); 3643 XSRETURN(1); 3644 } 3645 XSRETURN_UNDEF; 3646 } 3647 3648 static 3649 XS(w32_NodeName) 3650 { 3651 dXSARGS; 3652 char name[MAX_COMPUTERNAME_LENGTH+1]; 3653 DWORD size = sizeof(name); 3654 EXTEND(SP,1); 3655 if (GetComputerName(name,&size)) { 3656 /* size does NOT include NULL :-( */ 3657 ST(0) = sv_2mortal(newSVpvn(name,size)); 3658 XSRETURN(1); 3659 } 3660 XSRETURN_UNDEF; 3661 } 3662 3663 3664 static 3665 XS(w32_DomainName) 3666 { 3667 dXSARGS; 3668 HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll"); 3669 DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer); 3670 DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level, 3671 void *bufptr); 3672 3673 if (hNetApi32) { 3674 pfnNetApiBufferFree = (DWORD (__stdcall *)(void *)) 3675 GetProcAddress(hNetApi32, "NetApiBufferFree"); 3676 pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *)) 3677 GetProcAddress(hNetApi32, "NetWkstaGetInfo"); 3678 } 3679 EXTEND(SP,1); 3680 if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) { 3681 /* this way is more reliable, in case user has a local account. */ 3682 char dname[256]; 3683 DWORD dnamelen = sizeof(dname); 3684 struct { 3685 DWORD wki100_platform_id; 3686 LPWSTR wki100_computername; 3687 LPWSTR wki100_langroup; 3688 DWORD wki100_ver_major; 3689 DWORD wki100_ver_minor; 3690 } *pwi; 3691 /* NERR_Success *is* 0*/ 3692 if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) { 3693 if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { 3694 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup, 3695 -1, (LPSTR)dname, dnamelen, NULL, NULL); 3696 } 3697 else { 3698 WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername, 3699 -1, (LPSTR)dname, dnamelen, NULL, NULL); 3700 } 3701 pfnNetApiBufferFree(pwi); 3702 FreeLibrary(hNetApi32); 3703 XSRETURN_PV(dname); 3704 } 3705 FreeLibrary(hNetApi32); 3706 } 3707 else { 3708 /* Win95 doesn't have NetWksta*(), so do it the old way */ 3709 char name[256]; 3710 DWORD size = sizeof(name); 3711 if (hNetApi32) 3712 FreeLibrary(hNetApi32); 3713 if (GetUserName(name,&size)) { 3714 char sid[ONE_K_BUFSIZE]; 3715 DWORD sidlen = sizeof(sid); 3716 char dname[256]; 3717 DWORD dnamelen = sizeof(dname); 3718 SID_NAME_USE snu; 3719 if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen, 3720 dname, &dnamelen, &snu)) { 3721 XSRETURN_PV(dname); /* all that for this */ 3722 } 3723 } 3724 } 3725 XSRETURN_UNDEF; 3726 } 3727 3728 static 3729 XS(w32_FsType) 3730 { 3731 dXSARGS; 3732 char fsname[256]; 3733 DWORD flags, filecomplen; 3734 if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen, 3735 &flags, fsname, sizeof(fsname))) { 3736 if (GIMME_V == G_ARRAY) { 3737 XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname)))); 3738 XPUSHs(sv_2mortal(newSViv(flags))); 3739 XPUSHs(sv_2mortal(newSViv(filecomplen))); 3740 PUTBACK; 3741 return; 3742 } 3743 EXTEND(SP,1); 3744 XSRETURN_PV(fsname); 3745 } 3746 XSRETURN_EMPTY; 3747 } 3748 3749 static 3750 XS(w32_GetOSVersion) 3751 { 3752 dXSARGS; 3753 OSVERSIONINFOA osver; 3754 3755 if (USING_WIDE()) { 3756 OSVERSIONINFOW osverw; 3757 char szCSDVersion[sizeof(osverw.szCSDVersion)]; 3758 osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); 3759 if (!GetVersionExW(&osverw)) { 3760 XSRETURN_EMPTY; 3761 } 3762 W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion)); 3763 XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion))); 3764 osver.dwMajorVersion = osverw.dwMajorVersion; 3765 osver.dwMinorVersion = osverw.dwMinorVersion; 3766 osver.dwBuildNumber = osverw.dwBuildNumber; 3767 osver.dwPlatformId = osverw.dwPlatformId; 3768 } 3769 else { 3770 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); 3771 if (!GetVersionExA(&osver)) { 3772 XSRETURN_EMPTY; 3773 } 3774 XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion))); 3775 } 3776 XPUSHs(newSViv(osver.dwMajorVersion)); 3777 XPUSHs(newSViv(osver.dwMinorVersion)); 3778 XPUSHs(newSViv(osver.dwBuildNumber)); 3779 XPUSHs(newSViv(osver.dwPlatformId)); 3780 PUTBACK; 3781 } 3782 3783 static 3784 XS(w32_IsWinNT) 3785 { 3786 dXSARGS; 3787 EXTEND(SP,1); 3788 XSRETURN_IV(IsWinNT()); 3789 } 3790 3791 static 3792 XS(w32_IsWin95) 3793 { 3794 dXSARGS; 3795 EXTEND(SP,1); 3796 XSRETURN_IV(IsWin95()); 3797 } 3798 3799 static 3800 XS(w32_FormatMessage) 3801 { 3802 dXSARGS; 3803 DWORD source = 0; 3804 char msgbuf[ONE_K_BUFSIZE]; 3805 3806 if (items != 1) 3807 Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)"); 3808 3809 if (USING_WIDE()) { 3810 WCHAR wmsgbuf[ONE_K_BUFSIZE]; 3811 if (FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, 3812 &source, SvIV(ST(0)), 0, 3813 wmsgbuf, ONE_K_BUFSIZE-1, NULL)) 3814 { 3815 W2AHELPER(wmsgbuf, msgbuf, sizeof(msgbuf)); 3816 XSRETURN_PV(msgbuf); 3817 } 3818 } 3819 else { 3820 if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, 3821 &source, SvIV(ST(0)), 0, 3822 msgbuf, sizeof(msgbuf)-1, NULL)) 3823 XSRETURN_PV(msgbuf); 3824 } 3825 3826 XSRETURN_UNDEF; 3827 } 3828 3829 static 3830 XS(w32_Spawn) 3831 { 3832 dXSARGS; 3833 char *cmd, *args; 3834 PROCESS_INFORMATION stProcInfo; 3835 STARTUPINFO stStartInfo; 3836 BOOL bSuccess = FALSE; 3837 3838 if (items != 3) 3839 Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)"); 3840 3841 cmd = SvPV_nolen(ST(0)); 3842 args = SvPV_nolen(ST(1)); 3843 3844 memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */ 3845 stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */ 3846 stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */ 3847 stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */ 3848 3849 if (CreateProcess( 3850 cmd, /* Image path */ 3851 args, /* Arguments for command line */ 3852 NULL, /* Default process security */ 3853 NULL, /* Default thread security */ 3854 FALSE, /* Must be TRUE to use std handles */ 3855 NORMAL_PRIORITY_CLASS, /* No special scheduling */ 3856 NULL, /* Inherit our environment block */ 3857 NULL, /* Inherit our currrent directory */ 3858 &stStartInfo, /* -> Startup info */ 3859 &stProcInfo)) /* <- Process info (if OK) */ 3860 { 3861 int pid = (int)stProcInfo.dwProcessId; 3862 if (IsWin95() && pid < 0) 3863 pid = -pid; 3864 sv_setiv(ST(2), pid); 3865 CloseHandle(stProcInfo.hThread);/* library source code does this. */ 3866 bSuccess = TRUE; 3867 } 3868 XSRETURN_IV(bSuccess); 3869 } 3870 3871 static 3872 XS(w32_GetTickCount) 3873 { 3874 dXSARGS; 3875 DWORD msec = GetTickCount(); 3876 EXTEND(SP,1); 3877 if ((IV)msec > 0) 3878 XSRETURN_IV(msec); 3879 XSRETURN_NV(msec); 3880 } 3881 3882 static 3883 XS(w32_GetShortPathName) 3884 { 3885 dXSARGS; 3886 SV *shortpath; 3887 DWORD len; 3888 3889 if (items != 1) 3890 Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)"); 3891 3892 shortpath = sv_mortalcopy(ST(0)); 3893 SvUPGRADE(shortpath, SVt_PV); 3894 if (!SvPVX(shortpath) || !SvLEN(shortpath)) 3895 XSRETURN_UNDEF; 3896 3897 /* src == target is allowed */ 3898 do { 3899 len = GetShortPathName(SvPVX(shortpath), 3900 SvPVX(shortpath), 3901 SvLEN(shortpath)); 3902 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1)); 3903 if (len) { 3904 SvCUR_set(shortpath,len); 3905 ST(0) = shortpath; 3906 XSRETURN(1); 3907 } 3908 XSRETURN_UNDEF; 3909 } 3910 3911 static 3912 XS(w32_GetFullPathName) 3913 { 3914 dXSARGS; 3915 SV *filename; 3916 SV *fullpath; 3917 char *filepart; 3918 DWORD len; 3919 3920 if (items != 1) 3921 Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)"); 3922 3923 filename = ST(0); 3924 fullpath = sv_mortalcopy(filename); 3925 SvUPGRADE(fullpath, SVt_PV); 3926 if (!SvPVX(fullpath) || !SvLEN(fullpath)) 3927 XSRETURN_UNDEF; 3928 3929 do { 3930 len = GetFullPathName(SvPVX(filename), 3931 SvLEN(fullpath), 3932 SvPVX(fullpath), 3933 &filepart); 3934 } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1)); 3935 if (len) { 3936 if (GIMME_V == G_ARRAY) { 3937 EXTEND(SP,1); 3938 XST_mPV(1,filepart); 3939 len = filepart - SvPVX(fullpath); 3940 items = 2; 3941 } 3942 SvCUR_set(fullpath,len); 3943 ST(0) = fullpath; 3944 XSRETURN(items); 3945 } 3946 XSRETURN_EMPTY; 3947 } 3948 3949 static 3950 XS(w32_GetLongPathName) 3951 { 3952 dXSARGS; 3953 SV *path; 3954 char tmpbuf[MAX_PATH+1]; 3955 char *pathstr; 3956 STRLEN len; 3957 3958 if (items != 1) 3959 Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)"); 3960 3961 path = ST(0); 3962 pathstr = SvPV(path,len); 3963 strcpy(tmpbuf, pathstr); 3964 pathstr = win32_longpath(tmpbuf); 3965 if (pathstr) { 3966 ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr))); 3967 XSRETURN(1); 3968 } 3969 XSRETURN_EMPTY; 3970 } 3971 3972 static 3973 XS(w32_Sleep) 3974 { 3975 dXSARGS; 3976 if (items != 1) 3977 Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)"); 3978 Sleep(SvIV(ST(0))); 3979 XSRETURN_YES; 3980 } 3981 3982 static 3983 XS(w32_CopyFile) 3984 { 3985 dXSARGS; 3986 BOOL bResult; 3987 if (items != 3) 3988 Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)"); 3989 if (USING_WIDE()) { 3990 WCHAR wSourceFile[MAX_PATH+1]; 3991 WCHAR wDestFile[MAX_PATH+1]; 3992 A2WHELPER(SvPV_nolen(ST(0)), wSourceFile, sizeof(wSourceFile)); 3993 wcscpy(wSourceFile, PerlDir_mapW(wSourceFile)); 3994 A2WHELPER(SvPV_nolen(ST(1)), wDestFile, sizeof(wDestFile)); 3995 bResult = CopyFileW(wSourceFile, PerlDir_mapW(wDestFile), !SvTRUE(ST(2))); 3996 } 3997 else { 3998 char szSourceFile[MAX_PATH+1]; 3999 strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0)))); 4000 bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2))); 4001 } 4002 4003 if (bResult) 4004 XSRETURN_YES; 4005 XSRETURN_NO; 4006 } 4007 4008 void 4009 Perl_init_os_extras(void) 4010 { 4011 dTHXo; 4012 char *file = __FILE__; 4013 dXSUB_SYS; 4014 4015 /* these names are Activeware compatible */ 4016 newXS("Win32::GetCwd", w32_GetCwd, file); 4017 newXS("Win32::SetCwd", w32_SetCwd, file); 4018 newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file); 4019 newXS("Win32::GetLastError", w32_GetLastError, file); 4020 newXS("Win32::SetLastError", w32_SetLastError, file); 4021 newXS("Win32::LoginName", w32_LoginName, file); 4022 newXS("Win32::NodeName", w32_NodeName, file); 4023 newXS("Win32::DomainName", w32_DomainName, file); 4024 newXS("Win32::FsType", w32_FsType, file); 4025 newXS("Win32::GetOSVersion", w32_GetOSVersion, file); 4026 newXS("Win32::IsWinNT", w32_IsWinNT, file); 4027 newXS("Win32::IsWin95", w32_IsWin95, file); 4028 newXS("Win32::FormatMessage", w32_FormatMessage, file); 4029 newXS("Win32::Spawn", w32_Spawn, file); 4030 newXS("Win32::GetTickCount", w32_GetTickCount, file); 4031 newXS("Win32::GetShortPathName", w32_GetShortPathName, file); 4032 newXS("Win32::GetFullPathName", w32_GetFullPathName, file); 4033 newXS("Win32::GetLongPathName", w32_GetLongPathName, file); 4034 newXS("Win32::CopyFile", w32_CopyFile, file); 4035 newXS("Win32::Sleep", w32_Sleep, file); 4036 4037 /* XXX Bloat Alert! The following Activeware preloads really 4038 * ought to be part of Win32::Sys::*, so they're not included 4039 * here. 4040 */ 4041 /* LookupAccountName 4042 * LookupAccountSID 4043 * InitiateSystemShutdown 4044 * AbortSystemShutdown 4045 * ExpandEnvrironmentStrings 4046 */ 4047 } 4048 4049 void 4050 Perl_win32_init(int *argcp, char ***argvp) 4051 { 4052 /* Disable floating point errors, Perl will trap the ones we 4053 * care about. VC++ RTL defaults to switching these off 4054 * already, but the Borland RTL doesn't. Since we don't 4055 * want to be at the vendor's whim on the default, we set 4056 * it explicitly here. 4057 */ 4058 #if !defined(_ALPHA_) && !defined(__GNUC__) 4059 _control87(MCW_EM, MCW_EM); 4060 #endif 4061 MALLOC_INIT; 4062 } 4063 4064 void 4065 win32_get_child_IO(child_IO_table* ptbl) 4066 { 4067 ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE); 4068 ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE); 4069 ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE); 4070 } 4071 4072 #ifdef HAVE_INTERP_INTERN 4073 4074 # ifdef PERL_OBJECT 4075 # undef Perl_sys_intern_init 4076 # define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init 4077 # undef Perl_sys_intern_dup 4078 # define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup 4079 # undef Perl_sys_intern_clear 4080 # define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear 4081 # define pPerl this 4082 # endif 4083 4084 void 4085 Perl_sys_intern_init(pTHX) 4086 { 4087 w32_perlshell_tokens = Nullch; 4088 w32_perlshell_vec = (char**)NULL; 4089 w32_perlshell_items = 0; 4090 w32_fdpid = newAV(); 4091 New(1313, w32_children, 1, child_tab); 4092 w32_num_children = 0; 4093 # ifdef USE_ITHREADS 4094 w32_pseudo_id = 0; 4095 New(1313, w32_pseudo_children, 1, child_tab); 4096 w32_num_pseudo_children = 0; 4097 # endif 4098 w32_init_socktype = 0; 4099 } 4100 4101 void 4102 Perl_sys_intern_clear(pTHX) 4103 { 4104 Safefree(w32_perlshell_tokens); 4105 Safefree(w32_perlshell_vec); 4106 /* NOTE: w32_fdpid is freed by sv_clean_all() */ 4107 Safefree(w32_children); 4108 # ifdef USE_ITHREADS 4109 Safefree(w32_pseudo_children); 4110 # endif 4111 } 4112 4113 # ifdef USE_ITHREADS 4114 4115 void 4116 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) 4117 { 4118 dst->perlshell_tokens = Nullch; 4119 dst->perlshell_vec = (char**)NULL; 4120 dst->perlshell_items = 0; 4121 dst->fdpid = newAV(); 4122 Newz(1313, dst->children, 1, child_tab); 4123 dst->pseudo_id = 0; 4124 Newz(1313, dst->pseudo_children, 1, child_tab); 4125 dst->thr_intern.Winit_socktype = 0; 4126 } 4127 # endif /* USE_ITHREADS */ 4128 #endif /* HAVE_INTERP_INTERN */ 4129 4130 #ifdef PERL_OBJECT 4131 # undef this 4132 # define this pPerl 4133 #endif 4134 4135 static void 4136 win32_free_argvw(pTHXo_ void *ptr) 4137 { 4138 char** argv = (char**)ptr; 4139 while(*argv) { 4140 Safefree(*argv); 4141 *argv++ = Nullch; 4142 } 4143 } 4144 4145 void 4146 win32_argv2utf8(int argc, char** argv) 4147 { 4148 dTHXo; 4149 char* psz; 4150 int length, wargc; 4151 LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc); 4152 if (lpwStr && argc) { 4153 while (argc--) { 4154 length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL); 4155 Newz(0, psz, length, char); 4156 WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL); 4157 argv[argc] = psz; 4158 } 4159 call_atexit(win32_free_argvw, argv); 4160 } 4161 GlobalFree((HGLOBAL)lpwStr); 4162 } 4163 4164