win32/win32.c

   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 #define PERLIO_NOT_STDIO 0
  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 HWND_MESSAGE
  19 #  define HWND_MESSAGE     ((HWND)-3)
  20 #endif
  21 #ifndef WC_NO_BEST_FIT_CHARS
  22 #  define WC_NO_BEST_FIT_CHARS 0x00000400
  23 #endif
  24 #include <winnt.h>
  25 #include <tlhelp32.h>
  26 #include <io.h>
  27 #include <signal.h>
  28
  29 #define SystemProcessesAndThreadsInformation 5
  30
  31 /* Inline some definitions from the DDK */
  32 typedef struct {
  33     USHORT          Length;
  34     USHORT          MaximumLength;
  35     PWSTR           Buffer;
  36 }   UNICODE_STRING;
  37
  38 typedef struct {
  39     ULONG           NextEntryDelta;
  40     ULONG           ThreadCount;
  41     ULONG           Reserved1[6];
  42     LARGE_INTEGER   CreateTime;
  43     LARGE_INTEGER   UserTime;
  44     LARGE_INTEGER   KernelTime;
  45     UNICODE_STRING  ProcessName;
  46     LONG            BasePriority;
  47     ULONG           ProcessId;
  48     ULONG           InheritedFromProcessId;
  49     /* Remainder of the structure depends on the Windows version,
  50      * but we don't need those additional fields anyways... */
  51 }   SYSTEM_PROCESSES;
  52
  53 /* #include "config.h" */
  54
  55 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
  56 #define PerlIO FILE
  57 #endif
  58
  59 #include <sys/stat.h>
  60 #include "EXTERN.h"
  61 #include "perl.h"
  62
  63 /* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
  64 #if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
  65 #  include <shellapi.h>
  66 #else
  67 EXTERN_C LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
  68 #endif
  69
  70 #define NO_XSLOCKS
  71 #define PERL_NO_GET_CONTEXT
  72 #include "XSUB.h"
  73
  74 #include "Win32iop.h"
  75 #include <fcntl.h>
  76 #ifndef __GNUC__
  77 /* assert.h conflicts with #define of assert in perl.h */
  78 #include <assert.h>
  79 #endif
  80 #include <string.h>
  81 #include <stdarg.h>
  82 #include <float.h>
  83 #include <time.h>
  84 #if defined(_MSC_VER) || defined(__MINGW32__)
  85 #include <sys/utime.h>
  86 #else
  87 #include <utime.h>
  88 #endif
  89 #ifdef __GNUC__
  90 /* Mingw32 defaults to globing command line
  91  * So we turn it off like this:
  92  */
  93 int _CRT_glob = 0;
  94 #endif
  95
  96 #if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
  97 /* Mingw32-1.1 is missing some prototypes */
  98 START_EXTERN_C
  99 FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
 100 FILE * _wfdopen(int nFd, LPCWSTR wszMode);
 101 FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
 102 int _flushall();
 103 int _fcloseall();
 104 END_EXTERN_C
 105 #endif
 106
 107 #if defined(__BORLANDC__)
 108 #  define _stat stat
 109 #  define _utimbuf utimbuf
 110 #endif
 111
 112 #define EXECF_EXEC 1
 113 #define EXECF_SPAWN 2
 114 #define EXECF_SPAWN_NOWAIT 3
 115
 116 #if defined(PERL_IMPLICIT_SYS)
 117 #  undef win32_get_privlib
 118 #  define win32_get_privlib g_win32_get_privlib
 119 #  undef win32_get_sitelib
 120 #  define win32_get_sitelib g_win32_get_sitelib
 121 #  undef win32_get_vendorlib
 122 #  define win32_get_vendorlib g_win32_get_vendorlib
 123 #  undef getlogin
 124 #  define getlogin g_getlogin
 125 #endif
 126
 127 static void             get_shell(void);
 128 static long             tokenize(const char *str, char **dest, char ***destv);
 129 static int              do_spawn2(pTHX_ const char *cmd, int exectype);
 130 static BOOL             has_shell_metachars(const char *ptr);
 131 static long             filetime_to_clock(PFILETIME ft);
 132 static BOOL             filetime_from_time(PFILETIME ft, time_t t);
 133 static char *           get_emd_part(SV **leading, char *trailing, ...);
 134 static void             remove_dead_process(long deceased);
 135 static long             find_pid(int pid);
 136 static char *           qualified_path(const char *cmd);
 137 static char *           win32_get_xlib(const char *pl, const char *xlib,
 138                                        const char *libname);
 139
 140 #ifdef USE_ITHREADS
 141 static void             remove_dead_pseudo_process(long child);
 142 static long             find_pseudo_pid(int pid);
 143 #endif
 144
 145 START_EXTERN_C
 146 HANDLE  w32_perldll_handle = INVALID_HANDLE_VALUE;
 147 char    w32_module_name[MAX_PATH+1];
 148 END_EXTERN_C
 149
 150 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
 151
 152 static HANDLE (WINAPI *pfnCreateToolhelp32Snapshot)(DWORD, DWORD) = NULL;
 153 static BOOL   (WINAPI *pfnProcess32First)(HANDLE, PROCESSENTRY32*) = NULL;
 154 static BOOL   (WINAPI *pfnProcess32Next)(HANDLE, PROCESSENTRY32*) = NULL;
 155 static LONG   (WINAPI *pfnZwQuerySystemInformation)(UINT, PVOID, ULONG, PULONG);
 156
 157 #ifdef __BORLANDC__
 158 /* Silence STDERR grumblings from Borland's math library. */
 159 DllExport int
 160 _matherr(struct _exception *a)
 161 {
 162     PERL_UNUSED_VAR(a);
 163     return 1;
 164 }
 165 #endif
 166
 167 #if _MSC_VER >= 1400
 168 void my_invalid_parameter_handler(const wchar_t* expression,
 169     const wchar_t* function,
 170     const wchar_t* file,
 171     unsigned int line,
 172     uintptr_t pReserved)
 173 {
 174 #  ifdef _DEBUG
 175     wprintf(L"Invalid parameter detected in function %s."
 176             L" File: %s Line: %d\n", function, file, line);
 177     wprintf(L"Expression: %s\n", expression);
 178 #  endif
 179 }
 180 #endif
 181
 182 int
 183 IsWin95(void)
 184 {
 185     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
 186 }
 187
 188 int
 189 IsWinNT(void)
 190 {
 191     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
 192 }
 193
 194 EXTERN_C void
 195 set_w32_module_name(void)
 196 {
 197     /* this function may be called at DLL_PROCESS_ATTACH time */
 198     char* ptr;
 199     HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
 200                                ? GetModuleHandle(NULL)
 201                                : w32_perldll_handle);
 202
 203     OSVERSIONINFO osver; /* g_osver may not yet be initialized */
 204     osver.dwOSVersionInfoSize = sizeof(osver);
 205     GetVersionEx(&osver);
 206
 207     if (osver.dwPlatformId == VER_PLATFORM_WIN32_NT) {
 208         WCHAR modulename[MAX_PATH];
 209         WCHAR fullname[MAX_PATH];
 210         char *ansi;
 211
 212         GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
 213
 214         /* Make sure we get an absolute pathname in case the module was loaded
 215          * explicitly by LoadLibrary() with a relative path. */
 216         GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
 217
 218         /* remove \\?\ prefix */
 219         if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
 220             memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
 221
 222         ansi = win32_ansipath(fullname);
 223         my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
 224         win32_free(ansi);
 225     }
 226     else {
 227         GetModuleFileName(module, w32_module_name, sizeof(w32_module_name));
 228
 229         /* remove \\?\ prefix */
 230         if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
 231             memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
 232
 233         /* try to get full path to binary (which may be mangled when perl is
 234          * run from a 16-bit app) */
 235         /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
 236         win32_longpath(w32_module_name);
 237         /*PerlIO_printf(Perl_debug_log, "After  %s\n", w32_module_name);*/
 238     }
 239
 240     /* normalize to forward slashes */
 241     ptr = w32_module_name;
 242     while (*ptr) {
 243         if (*ptr == '\\')
 244             *ptr = '/';
 245         ++ptr;
 246     }
 247 }
 248
 249 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
 250 static char*
 251 get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
 252 {
 253     /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
 254     HKEY handle;
 255     DWORD type;
 256     const char *subkey = "Software\\Perl";
 257     char *str = Nullch;
 258     long retval;
 259
 260     retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
 261     if (retval == ERROR_SUCCESS) {
 262         DWORD datalen;
 263         retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
 264         if (retval == ERROR_SUCCESS
 265             && (type == REG_SZ || type == REG_EXPAND_SZ))
 266         {
 267             dTHX;
 268             if (!*svp)
 269                 *svp = sv_2mortal(newSVpvn("",0));
 270             SvGROW(*svp, datalen);
 271             retval = RegQueryValueEx(handle, valuename, 0, NULL,
 272                                      (PBYTE)SvPVX(*svp), &datalen);
 273             if (retval == ERROR_SUCCESS) {
 274                 str = SvPVX(*svp);
 275                 SvCUR_set(*svp,datalen-1);
 276             }
 277         }
 278         RegCloseKey(handle);
 279     }
 280     return str;
 281 }
 282
 283 /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
 284 static char*
 285 get_regstr(const char *valuename, SV **svp)
 286 {
 287     char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
 288     if (!str)
 289         str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
 290     return str;
 291 }
 292
 293 /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
 294 static char *
 295 get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 296 {
 297     char base[10];
 298     va_list ap;
 299     char mod_name[MAX_PATH+1];
 300     char *ptr;
 301     char *optr;
 302     char *strip;
 303     STRLEN baselen;
 304
 305     va_start(ap, trailing_path);
 306     strip = va_arg(ap, char *);
 307
 308     sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
 309     baselen = strlen(base);
 310
 311     if (!*w32_module_name) {
 312         set_w32_module_name();
 313     }
 314     strcpy(mod_name, w32_module_name);
 315     ptr = strrchr(mod_name, '/');
 316     while (ptr && strip) {
 317         /* look for directories to skip back */
 318         optr = ptr;
 319         *ptr = '\0';
 320         ptr = strrchr(mod_name, '/');
 321         /* avoid stripping component if there is no slash,
 322          * or it doesn't match ... */
 323         if (!ptr || stricmp(ptr+1, strip) != 0) {
 324             /* ... but not if component matches m|5\.$patchlevel.*| */
 325             if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
 326                           && strncmp(strip, base, baselen) == 0
 327                           && strncmp(ptr+1, base, baselen) == 0))
 328             {
 329                 *optr = '/';
 330                 ptr = optr;
 331             }
 332         }
 333         strip = va_arg(ap, char *);
 334     }
 335     if (!ptr) {
 336         ptr = mod_name;
 337         *ptr++ = '.';
 338         *ptr = '/';
 339     }
 340     va_end(ap);
 341     strcpy(++ptr, trailing_path);
 342
 343     /* only add directory if it exists */
 344     if (GetFileAttributes(mod_name) != (DWORD) -1) {
 345         /* directory exists */
 346         dTHX;
 347         if (!*prev_pathp)
 348             *prev_pathp = sv_2mortal(newSVpvn("",0));
 349         else if (SvPVX(*prev_pathp))
 350             sv_catpvn(*prev_pathp, ";", 1);
 351         sv_catpv(*prev_pathp, mod_name);
 352         return SvPVX(*prev_pathp);
 353     }
 354
 355     return Nullch;
 356 }
 357
 358 char *
 359 win32_get_privlib(const char *pl)
 360 {
 361     dTHX;
 362     char *stdlib = "lib";
 363     char buffer[MAX_PATH+1];
 364     SV *sv = Nullsv;
 365
 366     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
 367     sprintf(buffer, "%s-%s", stdlib, pl);
 368     if (!get_regstr(buffer, &sv))
 369         (void)get_regstr(stdlib, &sv);
 370
 371     /* $stdlib .= ";$EMD/../../lib" */
 372     return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
 373 }
 374
 375 static char *
 376 win32_get_xlib(const char *pl, const char *xlib, const char *libname)
 377 {
 378     dTHX;
 379     char regstr[40];
 380     char pathstr[MAX_PATH+1];
 381     SV *sv1 = Nullsv;
 382     SV *sv2 = Nullsv;
 383
 384     /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
 385     sprintf(regstr, "%s-%s", xlib, pl);
 386     (void)get_regstr(regstr, &sv1);
 387
 388     /* $xlib .=
 389      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib";  */
 390     sprintf(pathstr, "%s/%s/lib", libname, pl);
 391     (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
 392
 393     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
 394     (void)get_regstr(xlib, &sv2);
 395
 396     /* $xlib .=
 397      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib";  */
 398     sprintf(pathstr, "%s/lib", libname);
 399     (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
 400
 401     if (!sv1 && !sv2)
 402         return Nullch;
 403     if (!sv1)
 404         return SvPVX(sv2);
 405     if (!sv2)
 406         return SvPVX(sv1);
 407
 408     sv_catpvn(sv1, ";", 1);
 409     sv_catsv(sv1, sv2);
 410
 411     return SvPVX(sv1);
 412 }
 413
 414 char *
 415 win32_get_sitelib(const char *pl)
 416 {
 417     return win32_get_xlib(pl, "sitelib", "site");
 418 }
 419
 420 #ifndef PERL_VENDORLIB_NAME
 421 #  define PERL_VENDORLIB_NAME   "vendor"
 422 #endif
 423
 424 char *
 425 win32_get_vendorlib(const char *pl)
 426 {
 427     return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
 428 }
 429
 430 static BOOL
 431 has_shell_metachars(const char *ptr)
 432 {
 433     int inquote = 0;
 434     char quote = '\0';
 435
 436     /*
 437      * Scan string looking for redirection (< or >) or pipe
 438      * characters (|) that are not in a quoted string.
 439      * Shell variable interpolation (%VAR%) can also happen inside strings.
 440      */
 441     while (*ptr) {
 442         switch(*ptr) {
 443         case '%':
 444             return TRUE;
 445         case '\'':
 446         case '\"':
 447             if (inquote) {
 448                 if (quote == *ptr) {
 449                     inquote = 0;
 450                     quote = '\0';
 451                 }
 452             }
 453             else {
 454                 quote = *ptr;
 455                 inquote++;
 456             }
 457             break;
 458         case '>':
 459         case '<':
 460         case '|':
 461             if (!inquote)
 462                 return TRUE;
 463         default:
 464             break;
 465         }
 466         ++ptr;
 467     }
 468     return FALSE;
 469 }
 470
 471 #if !defined(PERL_IMPLICIT_SYS)
 472 /* since the current process environment is being updated in util.c
 473  * the library functions will get the correct environment
 474  */
 475 PerlIO *
 476 Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 477 {
 478 #ifdef FIXCMD
 479 #define fixcmd(x)   {                                   \
 480                         char *pspace = strchr((x),' '); \
 481                         if (pspace) {                   \
 482                             char *p = (x);              \
 483                             while (p < pspace) {        \
 484                                 if (*p == '/')          \
 485                                     *p = '\\';          \
 486                                 p++;                    \
 487                             }                           \
 488                         }                               \
 489                     }
 490 #else
 491 #define fixcmd(x)
 492 #endif
 493     fixcmd(cmd);
 494     PERL_FLUSHALL_FOR_CHILD;
 495     return win32_popen(cmd, mode);
 496 }
 497
 498 long
 499 Perl_my_pclose(pTHX_ PerlIO *fp)
 500 {
 501     return win32_pclose(fp);
 502 }
 503 #endif
 504
 505 DllExport unsigned long
 506 win32_os_id(void)
 507 {
 508     return (unsigned long)g_osver.dwPlatformId;
 509 }
 510
 511 DllExport int
 512 win32_getpid(void)
 513 {
 514     int pid;
 515 #ifdef USE_ITHREADS
 516     dTHX;
 517     if (w32_pseudo_id)
 518         return -((int)w32_pseudo_id);
 519 #endif
 520     pid = _getpid();
 521     /* Windows 9x appears to always reports a pid for threads and processes
 522      * that has the high bit set. So we treat the lower 31 bits as the
 523      * "real" PID for Perl's purposes. */
 524     if (IsWin95() && pid < 0)
 525         pid = -pid;
 526     return pid;
 527 }
 528
 529 /* Tokenize a string.  Words are null-separated, and the list
 530  * ends with a doubled null.  Any character (except null and
 531  * including backslash) may be escaped by preceding it with a
 532  * backslash (the backslash will be stripped).
 533  * Returns number of words in result buffer.
 534  */
 535 static long
 536 tokenize(const char *str, char **dest, char ***destv)
 537 {
 538     char *retstart = Nullch;
 539     char **retvstart = 0;
 540     int items = -1;
 541     if (str) {
 542         dTHX;
 543         int slen = strlen(str);
 544         register char *ret;
 545         register char **retv;
 546         Newx(ret, slen+2, char);
 547         Newx(retv, (slen+3)/2, char*);
 548
 549         retstart = ret;
 550         retvstart = retv;
 551         *retv = ret;
 552         items = 0;
 553         while (*str) {
 554             *ret = *str++;
 555             if (*ret == '\\' && *str)
 556                 *ret = *str++;
 557             else if (*ret == ' ') {
 558                 while (*str == ' ')
 559                     str++;
 560                 if (ret == retstart)
 561                     ret--;
 562                 else {
 563                     *ret = '\0';
 564                     ++items;
 565                     if (*str)
 566                         *++retv = ret+1;
 567                 }
 568             }
 569             else if (!*str)
 570                 ++items;
 571             ret++;
 572         }
 573         retvstart[items] = Nullch;
 574         *ret++ = '\0';
 575         *ret = '\0';
 576     }
 577     *dest = retstart;
 578     *destv = retvstart;
 579     return items;
 580 }
 581
 582 static void
 583 get_shell(void)
 584 {
 585     dTHX;
 586     if (!w32_perlshell_tokens) {
 587         /* we don't use COMSPEC here for two reasons:
 588          *  1. the same reason perl on UNIX doesn't use SHELL--rampant and
 589          *     uncontrolled unportability of the ensuing scripts.
 590          *  2. PERL5SHELL could be set to a shell that may not be fit for
 591          *     interactive use (which is what most programs look in COMSPEC
 592          *     for).
 593          */
 594         const char* defaultshell = (IsWinNT()
 595                                     ? "cmd.exe /x/d/c" : "command.com /c");
 596         const char *usershell = PerlEnv_getenv("PERL5SHELL");
 597         w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
 598                                        &w32_perlshell_tokens,
 599                                        &w32_perlshell_vec);
 600     }
 601 }
 602
 603 int
 604 Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
 605 {
 606     char **argv;
 607     char *str;
 608     int status;
 609     int flag = P_WAIT;
 610     int index = 0;
 611
 612     if (sp <= mark)
 613         return -1;
 614
 615     get_shell();
 616     Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
 617
 618     if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
 619         ++mark;
 620         flag = SvIVx(*mark);
 621     }
 622
 623     while (++mark <= sp) {
 624         if (*mark && (str = SvPV_nolen(*mark)))
 625             argv[index++] = str;
 626         else
 627             argv[index++] = "";
 628     }
 629     argv[index++] = 0;
 630
 631     status = win32_spawnvp(flag,
 632                            (const char*)(really ? SvPV_nolen(really) : argv[0]),
 633                            (const char* const*)argv);
 634
 635     if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
 636         /* possible shell-builtin, invoke with shell */
 637         int sh_items;
 638         sh_items = w32_perlshell_items;
 639         while (--index >= 0)
 640             argv[index+sh_items] = argv[index];
 641         while (--sh_items >= 0)
 642             argv[sh_items] = w32_perlshell_vec[sh_items];
 643
 644         status = win32_spawnvp(flag,
 645                                (const char*)(really ? SvPV_nolen(really) : argv[0]),
 646                                (const char* const*)argv);
 647     }
 648
 649     if (flag == P_NOWAIT) {
 650         if (IsWin95())
 651             PL_statusvalue = -1;        /* >16bits hint for pp_system() */
 652     }
 653     else {
 654         if (status < 0) {
 655             if (ckWARN(WARN_EXEC))
 656                 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
 657             status = 255 * 256;
 658         }
 659         else
 660             status *= 256;
 661         PL_statusvalue = status;
 662     }
 663     Safefree(argv);
 664     return (status);
 665 }
 666
 667 /* returns pointer to the next unquoted space or the end of the string */
 668 static char*
 669 find_next_space(const char *s)
 670 {
 671     bool in_quotes = FALSE;
 672     while (*s) {
 673         /* ignore doubled backslashes, or backslash+quote */
 674         if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
 675             s += 2;
 676         }
 677         /* keep track of when we're within quotes */
 678         else if (*s == '"') {
 679             s++;
 680             in_quotes = !in_quotes;
 681         }
 682         /* break it up only at spaces that aren't in quotes */
 683         else if (!in_quotes && isSPACE(*s))
 684             return (char*)s;
 685         else
 686             s++;
 687     }
 688     return (char*)s;
 689 }
 690
 691 static int
 692 do_spawn2(pTHX_ const char *cmd, int exectype)
 693 {
 694     char **a;
 695     char *s;
 696     char **argv;
 697     int status = -1;
 698     BOOL needToTry = TRUE;
 699     char *cmd2;
 700
 701     /* Save an extra exec if possible. See if there are shell
 702      * metacharacters in it */
 703     if (!has_shell_metachars(cmd)) {
 704         Newx(argv, strlen(cmd) / 2 + 2, char*);
 705         Newx(cmd2, strlen(cmd) + 1, char);
 706         strcpy(cmd2, cmd);
 707         a = argv;
 708         for (s = cmd2; *s;) {
 709             while (*s && isSPACE(*s))
 710                 s++;
 711             if (*s)
 712                 *(a++) = s;
 713             s = find_next_space(s);
 714             if (*s)
 715                 *s++ = '\0';
 716         }
 717         *a = Nullch;
 718         if (argv[0]) {
 719             switch (exectype) {
 720             case EXECF_SPAWN:
 721                 status = win32_spawnvp(P_WAIT, argv[0],
 722                                        (const char* const*)argv);
 723                 break;
 724             case EXECF_SPAWN_NOWAIT:
 725                 status = win32_spawnvp(P_NOWAIT, argv[0],
 726                                        (const char* const*)argv);
 727                 break;
 728             case EXECF_EXEC:
 729                 status = win32_execvp(argv[0], (const char* const*)argv);
 730                 break;
 731             }
 732             if (status != -1 || errno == 0)
 733                 needToTry = FALSE;
 734         }
 735         Safefree(argv);
 736         Safefree(cmd2);
 737     }
 738     if (needToTry) {
 739         char **argv;
 740         int i = -1;
 741         get_shell();
 742         Newx(argv, w32_perlshell_items + 2, char*);
 743         while (++i < w32_perlshell_items)
 744             argv[i] = w32_perlshell_vec[i];
 745         argv[i++] = (char *)cmd;
 746         argv[i] = Nullch;
 747         switch (exectype) {
 748         case EXECF_SPAWN:
 749             status = win32_spawnvp(P_WAIT, argv[0],
 750                                    (const char* const*)argv);
 751             break;
 752         case EXECF_SPAWN_NOWAIT:
 753             status = win32_spawnvp(P_NOWAIT, argv[0],
 754                                    (const char* const*)argv);
 755             break;
 756         case EXECF_EXEC:
 757             status = win32_execvp(argv[0], (const char* const*)argv);
 758             break;
 759         }
 760         cmd = argv[0];
 761         Safefree(argv);
 762     }
 763     if (exectype == EXECF_SPAWN_NOWAIT) {
 764         if (IsWin95())
 765             PL_statusvalue = -1;        /* >16bits hint for pp_system() */
 766     }
 767     else {
 768         if (status < 0) {
 769             if (ckWARN(WARN_EXEC))
 770                 Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s",
 771                      (exectype == EXECF_EXEC ? "exec" : "spawn"),
 772                      cmd, strerror(errno));
 773             status = 255 * 256;
 774         }
 775         else
 776             status *= 256;
 777         PL_statusvalue = status;
 778     }
 779     return (status);
 780 }
 781
 782 int
 783 Perl_do_spawn(pTHX_ char *cmd)
 784 {
 785     return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
 786 }
 787
 788 int
 789 Perl_do_spawn_nowait(pTHX_ char *cmd)
 790 {
 791     return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
 792 }
 793
 794 bool
 795 Perl_do_exec(pTHX_ const char *cmd)
 796 {
 797     do_spawn2(aTHX_ cmd, EXECF_EXEC);
 798     return FALSE;
 799 }
 800
 801 /* The idea here is to read all the directory names into a string table
 802  * (separated by nulls) and when one of the other dir functions is called
 803  * return the pointer to the current file name.
 804  */
 805 DllExport DIR *
 806 win32_opendir(const char *filename)
 807 {
 808     dTHX;
 809     DIR                 *dirp;
 810     long                len;
 811     long                idx;
 812     char                scanname[MAX_PATH+3];
 813     Stat_t              sbuf;
 814     WIN32_FIND_DATAA    aFindData;
 815     WIN32_FIND_DATAW    wFindData;
 816     bool                using_wide;
 817     char                buffer[MAX_PATH*2];
 818     char                *ptr;
 819
 820     len = strlen(filename);
 821     if (len > MAX_PATH)
 822         return NULL;
 823
 824     /* check to see if filename is a directory */
 825     if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
 826         return NULL;
 827
 828     /* Get us a DIR structure */
 829     Newxz(dirp, 1, DIR);
 830
 831     /* Create the search pattern */
 832     strcpy(scanname, filename);
 833
 834     /* bare drive name means look in cwd for drive */
 835     if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
 836         scanname[len++] = '.';
 837         scanname[len++] = '/';
 838     }
 839     else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
 840         scanname[len++] = '/';
 841     }
 842     scanname[len++] = '*';
 843     scanname[len] = '\0';
 844
 845     /* do the FindFirstFile call */
 846     if (IsWinNT()) {
 847         WCHAR wscanname[sizeof(scanname)];
 848         MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
 849         dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
 850         using_wide = TRUE;
 851     }
 852     else {
 853         dirp->handle = FindFirstFileA(PerlDir_mapA(scanname), &aFindData);
 854     }
 855     if (dirp->handle == INVALID_HANDLE_VALUE) {
 856         DWORD err = GetLastError();
 857         /* FindFirstFile() fails on empty drives! */
 858         switch (err) {
 859         case ERROR_FILE_NOT_FOUND:
 860             return dirp;
 861         case ERROR_NO_MORE_FILES:
 862         case ERROR_PATH_NOT_FOUND:
 863             errno = ENOENT;
 864             break;
 865         case ERROR_NOT_ENOUGH_MEMORY:
 866             errno = ENOMEM;
 867             break;
 868         default:
 869             errno = EINVAL;
 870             break;
 871         }
 872         Safefree(dirp);
 873         return NULL;
 874     }
 875
 876     if (using_wide) {
 877         BOOL use_default = FALSE;
 878         WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
 879                             wFindData.cFileName, -1,
 880                             buffer, sizeof(buffer), NULL, &use_default);
 881         if (use_default && *wFindData.cAlternateFileName) {
 882             WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
 883                                 wFindData.cAlternateFileName, -1,
 884                                 buffer, sizeof(buffer), NULL, NULL);
 885         }
 886         ptr = buffer;
 887     }
 888     else {
 889         ptr = aFindData.cFileName;
 890     }
 891     /* now allocate the first part of the string table for
 892      * the filenames that we find.
 893      */
 894     idx = strlen(ptr)+1;
 895     if (idx < 256)
 896         dirp->size = 256;
 897     else
 898         dirp->size = idx;
 899     Newx(dirp->start, dirp->size, char);
 900     strcpy(dirp->start, ptr);
 901     dirp->nfiles++;
 902     dirp->end = dirp->curr = dirp->start;
 903     dirp->end += idx;
 904     return dirp;
 905 }
 906
 907
 908 /* Readdir just returns the current string pointer and bumps the
 909  * string pointer to the nDllExport entry.
 910  */
 911 DllExport struct direct *
 912 win32_readdir(DIR *dirp)
 913 {
 914     long         len;
 915
 916     if (dirp->curr) {
 917         /* first set up the structure to return */
 918         len = strlen(dirp->curr);
 919         strcpy(dirp->dirstr.d_name, dirp->curr);
 920         dirp->dirstr.d_namlen = len;
 921
 922         /* Fake an inode */
 923         dirp->dirstr.d_ino = dirp->curr - dirp->start;
 924
 925         /* Now set up for the next call to readdir */
 926         dirp->curr += len + 1;
 927         if (dirp->curr >= dirp->end) {
 928             dTHX;
 929             BOOL res;
 930             WIN32_FIND_DATAA aFindData;
 931             char buffer[MAX_PATH*2];
 932             char *ptr;
 933
 934             /* finding the next file that matches the wildcard
 935              * (which should be all of them in this directory!).
 936              */
 937             if (IsWinNT()) {
 938                 WIN32_FIND_DATAW wFindData;
 939                 res = FindNextFileW(dirp->handle, &wFindData);
 940                 if (res) {
 941                     BOOL use_default = FALSE;
 942                     WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
 943                                         wFindData.cFileName, -1,
 944                                         buffer, sizeof(buffer), NULL, &use_default);
 945                     if (use_default && *wFindData.cAlternateFileName) {
 946                         WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS,
 947                                             wFindData.cAlternateFileName, -1,
 948                                             buffer, sizeof(buffer), NULL, NULL);
 949                     }
 950                     ptr = buffer;
 951                 }
 952             }
 953             else {
 954                 res = FindNextFileA(dirp->handle, &aFindData);
 955                 ptr = aFindData.cFileName;
 956             }
 957             if (res) {
 958                 long endpos = dirp->end - dirp->start;
 959                 long newsize = endpos + strlen(ptr) + 1;
 960                 /* bump the string table size by enough for the
 961                  * new name and its null terminator */
 962                 while (newsize > dirp->size) {
 963                     long curpos = dirp->curr - dirp->start;
 964                     dirp->size *= 2;
 965                     Renew(dirp->start, dirp->size, char);
 966                     dirp->curr = dirp->start + curpos;
 967                 }
 968                 strcpy(dirp->start + endpos, ptr);
 969                 dirp->end = dirp->start + newsize;
 970                 dirp->nfiles++;
 971             }
 972             else
 973                 dirp->curr = NULL;
 974         }
 975         return &(dirp->dirstr);
 976     }
 977     else
 978         return NULL;
 979 }
 980
 981 /* Telldir returns the current string pointer position */
 982 DllExport long
 983 win32_telldir(DIR *dirp)
 984 {
 985     return (dirp->curr - dirp->start);
 986 }
 987
 988
 989 /* Seekdir moves the string pointer to a previously saved position
 990  * (returned by telldir).
 991  */
 992 DllExport void
 993 win32_seekdir(DIR *dirp, long loc)
 994 {
 995     dirp->curr = dirp->start + loc;
 996 }
 997
 998 /* Rewinddir resets the string pointer to the start */
 999 DllExport void
1000 win32_rewinddir(DIR *dirp)
1001 {
1002     dirp->curr = dirp->start;
1003 }
1004
1005 /* free the memory allocated by opendir */
1006 DllExport int
1007 win32_closedir(DIR *dirp)
1008 {
1009     dTHX;
1010     if (dirp->handle != INVALID_HANDLE_VALUE)
1011         FindClose(dirp->handle);
1012     Safefree(dirp->start);
1013     Safefree(dirp);
1014     return 1;
1015 }
1016
1017
1018 /*
1019  * various stubs
1020  */
1021
1022
1023 /* Ownership
1024  *
1025  * Just pretend that everyone is a superuser. NT will let us know if
1026  * we don\'t really have permission to do something.
1027  */
1028
1029 #define ROOT_UID    ((uid_t)0)
1030 #define ROOT_GID    ((gid_t)0)
1031
1032 uid_t
1033 getuid(void)
1034 {
1035     return ROOT_UID;
1036 }
1037
1038 uid_t
1039 geteuid(void)
1040 {
1041     return ROOT_UID;
1042 }
1043
1044 gid_t
1045 getgid(void)
1046 {
1047     return ROOT_GID;
1048 }
1049
1050 gid_t
1051 getegid(void)
1052 {
1053     return ROOT_GID;
1054 }
1055
1056 int
1057 setuid(uid_t auid)
1058 {
1059     return (auid == ROOT_UID ? 0 : -1);
1060 }
1061
1062 int
1063 setgid(gid_t agid)
1064 {
1065     return (agid == ROOT_GID ? 0 : -1);
1066 }
1067
1068 char *
1069 getlogin(void)
1070 {
1071     dTHX;
1072     char *buf = w32_getlogin_buffer;
1073     DWORD size = sizeof(w32_getlogin_buffer);
1074     if (GetUserName(buf,&size))
1075         return buf;
1076     return (char*)NULL;
1077 }
1078
1079 int
1080 chown(const char *path, uid_t owner, gid_t group)
1081 {
1082     /* XXX noop */
1083     return 0;
1084 }
1085
1086 /*
1087  * XXX this needs strengthening  (for PerlIO)
1088  *   -- BKS, 11-11-200
1089 */
1090 int mkstemp(const char *path)
1091 {
1092     dTHX;
1093     char buf[MAX_PATH+1];
1094     int i = 0, fd = -1;
1095
1096 retry:
1097     if (i++ > 10) { /* give up */
1098         errno = ENOENT;
1099         return -1;
1100     }
1101     if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
1102         errno = ENOENT;
1103         return -1;
1104     }
1105     fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
1106     if (fd == -1)
1107         goto retry;
1108     return fd;
1109 }
1110
1111 static long
1112 find_pid(int pid)
1113 {
1114     dTHX;
1115     long child = w32_num_children;
1116     while (--child >= 0) {
1117         if ((int)w32_child_pids[child] == pid)
1118             return child;
1119     }
1120     return -1;
1121 }
1122
1123 static void
1124 remove_dead_process(long child)
1125 {
1126     if (child >= 0) {
1127         dTHX;
1128         CloseHandle(w32_child_handles[child]);
1129         Move(&w32_child_handles[child+1], &w32_child_handles[child],
1130              (w32_num_children-child-1), HANDLE);
1131         Move(&w32_child_pids[child+1], &w32_child_pids[child],
1132              (w32_num_children-child-1), DWORD);
1133         w32_num_children--;
1134     }
1135 }
1136
1137 #ifdef USE_ITHREADS
1138 static long
1139 find_pseudo_pid(int pid)
1140 {
1141     dTHX;
1142     long child = w32_num_pseudo_children;
1143     while (--child >= 0) {
1144         if ((int)w32_pseudo_child_pids[child] == pid)
1145             return child;
1146     }
1147     return -1;
1148 }
1149
1150 static void
1151 remove_dead_pseudo_process(long child)
1152 {
1153     if (child >= 0) {
1154         dTHX;
1155         CloseHandle(w32_pseudo_child_handles[child]);
1156         Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
1157              (w32_num_pseudo_children-child-1), HANDLE);
1158         Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
1159              (w32_num_pseudo_children-child-1), DWORD);
1160         Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child],
1161              (w32_num_pseudo_children-child-1), HWND);
1162         w32_num_pseudo_children--;
1163     }
1164 }
1165 #endif
1166
1167 static int
1168 terminate_process(DWORD pid, HANDLE process_handle, int sig)
1169 {
1170     switch(sig) {
1171     case 0:
1172         /* "Does process exist?" use of kill */
1173         return 1;
1174     case 2:
1175         if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid))
1176             return 1;
1177         break;
1178     case SIGBREAK:
1179     case SIGTERM:
1180         if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid))
1181             return 1;
1182         break;
1183     default: /* For now be backwards compatible with perl 5.6 */
1184     case 9:
1185         /* Note that we will only be able to kill processes owned by the
1186          * current process owner, even when we are running as an administrator.
1187          * To kill processes of other owners we would need to set the
1188          * 'SeDebugPrivilege' privilege before obtaining the process handle.
1189          */
1190         if (TerminateProcess(process_handle, sig))
1191             return 1;
1192         break;
1193     }
1194     return 0;
1195 }
1196
1197 /* Traverse process tree using ToolHelp functions */
1198 static int
1199 kill_process_tree_toolhelp(DWORD pid, int sig)
1200 {
1201     HANDLE process_handle;
1202     HANDLE snapshot_handle;
1203     int killed = 0;
1204
1205     process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
1206     if (process_handle == INVALID_HANDLE_VALUE)
1207         return 0;
1208
1209     killed += terminate_process(pid, process_handle, sig);
1210
1211     snapshot_handle = pfnCreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
1212     if (snapshot_handle != INVALID_HANDLE_VALUE) {
1213         PROCESSENTRY32 entry;
1214
1215         entry.dwSize = sizeof(entry);
1216         if (pfnProcess32First(snapshot_handle, &entry)) {
1217             do {
1218                 if (entry.th32ParentProcessID == pid)
1219                     killed += kill_process_tree_toolhelp(entry.th32ProcessID, sig);
1220                 entry.dwSize = sizeof(entry);
1221             }
1222             while (pfnProcess32Next(snapshot_handle, &entry));
1223         }
1224         CloseHandle(snapshot_handle);
1225     }
1226     CloseHandle(process_handle);
1227     return killed;
1228 }
1229
1230 /* Traverse process tree using undocumented system information structures.
1231  * This is only necessary on Windows NT, which lacks the ToolHelp functions.
1232  */
1233 static int
1234 kill_process_tree_sysinfo(SYSTEM_PROCESSES *process_info, DWORD pid, int sig)
1235 {
1236     HANDLE process_handle;
1237     SYSTEM_PROCESSES *p = process_info;
1238     int killed = 0;
1239
1240     process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
1241     if (process_handle == INVALID_HANDLE_VALUE)
1242         return 0;
1243
1244     killed += terminate_process(pid, process_handle, sig);
1245
1246     while (1) {
1247         if (p->InheritedFromProcessId == (DWORD)pid)
1248             killed += kill_process_tree_sysinfo(process_info, p->ProcessId, sig);
1249
1250         if (p->NextEntryDelta == 0)
1251             break;
1252
1253         p = (SYSTEM_PROCESSES*)((char*)p + p->NextEntryDelta);
1254     }
1255
1256     CloseHandle(process_handle);
1257     return killed;
1258 }
1259
1260 int
1261 killpg(int pid, int sig)
1262 {
1263     /* Use "documented" method whenever available */
1264     if (pfnCreateToolhelp32Snapshot && pfnProcess32First && pfnProcess32Next) {
1265         return kill_process_tree_toolhelp((DWORD)pid, sig);
1266     }
1267
1268     /* Fall back to undocumented Windows internals on Windows NT */
1269     if (pfnZwQuerySystemInformation) {
1270         dTHX;
1271         char *buffer;
1272         DWORD size = 0;
1273
1274         pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, NULL, 0, &size);
1275         Newx(buffer, size, char);
1276
1277         if (pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, buffer, size, NULL) >= 0) {
1278             int killed = kill_process_tree_sysinfo((SYSTEM_PROCESSES*)buffer, (DWORD)pid, sig);
1279             Safefree(buffer);
1280             return killed;
1281         }
1282     }
1283     return 0;
1284 }
1285
1286 static int
1287 my_kill(int pid, int sig)
1288 {
1289     int retval = 0;
1290     HANDLE process_handle;
1291
1292     if (sig < 0)
1293         return killpg(pid, -sig);
1294
1295     process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
1296     if (process_handle != INVALID_HANDLE_VALUE) {
1297         retval = terminate_process(pid, process_handle, sig);
1298         CloseHandle(process_handle);
1299     }
1300     return retval;
1301 }
1302
1303 DllExport int
1304 win32_kill(int pid, int sig)
1305 {
1306     dTHX;
1307     HANDLE hProcess;
1308     long child;
1309 #ifdef USE_ITHREADS
1310     if (pid < 0) {
1311         /* it is a pseudo-forked child */
1312         child = find_pseudo_pid(-pid);
1313         if (child >= 0) {
1314             HWND hwnd = w32_pseudo_child_message_hwnds[child];
1315             hProcess = w32_pseudo_child_handles[child];
1316             switch (sig) {
1317             case 0:
1318                 /* "Does process exist?" use of kill */
1319                 return 0;
1320
1321             case 9:
1322                 /* kill -9 style un-graceful exit */
1323                 if (TerminateThread(hProcess, sig)) {
1324                     remove_dead_pseudo_process(child);
1325                     return 0;
1326                 }
1327                 break;
1328
1329             default: {
1330                 int count = 0;
1331                 /* pseudo-process has not yet properly initialized if hwnd isn't set */
1332                 while (hwnd == INVALID_HANDLE_VALUE && count < 5) {
1333                     /* Yield and wait for the other thread to send us its message_hwnd */
1334                     Sleep(0);
1335                     win32_async_check(aTHX);
1336                     ++count;
1337                 }
1338                 if (hwnd != INVALID_HANDLE_VALUE) {
1339                     /* We fake signals to pseudo-processes using Win32
1340                      * message queue.  In Win9X the pids are negative already. */
1341                     if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) ||
1342                         PostThreadMessage(IsWin95() ? pid : -pid, WM_USER_KILL, sig, 0))
1343                     {
1344                         /* It might be us ... */
1345                         PERL_ASYNC_CHECK();
1346                         return 0;
1347                     }
1348                 }
1349                 break;
1350             }
1351             } /* switch */
1352         }
1353         else if (IsWin95()) {
1354             pid = -pid;
1355             goto alien_process;
1356         }
1357     }
1358     else
1359 #endif
1360     {
1361         child = find_pid(pid);
1362         if (child >= 0) {
1363             if (my_kill(pid, sig)) {
1364                 DWORD exitcode = 0;
1365                 if (GetExitCodeProcess(w32_child_handles[child], &exitcode) &&
1366                     exitcode != STILL_ACTIVE)
1367                 {
1368                     remove_dead_process(child);
1369                 }
1370                 return 0;
1371             }
1372         }
1373         else {
1374 alien_process:
1375             if (my_kill((IsWin95() ? -pid : pid), sig))
1376                 return 0;
1377         }
1378     }
1379     errno = EINVAL;
1380     return -1;
1381 }
1382
1383 DllExport int
1384 win32_stat(const char *path, Stat_t *sbuf)
1385 {
1386     dTHX;
1387     char        buffer[MAX_PATH+1];
1388     int         l = strlen(path);
1389     int         res;
1390     int         nlink = 1;
1391     BOOL        expect_dir = FALSE;
1392
1393     GV          *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT",
1394                                          GV_NOTQUAL, SVt_PV);
1395     BOOL        sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy));
1396
1397     if (l > 1) {
1398         switch(path[l - 1]) {
1399         /* FindFirstFile() and stat() are buggy with a trailing
1400          * slashes, except for the root directory of a drive */
1401         case '\\':
1402         case '/':
1403             if (l > sizeof(buffer)) {
1404                 errno = ENAMETOOLONG;
1405                 return -1;
1406             }
1407             --l;
1408             strncpy(buffer, path, l);
1409             /* remove additional trailing slashes */
1410             while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
1411                 --l;
1412             /* add back slash if we otherwise end up with just a drive letter */
1413             if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
1414                 buffer[l++] = '\\';
1415             buffer[l] = '\0';
1416             path = buffer;
1417             expect_dir = TRUE;
1418             break;
1419
1420         /* FindFirstFile() is buggy with "x:", so add a dot :-( */
1421         case ':':
1422             if (l == 2 && isALPHA(path[0])) {
1423                 buffer[0] = path[0];
1424                 buffer[1] = ':';
1425                 buffer[2] = '.';
1426                 buffer[3] = '\0';
1427                 l = 3;
1428                 path = buffer;
1429             }
1430             break;
1431         }
1432     }
1433
1434     path = PerlDir_mapA(path);
1435     l = strlen(path);
1436
1437     if (!sloppy) {
1438         /* We must open & close the file once; otherwise file attribute changes  */
1439         /* might not yet have propagated to "other" hard links of the same file. */
1440         /* This also gives us an opportunity to determine the number of links.   */
1441         HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
1442         if (handle != INVALID_HANDLE_VALUE) {
1443             BY_HANDLE_FILE_INFORMATION bhi;
1444             if (GetFileInformationByHandle(handle, &bhi))
1445                 nlink = bhi.nNumberOfLinks;
1446             CloseHandle(handle);
1447         }
1448     }
1449
1450     /* path will be mapped correctly above */
1451 #if defined(WIN64) || defined(USE_LARGE_FILES)
1452     res = _stati64(path, sbuf);
1453 #else
1454     res = stat(path, sbuf);
1455 #endif
1456     sbuf->st_nlink = nlink;
1457
1458     if (res < 0) {
1459         /* CRT is buggy on sharenames, so make sure it really isn't.
1460          * XXX using GetFileAttributesEx() will enable us to set
1461          * sbuf->st_*time (but note that's not available on the
1462          * Windows of 1995) */
1463         DWORD r = GetFileAttributesA(path);
1464         if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
1465             /* sbuf may still contain old garbage since stat() failed */
1466             Zero(sbuf, 1, Stat_t);
1467             sbuf->st_mode = S_IFDIR | S_IREAD;
1468             errno = 0;
1469             if (!(r & FILE_ATTRIBUTE_READONLY))
1470                 sbuf->st_mode |= S_IWRITE | S_IEXEC;
1471             return 0;
1472         }
1473     }
1474     else {
1475         if (l == 3 && isALPHA(path[0]) && path[1] == ':'
1476             && (path[2] == '\\' || path[2] == '/'))
1477         {
1478             /* The drive can be inaccessible, some _stat()s are buggy */
1479             if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
1480                 errno = ENOENT;
1481                 return -1;
1482             }
1483         }
1484         if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
1485             errno = ENOTDIR;
1486             return -1;
1487         }
1488 #ifdef __BORLANDC__
1489         if (S_ISDIR(sbuf->st_mode))
1490             sbuf->st_mode |= S_IWRITE | S_IEXEC;
1491         else if (S_ISREG(sbuf->st_mode)) {
1492             int perms;
1493             if (l >= 4 && path[l-4] == '.') {
1494                 const char *e = path + l - 3;
1495                 if (strnicmp(e,"exe",3)
1496                     && strnicmp(e,"bat",3)
1497                     && strnicmp(e,"com",3)
1498                     && (IsWin95() || strnicmp(e,"cmd",3)))
1499                     sbuf->st_mode &= ~S_IEXEC;
1500                 else
1501                     sbuf->st_mode |= S_IEXEC;
1502             }
1503             else
1504                 sbuf->st_mode &= ~S_IEXEC;
1505             /* Propagate permissions to _group_ and _others_ */
1506             perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC);
1507             sbuf->st_mode |= (perms>>3) | (perms>>6);
1508         }
1509 #endif
1510     }
1511     return res;
1512 }
1513
1514 #define isSLASH(c) ((c) == '/' || (c) == '\\')
1515 #define SKIP_SLASHES(s) \
1516     STMT_START {                                \
1517         while (*(s) && isSLASH(*(s)))           \
1518             ++(s);                              \
1519     } STMT_END
1520 #define COPY_NONSLASHES(d,s) \
1521     STMT_START {                                \
1522         while (*(s) && !isSLASH(*(s)))          \
1523             *(d)++ = *(s)++;                    \
1524     } STMT_END
1525
1526 /* Find the longname of a given path.  path is destructively modified.
1527  * It should have space for at least MAX_PATH characters. */
1528 DllExport char *
1529 win32_longpath(char *path)
1530 {
1531     WIN32_FIND_DATA fdata;
1532     HANDLE fhand;
1533     char tmpbuf[MAX_PATH+1];
1534     char *tmpstart = tmpbuf;
1535     char *start = path;
1536     char sep;
1537     if (!path)
1538         return Nullch;
1539
1540     /* drive prefix */
1541     if (isALPHA(path[0]) && path[1] == ':') {
1542         start = path + 2;
1543         *tmpstart++ = path[0];
1544         *tmpstart++ = ':';
1545     }
1546     /* UNC prefix */
1547     else if (isSLASH(path[0]) && isSLASH(path[1])) {
1548         start = path + 2;
1549         *tmpstart++ = path[0];
1550         *tmpstart++ = path[1];
1551         SKIP_SLASHES(start);
1552         COPY_NONSLASHES(tmpstart,start);        /* copy machine name */
1553         if (*start) {
1554             *tmpstart++ = *start++;
1555             SKIP_SLASHES(start);
1556             COPY_NONSLASHES(tmpstart,start);    /* copy share name */
1557         }
1558     }
1559     *tmpstart = '\0';
1560     while (*start) {
1561         /* copy initial slash, if any */
1562         if (isSLASH(*start)) {
1563             *tmpstart++ = *start++;
1564             *tmpstart = '\0';
1565             SKIP_SLASHES(start);
1566         }
1567
1568         /* FindFirstFile() expands "." and "..", so we need to pass
1569          * those through unmolested */
1570         if (*start == '.'
1571             && (!start[1] || isSLASH(start[1])
1572                 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
1573         {
1574             COPY_NONSLASHES(tmpstart,start);    /* copy "." or ".." */
1575             *tmpstart = '\0';
1576             continue;
1577         }
1578
1579         /* if this is the end, bust outta here */
1580         if (!*start)
1581             break;
1582
1583         /* now we're at a non-slash; walk up to next slash */
1584         while (*start && !isSLASH(*start))
1585             ++start;
1586
1587         /* stop and find full name of component */
1588         sep = *start;
1589         *start = '\0';
1590         fhand = FindFirstFile(path,&fdata);
1591         *start = sep;
1592         if (fhand != INVALID_HANDLE_VALUE) {
1593             STRLEN len = strlen(fdata.cFileName);
1594             if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
1595                 strcpy(tmpstart, fdata.cFileName);
1596                 tmpstart += len;
1597                 FindClose(fhand);
1598             }
1599             else {
1600                 FindClose(fhand);
1601                 errno = ERANGE;
1602                 return Nullch;
1603             }
1604         }
1605         else {
1606             /* failed a step, just return without side effects */
1607             /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
1608             errno = EINVAL;
1609             return Nullch;
1610         }
1611     }
1612     strcpy(path,tmpbuf);
1613     return path;
1614 }
1615
1616 static void
1617 out_of_memory()
1618 {
1619     dTHX;
1620     /* Can't use PerlIO to write as it allocates memory */
1621     PerlLIO_write(PerlIO_fileno(Perl_error_log),
1622                   PL_no_mem, strlen(PL_no_mem));
1623     my_exit(1);
1624 }
1625
1626 /* The win32_ansipath() function takes a Unicode filename and converts it
1627  * into the current Windows codepage. If some characters cannot be mapped,
1628  * then it will convert the short name instead.
1629  *
1630  * The buffer to the ansi pathname must be freed with win32_free() when it
1631  * it no longer needed.
1632  *
1633  * The argument to win32_ansipath() must exist before this function is
1634  * called; otherwise there is no way to determine the short path name.
1635  *
1636  * Ideas for future refinement:
1637  * - Only convert those segments of the path that are not in the current
1638  *   codepage, but leave the other segments in their long form.
1639  * - If the resulting name is longer than MAX_PATH, start converting
1640  *   additional path segments into short names until the full name
1641  *   is shorter than MAX_PATH.  Shorten the filename part last!
1642  */
1643 DllExport char *
1644 win32_ansipath(const WCHAR *widename)
1645 {
1646     char *name;
1647     BOOL use_default = FALSE;
1648     size_t widelen = wcslen(widename)+1;
1649     int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1650                                   NULL, 0, NULL, NULL);
1651     name = win32_malloc(len);
1652     if (!name)
1653         out_of_memory();
1654
1655     WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
1656                         name, len, NULL, &use_default);
1657     if (use_default) {
1658         WCHAR *shortname;
1659         DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
1660         shortname = win32_malloc(shortlen*sizeof(WCHAR));
1661         if (!shortname)
1662             out_of_memory();
1663         shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
1664
1665         len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1666                                   NULL, 0, NULL, NULL);
1667         name = win32_realloc(name, len);
1668         if (!name)
1669             out_of_memory();
1670         WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
1671                             name, len, NULL, NULL);
1672         win32_free(shortname);
1673     }
1674     return name;
1675 }
1676
1677 DllExport char *
1678 win32_getenv(const char *name)
1679 {
1680     dTHX;
1681     DWORD needlen;
1682     SV *curitem = Nullsv;
1683
1684     needlen = GetEnvironmentVariableA(name,NULL,0);
1685     if (needlen != 0) {
1686         curitem = sv_2mortal(newSVpvn("", 0));
1687         do {
1688             SvGROW(curitem, needlen+1);
1689             needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
1690                                               needlen);
1691         } while (needlen >= SvLEN(curitem));
1692         SvCUR_set(curitem, needlen);
1693     }
1694     else {
1695         /* allow any environment variables that begin with 'PERL'
1696            to be stored in the registry */
1697         if (strncmp(name, "PERL", 4) == 0)
1698             (void)get_regstr(name, &curitem);
1699     }
1700     if (curitem && SvCUR(curitem))
1701         return SvPVX(curitem);
1702
1703     return Nullch;
1704 }
1705
1706 DllExport int
1707 win32_putenv(const char *name)
1708 {
1709     dTHX;
1710     char* curitem;
1711     char* val;
1712     int relval = -1;
1713
1714     if (name) {
1715         Newx(curitem,strlen(name)+1,char);
1716         strcpy(curitem, name);
1717         val = strchr(curitem, '=');
1718         if (val) {
1719             /* The sane way to deal with the environment.
1720              * Has these advantages over putenv() & co.:
1721              *  * enables us to store a truly empty value in the
1722              *    environment (like in UNIX).
1723              *  * we don't have to deal with RTL globals, bugs and leaks.
1724              *  * Much faster.
1725              * Why you may want to enable USE_WIN32_RTL_ENV:
1726              *  * environ[] and RTL functions will not reflect changes,
1727              *    which might be an issue if extensions want to access
1728              *    the env. via RTL.  This cuts both ways, since RTL will
1729              *    not see changes made by extensions that call the Win32
1730              *    functions directly, either.
1731              * GSAR 97-06-07
1732              */
1733             *val++ = '\0';
1734             if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
1735                 relval = 0;
1736         }
1737         Safefree(curitem);
1738     }
1739     return relval;
1740 }
1741
1742 static long
1743 filetime_to_clock(PFILETIME ft)
1744 {
1745     __int64 qw = ft->dwHighDateTime;
1746     qw <<= 32;
1747     qw |= ft->dwLowDateTime;
1748     qw /= 10000;  /* File time ticks at 0.1uS, clock at 1mS */
1749     return (long) qw;
1750 }
1751
1752 DllExport int
1753 win32_times(struct tms *timebuf)
1754 {
1755     FILETIME user;
1756     FILETIME kernel;
1757     FILETIME dummy;
1758     clock_t process_time_so_far = clock();
1759     if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy,
1760                         &kernel,&user)) {
1761         timebuf->tms_utime = filetime_to_clock(&user);
1762         timebuf->tms_stime = filetime_to_clock(&kernel);
1763         timebuf->tms_cutime = 0;
1764         timebuf->tms_cstime = 0;
1765     } else {
1766         /* That failed - e.g. Win95 fallback to clock() */
1767         timebuf->tms_utime = process_time_so_far;
1768         timebuf->tms_stime = 0;
1769         timebuf->tms_cutime = 0;
1770         timebuf->tms_cstime = 0;
1771     }
1772     return process_time_so_far;
1773 }
1774
1775 /* fix utime() so it works on directories in NT */
1776 static BOOL
1777 filetime_from_time(PFILETIME pFileTime, time_t Time)
1778 {
1779     struct tm *pTM = localtime(&Time);
1780     SYSTEMTIME SystemTime;
1781     FILETIME LocalTime;
1782
1783     if (pTM == NULL)
1784         return FALSE;
1785
1786     SystemTime.wYear   = pTM->tm_year + 1900;
1787     SystemTime.wMonth  = pTM->tm_mon + 1;
1788     SystemTime.wDay    = pTM->tm_mday;
1789     SystemTime.wHour   = pTM->tm_hour;
1790     SystemTime.wMinute = pTM->tm_min;
1791     SystemTime.wSecond = pTM->tm_sec;
1792     SystemTime.wMilliseconds = 0;
1793
1794     return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
1795            LocalFileTimeToFileTime(&LocalTime, pFileTime);
1796 }
1797
1798 DllExport int
1799 win32_unlink(const char *filename)
1800 {
1801     dTHX;
1802     int ret;
1803     DWORD attrs;
1804
1805     filename = PerlDir_mapA(filename);
1806     attrs = GetFileAttributesA(filename);
1807     if (attrs == 0xFFFFFFFF) {
1808         errno = ENOENT;
1809         return -1;
1810     }
1811     if (attrs & FILE_ATTRIBUTE_READONLY) {
1812         (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
1813         ret = unlink(filename);
1814         if (ret == -1)
1815             (void)SetFileAttributesA(filename, attrs);
1816     }
1817     else
1818         ret = unlink(filename);
1819     return ret;
1820 }
1821
1822 DllExport int
1823 win32_utime(const char *filename, struct utimbuf *times)
1824 {
1825     dTHX;
1826     HANDLE handle;
1827     FILETIME ftCreate;
1828     FILETIME ftAccess;
1829     FILETIME ftWrite;
1830     struct utimbuf TimeBuffer;
1831     int rc;
1832
1833     filename = PerlDir_mapA(filename);
1834     rc = utime(filename, times);
1835
1836     /* EACCES: path specifies directory or readonly file */
1837     if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
1838         return rc;
1839
1840     if (times == NULL) {
1841         times = &TimeBuffer;
1842         time(&times->actime);
1843         times->modtime = times->actime;
1844     }
1845
1846     /* This will (and should) still fail on readonly files */
1847     handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
1848                          FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
1849                          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
1850     if (handle == INVALID_HANDLE_VALUE)
1851         return rc;
1852
1853     if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
1854         filetime_from_time(&ftAccess, times->actime) &&
1855         filetime_from_time(&ftWrite, times->modtime) &&
1856         SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
1857     {
1858         rc = 0;
1859     }
1860
1861     CloseHandle(handle);
1862     return rc;
1863 }
1864
1865 typedef union {
1866     unsigned __int64    ft_i64;
1867     FILETIME            ft_val;
1868 } FT_t;
1869
1870 #ifdef __GNUC__
1871 #define Const64(x) x##LL
1872 #else
1873 #define Const64(x) x##i64
1874 #endif
1875 /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
1876 #define EPOCH_BIAS  Const64(116444736000000000)
1877
1878 /* NOTE: This does not compute the timezone info (doing so can be expensive,
1879  * and appears to be unsupported even by glibc) */
1880 DllExport int
1881 win32_gettimeofday(struct timeval *tp, void *not_used)
1882 {
1883     FT_t ft;
1884
1885     /* this returns time in 100-nanosecond units  (i.e. tens of usecs) */
1886     GetSystemTimeAsFileTime(&ft.ft_val);
1887
1888     /* seconds since epoch */
1889     tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
1890
1891     /* microseconds remaining */
1892     tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
1893
1894     return 0;
1895 }
1896
1897 DllExport int
1898 win32_uname(struct utsname *name)
1899 {
1900     struct hostent *hep;
1901     STRLEN nodemax = sizeof(name->nodename)-1;
1902
1903     /* sysname */
1904     switch (g_osver.dwPlatformId) {
1905     case VER_PLATFORM_WIN32_WINDOWS:
1906         strcpy(name->sysname, "Windows");
1907         break;
1908     case VER_PLATFORM_WIN32_NT:
1909         strcpy(name->sysname, "Windows NT");
1910         break;
1911     case VER_PLATFORM_WIN32s:
1912         strcpy(name->sysname, "Win32s");
1913         break;
1914     default:
1915         strcpy(name->sysname, "Win32 Unknown");
1916         break;
1917     }
1918
1919     /* release */
1920     sprintf(name->release, "%d.%d",
1921             g_osver.dwMajorVersion, g_osver.dwMinorVersion);
1922
1923     /* version */
1924     sprintf(name->version, "Build %d",
1925             g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
1926             ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
1927     if (g_osver.szCSDVersion[0]) {
1928         char *buf = name->version + strlen(name->version);
1929         sprintf(buf, " (%s)", g_osver.szCSDVersion);
1930     }
1931
1932     /* nodename */
1933     hep = win32_gethostbyname("localhost");
1934     if (hep) {
1935         STRLEN len = strlen(hep->h_name);
1936         if (len <= nodemax) {
1937             strcpy(name->nodename, hep->h_name);
1938         }
1939         else {
1940             strncpy(name->nodename, hep->h_name, nodemax);
1941             name->nodename[nodemax] = '\0';
1942         }
1943     }
1944     else {
1945         DWORD sz = nodemax;
1946         if (!GetComputerName(name->nodename, &sz))
1947             *name->nodename = '\0';
1948     }
1949
1950     /* machine (architecture) */
1951     {
1952         SYSTEM_INFO info;
1953         DWORD procarch;
1954         char *arch;
1955         GetSystemInfo(&info);
1956
1957 #if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) \
1958  || (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION))
1959         procarch = info.u.s.wProcessorArchitecture;
1960 #else
1961         procarch = info.wProcessorArchitecture;
1962 #endif
1963         switch (procarch) {
1964         case PROCESSOR_ARCHITECTURE_INTEL:
1965             arch = "x86"; break;
1966         case PROCESSOR_ARCHITECTURE_MIPS:
1967             arch = "mips"; break;
1968         case PROCESSOR_ARCHITECTURE_ALPHA:
1969             arch = "alpha"; break;
1970         case PROCESSOR_ARCHITECTURE_PPC:
1971             arch = "ppc"; break;
1972 #ifdef PROCESSOR_ARCHITECTURE_SHX
1973         case PROCESSOR_ARCHITECTURE_SHX:
1974             arch = "shx"; break;
1975 #endif
1976 #ifdef PROCESSOR_ARCHITECTURE_ARM
1977         case PROCESSOR_ARCHITECTURE_ARM:
1978             arch = "arm"; break;
1979 #endif
1980 #ifdef PROCESSOR_ARCHITECTURE_IA64
1981         case PROCESSOR_ARCHITECTURE_IA64:
1982             arch = "ia64"; break;
1983 #endif
1984 #ifdef PROCESSOR_ARCHITECTURE_ALPHA64
1985         case PROCESSOR_ARCHITECTURE_ALPHA64:
1986             arch = "alpha64"; break;
1987 #endif
1988 #ifdef PROCESSOR_ARCHITECTURE_MSIL
1989         case PROCESSOR_ARCHITECTURE_MSIL:
1990             arch = "msil"; break;
1991 #endif
1992 #ifdef PROCESSOR_ARCHITECTURE_AMD64
1993         case PROCESSOR_ARCHITECTURE_AMD64:
1994             arch = "amd64"; break;
1995 #endif
1996 #ifdef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
1997         case PROCESSOR_ARCHITECTURE_IA32_ON_WIN64:
1998             arch = "ia32-64"; break;
1999 #endif
2000 #ifdef PROCESSOR_ARCHITECTURE_UNKNOWN
2001         case PROCESSOR_ARCHITECTURE_UNKNOWN:
2002             arch = "unknown"; break;
2003 #endif
2004         default:
2005             sprintf(name->machine, "unknown(0x%x)", procarch);
2006             arch = name->machine;
2007             break;
2008         }
2009         if (name->machine != arch)
2010             strcpy(name->machine, arch);
2011     }
2012     return 0;
2013 }
2014
2015 /* Timing related stuff */
2016
2017 int
2018 do_raise(pTHX_ int sig)
2019 {
2020     if (sig < SIG_SIZE) {
2021         Sighandler_t handler = w32_sighandler[sig];
2022         if (handler == SIG_IGN) {
2023             return 0;
2024         }
2025         else if (handler != SIG_DFL) {
2026             (*handler)(sig);
2027             return 0;
2028         }
2029         else {
2030             /* Choose correct default behaviour */
2031             switch (sig) {
2032 #ifdef SIGCLD
2033                 case SIGCLD:
2034 #endif
2035 #ifdef SIGCHLD
2036                 case SIGCHLD:
2037 #endif
2038                 case 0:
2039                     return 0;
2040                 case SIGTERM:
2041                 default:
2042                     break;
2043             }
2044         }
2045     }
2046     /* Tell caller to exit thread/process as approriate */
2047     return 1;
2048 }
2049
2050 void
2051 sig_terminate(pTHX_ int sig)
2052 {
2053     Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
2054     /* exit() seems to be safe, my_exit() or die() is a problem in ^C
2055        thread
2056      */
2057     exit(sig);
2058 }
2059
2060 DllExport int
2061 win32_async_check(pTHX)
2062 {
2063     MSG msg;
2064     HWND hwnd = w32_message_hwnd;
2065
2066     w32_poll_count = 0;
2067
2068     if (hwnd == INVALID_HANDLE_VALUE) {
2069         /* Call PeekMessage() to mark all pending messages in the queue as "old".
2070          * This is necessary when we are being called by win32_msgwait() to
2071          * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
2072          * message over and over.  An example how this can happen is when
2073          * Perl is calling win32_waitpid() inside a GUI application and the GUI
2074          * is generating messages before the process terminated.
2075          */
2076         PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
2077         if (PL_sig_pending)
2078             despatch_signals();
2079         return 1;
2080     }
2081
2082     /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
2083      * and ignores window messages - should co-exist better with windows apps e.g. Tk
2084      */
2085     if (hwnd == NULL)
2086         hwnd = (HWND)-1;
2087
2088     while (PeekMessage(&msg, hwnd, WM_TIMER,    WM_TIMER,    PM_REMOVE|PM_NOYIELD) ||
2089            PeekMessage(&msg, hwnd, WM_USER_MIN, WM_USER_MAX, PM_REMOVE|PM_NOYIELD))
2090     {
2091         switch (msg.message) {
2092 #ifdef USE_ITHREADS
2093         case WM_USER_MESSAGE: {
2094             int child = find_pseudo_pid(msg.wParam);
2095             if (child >= 0)
2096                 w32_pseudo_child_message_hwnds[child] = (HWND)msg.lParam;
2097             break;
2098         }
2099 #endif
2100
2101         case WM_USER_KILL: {
2102             /* We use WM_USER to fake kill() with other signals */
2103             int sig = msg.wParam;
2104             if (do_raise(aTHX_ sig))
2105                 sig_terminate(aTHX_ sig);
2106             break;
2107         }
2108
2109         case WM_TIMER: {
2110             /* alarm() is a one-shot but SetTimer() repeats so kill it */
2111             if (w32_timerid && w32_timerid==msg.wParam) {
2112                 KillTimer(w32_message_hwnd, w32_timerid);
2113                 w32_timerid=0;
2114
2115                 /* Now fake a call to signal handler */
2116                 if (do_raise(aTHX_ 14))
2117                     sig_terminate(aTHX_ 14);
2118             }
2119             break;
2120         }
2121         } /* switch */
2122     }
2123
2124     /* Above or other stuff may have set a signal flag */
2125     if (PL_sig_pending) {
2126         despatch_signals();
2127     }
2128     return 1;
2129 }
2130
2131 /* This function will not return until the timeout has elapsed, or until
2132  * one of the handles is ready. */
2133 DllExport DWORD
2134 win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
2135 {
2136     /* We may need several goes at this - so compute when we stop */
2137     DWORD ticks = 0;
2138     if (timeout != INFINITE) {
2139         ticks = GetTickCount();
2140         timeout += ticks;
2141     }
2142     while (1) {
2143         DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS);
2144         if (resultp)
2145            *resultp = result;
2146         if (result == WAIT_TIMEOUT) {
2147             /* Ran out of time - explicit return of zero to avoid -ve if we
2148                have scheduling issues
2149              */
2150             return 0;
2151         }
2152         if (timeout != INFINITE) {
2153             ticks = GetTickCount();
2154         }
2155         if (result == WAIT_OBJECT_0 + count) {
2156             /* Message has arrived - check it */
2157             (void)win32_async_check(aTHX);
2158         }
2159         else {
2160            /* Not timeout or message - one of handles is ready */
2161            break;
2162         }
2163     }
2164     /* compute time left to wait */
2165     ticks = timeout - ticks;
2166     /* If we are past the end say zero */
2167     return (ticks > 0) ? ticks : 0;
2168 }
2169
2170 int
2171 win32_internal_wait(int *status, DWORD timeout)
2172 {
2173     /* XXX this wait emulation only knows about processes
2174      * spawned via win32_spawnvp(P_NOWAIT, ...).
2175      */
2176     dTHX;
2177     int i, retval;
2178     DWORD exitcode, waitcode;
2179
2180 #ifdef USE_ITHREADS
2181     if (w32_num_pseudo_children) {
2182         win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
2183                       timeout, &waitcode);
2184         /* Time out here if there are no other children to wait for. */
2185         if (waitcode == WAIT_TIMEOUT) {
2186             if (!w32_num_children) {
2187                 return 0;
2188             }
2189         }
2190         else if (waitcode != WAIT_FAILED) {
2191             if (waitcode >= WAIT_ABANDONED_0
2192                 && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
2193                 i = waitcode - WAIT_ABANDONED_0;
2194             else
2195                 i = waitcode - WAIT_OBJECT_0;
2196             if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
2197                 *status = (int)((exitcode & 0xff) << 8);
2198                 retval = (int)w32_pseudo_child_pids[i];
2199                 remove_dead_pseudo_process(i);
2200                 return -retval;
2201             }
2202         }
2203     }
2204 #endif
2205
2206     if (!w32_num_children) {
2207         errno = ECHILD;
2208         return -1;
2209     }
2210
2211     /* if a child exists, wait for it to die */
2212     win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
2213     if (waitcode == WAIT_TIMEOUT) {
2214         return 0;
2215     }
2216     if (waitcode != WAIT_FAILED) {
2217         if (waitcode >= WAIT_ABANDONED_0
2218             && waitcode < WAIT_ABANDONED_0 + w32_num_children)
2219             i = waitcode - WAIT_ABANDONED_0;
2220         else
2221             i = waitcode - WAIT_OBJECT_0;
2222         if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
2223             *status = (int)((exitcode & 0xff) << 8);
2224             retval = (int)w32_child_pids[i];
2225             remove_dead_process(i);
2226             return retval;
2227         }
2228     }
2229
2230     errno = GetLastError();
2231     return -1;
2232 }
2233
2234 DllExport int
2235 win32_waitpid(int pid, int *status, int flags)
2236 {
2237     dTHX;
2238     DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
2239     int retval = -1;
2240     long child;
2241     if (pid == -1)                              /* XXX threadid == 1 ? */
2242         return win32_internal_wait(status, timeout);
2243 #ifdef USE_ITHREADS
2244     else if (pid < 0) {
2245         child = find_pseudo_pid(-pid);
2246         if (child >= 0) {
2247             HANDLE hThread = w32_pseudo_child_handles[child];
2248             DWORD waitcode;
2249             win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
2250             if (waitcode == WAIT_TIMEOUT) {
2251                 return 0;
2252             }
2253             else if (waitcode == WAIT_OBJECT_0) {
2254                 if (GetExitCodeThread(hThread, &waitcode)) {
2255                     *status = (int)((waitcode & 0xff) << 8);
2256                     retval = (int)w32_pseudo_child_pids[child];
2257                     remove_dead_pseudo_process(child);
2258                     return -retval;
2259                 }
2260             }
2261             else
2262                 errno = ECHILD;
2263         }
2264         else if (IsWin95()) {
2265             pid = -pid;
2266             goto alien_process;
2267         }
2268     }
2269 #endif
2270     else {
2271         HANDLE hProcess;
2272         DWORD waitcode;
2273         child = find_pid(pid);
2274         if (child >= 0) {
2275             hProcess = w32_child_handles[child];
2276             win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
2277             if (waitcode == WAIT_TIMEOUT) {
2278                 return 0;
2279             }
2280             else if (waitcode == WAIT_OBJECT_0) {
2281                 if (GetExitCodeProcess(hProcess, &waitcode)) {
2282                     *status = (int)((waitcode & 0xff) << 8);
2283                     retval = (int)w32_child_pids[child];
2284                     remove_dead_process(child);
2285                     return retval;
2286                 }
2287             }
2288             else
2289                 errno = ECHILD;
2290         }
2291         else {
2292 alien_process:
2293             hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
2294                                    (IsWin95() ? -pid : pid));
2295             if (hProcess) {
2296                 win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
2297                 if (waitcode == WAIT_TIMEOUT) {
2298                     CloseHandle(hProcess);
2299                     return 0;
2300                 }
2301                 else if (waitcode == WAIT_OBJECT_0) {
2302                     if (GetExitCodeProcess(hProcess, &waitcode)) {
2303                         *status = (int)((waitcode & 0xff) << 8);
2304                         CloseHandle(hProcess);
2305                         return pid;
2306                     }
2307                 }
2308                 CloseHandle(hProcess);
2309             }
2310             else
2311                 errno = ECHILD;
2312         }
2313     }
2314     return retval >= 0 ? pid : retval;
2315 }
2316
2317 DllExport int
2318 win32_wait(int *status)
2319 {
2320     return win32_internal_wait(status, INFINITE);
2321 }
2322
2323 DllExport unsigned int
2324 win32_sleep(unsigned int t)
2325 {
2326     dTHX;
2327     /* Win32 times are in ms so *1000 in and /1000 out */
2328     return win32_msgwait(aTHX_ 0, NULL, t*1000, NULL)/1000;
2329 }
2330
2331 DllExport unsigned int
2332 win32_alarm(unsigned int sec)
2333 {
2334     /*
2335      * the 'obvious' implentation is SetTimer() with a callback
2336      * which does whatever receiving SIGALRM would do
2337      * we cannot use SIGALRM even via raise() as it is not
2338      * one of the supported codes in <signal.h>
2339      */
2340     dTHX;
2341
2342     if (w32_message_hwnd == INVALID_HANDLE_VALUE)
2343         w32_message_hwnd = win32_create_message_window();
2344
2345     if (sec) {
2346         if (w32_message_hwnd == NULL)
2347             w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL);
2348         else {
2349             w32_timerid = 1;
2350             SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL);
2351         }
2352     }
2353     else {
2354         if (w32_timerid) {
2355             KillTimer(w32_message_hwnd, w32_timerid);
2356             w32_timerid = 0;
2357         }
2358     }
2359     return 0;
2360 }
2361
2362 #ifdef HAVE_DES_FCRYPT
2363 extern char *   des_fcrypt(const char *txt, const char *salt, char *cbuf);
2364 #endif
2365
2366 DllExport char *
2367 win32_crypt(const char *txt, const char *salt)
2368 {
2369     dTHX;
2370 #ifdef HAVE_DES_FCRYPT
2371     return des_fcrypt(txt, salt, w32_crypt_buffer);
2372 #else
2373     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
2374     return Nullch;
2375 #endif
2376 }
2377
2378 #ifdef USE_FIXED_OSFHANDLE
2379
2380 #define FOPEN                   0x01    /* file handle open */
2381 #define FNOINHERIT              0x10    /* file handle opened O_NOINHERIT */
2382 #define FAPPEND                 0x20    /* file handle opened O_APPEND */
2383 #define FDEV                    0x40    /* file handle refers to device */
2384 #define FTEXT                   0x80    /* file handle is in text mode */
2385
2386 /***
2387 *int my_open_osfhandle(intptr_t osfhandle, int flags) - open C Runtime file handle
2388 *
2389 *Purpose:
2390 *       This function allocates a free C Runtime file handle and associates
2391 *       it with the Win32 HANDLE specified by the first parameter. This is a
2392 *       temperary fix for WIN95's brain damage GetFileType() error on socket
2393 *       we just bypass that call for socket
2394 *
2395 *       This works with MSVC++ 4.0+ or GCC/Mingw32
2396 *
2397 *Entry:
2398 *       intptr_t osfhandle - Win32 HANDLE to associate with C Runtime file handle.
2399 *       int flags      - flags to associate with C Runtime file handle.
2400 *
2401 *Exit:
2402 *       returns index of entry in fh, if successful
2403 *       return -1, if no free entry is found
2404 *
2405 *Exceptions:
2406 *
2407 *******************************************************************************/
2408
2409 /*
2410  * we fake up some parts of the CRT that aren't exported by MSVCRT.dll
2411  * this lets sockets work on Win9X with GCC and should fix the problems
2412  * with perl95.exe
2413  *      -- BKS, 1-23-2000
2414 */
2415
2416 /* create an ioinfo entry, kill its handle, and steal the entry */
2417
2418 static int
2419 _alloc_osfhnd(void)
2420 {
2421     HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL);
2422     int fh = _open_osfhandle((intptr_t)hF, 0);
2423     CloseHandle(hF);
2424     if (fh == -1)
2425         return fh;
2426     EnterCriticalSection(&(_pioinfo(fh)->lock));
2427     return fh;
2428 }
2429
2430 static int
2431 my_open_osfhandle(intptr_t osfhandle, int flags)
2432 {
2433     int fh;
2434     char fileflags;             /* _osfile flags */
2435
2436     /* copy relevant flags from second parameter */
2437     fileflags = FDEV;
2438
2439     if (flags & O_APPEND)
2440         fileflags |= FAPPEND;
2441
2442     if (flags & O_TEXT)
2443         fileflags |= FTEXT;
2444
2445     if (flags & O_NOINHERIT)
2446         fileflags |= FNOINHERIT;
2447
2448     /* attempt to allocate a C Runtime file handle */
2449     if ((fh = _alloc_osfhnd()) == -1) {
2450         errno = EMFILE;         /* too many open files */
2451         _doserrno = 0L;         /* not an OS error */
2452         return -1;              /* return error to caller */
2453     }
2454
2455     /* the file is open. now, set the info in _osfhnd array */
2456     _set_osfhnd(fh, osfhandle);
2457
2458     fileflags |= FOPEN;         /* mark as open */
2459
2460     _osfile(fh) = fileflags;    /* set osfile entry */
2461     LeaveCriticalSection(&_pioinfo(fh)->lock);
2462
2463     return fh;                  /* return handle */
2464 }
2465
2466 #endif  /* USE_FIXED_OSFHANDLE */
2467
2468 /* simulate flock by locking a range on the file */
2469
2470 #define LK_ERR(f,i)     ((f) ? (i = 0) : (errno = GetLastError()))
2471 #define LK_LEN          0xffff0000
2472
2473 DllExport int
2474 win32_flock(int fd, int oper)
2475 {
2476     OVERLAPPED o;
2477     int i = -1;
2478     HANDLE fh;
2479
2480     if (!IsWinNT()) {
2481         dTHX;
2482         Perl_croak_nocontext("flock() unimplemented on this platform");
2483         return -1;
2484     }
2485     fh = (HANDLE)_get_osfhandle(fd);
2486     memset(&o, 0, sizeof(o));
2487
2488     switch(oper) {
2489     case LOCK_SH:               /* shared lock */
2490         LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
2491         break;
2492     case LOCK_EX:               /* exclusive lock */
2493         LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
2494         break;
2495     case LOCK_SH|LOCK_NB:       /* non-blocking shared lock */
2496         LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
2497         break;
2498     case LOCK_EX|LOCK_NB:       /* non-blocking exclusive lock */
2499         LK_ERR(LockFileEx(fh,
2500                        LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
2501                        0, LK_LEN, 0, &o),i);
2502         break;
2503     case LOCK_UN:               /* unlock lock */
2504         LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
2505         break;
2506     default:                    /* unknown */
2507         errno = EINVAL;
2508         break;
2509     }
2510     return i;
2511 }
2512
2513 #undef LK_ERR
2514 #undef LK_LEN
2515
2516 /*
2517  *  redirected io subsystem for all XS modules
2518  *
2519  */
2520
2521 DllExport int *
2522 win32_errno(void)
2523 {
2524     return (&errno);
2525 }
2526
2527 DllExport char ***
2528 win32_environ(void)
2529 {
2530     return (&(_environ));
2531 }
2532
2533 /* the rest are the remapped stdio routines */
2534 DllExport FILE *
2535 win32_stderr(void)
2536 {
2537     return (stderr);
2538 }
2539
2540 DllExport FILE *
2541 win32_stdin(void)
2542 {
2543     return (stdin);
2544 }
2545
2546 DllExport FILE *
2547 win32_stdout()
2548 {
2549     return (stdout);
2550 }
2551
2552 DllExport int
2553 win32_ferror(FILE *fp)
2554 {
2555     return (ferror(fp));
2556 }
2557
2558
2559 DllExport int
2560 win32_feof(FILE *fp)
2561 {
2562     return (feof(fp));
2563 }
2564
2565 /*
2566  * Since the errors returned by the socket error function
2567  * WSAGetLastError() are not known by the library routine strerror
2568  * we have to roll our own.
2569  */
2570
2571 DllExport char *
2572 win32_strerror(int e)
2573 {
2574 #if !defined __BORLANDC__ && !defined __MINGW32__      /* compiler intolerance */
2575     extern int sys_nerr;
2576 #endif
2577     DWORD source = 0;
2578
2579     if (e < 0 || e > sys_nerr) {
2580         dTHX;
2581         if (e < 0)
2582             e = GetLastError();
2583
2584         if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
2585                           w32_strerror_buffer,
2586                           sizeof(w32_strerror_buffer), NULL) == 0)
2587             strcpy(w32_strerror_buffer, "Unknown Error");
2588
2589         return w32_strerror_buffer;
2590     }
2591     return strerror(e);
2592 }
2593
2594 DllExport void
2595 win32_str_os_error(void *sv, DWORD dwErr)
2596 {
2597     DWORD dwLen;
2598     char *sMsg;
2599     dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
2600                           |FORMAT_MESSAGE_IGNORE_INSERTS
2601                           |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
2602                            dwErr, 0, (char *)&sMsg, 1, NULL);
2603     /* strip trailing whitespace and period */
2604     if (0 < dwLen) {
2605         do {
2606             --dwLen;    /* dwLen doesn't include trailing null */
2607         } while (0 < dwLen && isSPACE(sMsg[dwLen]));
2608         if ('.' != sMsg[dwLen])
2609             dwLen++;
2610         sMsg[dwLen] = '\0';
2611     }
2612     if (0 == dwLen) {
2613         sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
2614         if (sMsg)
2615             dwLen = sprintf(sMsg,
2616                             "Unknown error #0x%lX (lookup 0x%lX)",
2617                             dwErr, GetLastError());
2618     }
2619     if (sMsg) {
2620         dTHX;
2621         sv_setpvn((SV*)sv, sMsg, dwLen);
2622         LocalFree(sMsg);
2623     }
2624 }
2625
2626 DllExport int
2627 win32_fprintf(FILE *fp, const char *format, ...)
2628 {
2629     va_list marker;
2630     va_start(marker, format);     /* Initialize variable arguments. */
2631
2632     return (vfprintf(fp, format, marker));
2633 }
2634
2635 DllExport int
2636 win32_printf(const char *format, ...)
2637 {
2638     va_list marker;
2639     va_start(marker, format);     /* Initialize variable arguments. */
2640
2641     return (vprintf(format, marker));
2642 }
2643
2644 DllExport int
2645 win32_vfprintf(FILE *fp, const char *format, va_list args)
2646 {
2647     return (vfprintf(fp, format, args));
2648 }
2649
2650 DllExport int
2651 win32_vprintf(const char *format, va_list args)
2652 {
2653     return (vprintf(format, args));
2654 }
2655
2656 DllExport size_t
2657 win32_fread(void *buf, size_t size, size_t count, FILE *fp)
2658 {
2659     return fread(buf, size, count, fp);
2660 }
2661
2662 DllExport size_t
2663 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
2664 {
2665     return fwrite(buf, size, count, fp);
2666 }
2667
2668 #define MODE_SIZE 10
2669
2670 DllExport FILE *
2671 win32_fopen(const char *filename, const char *mode)
2672 {
2673     dTHX;
2674     FILE *f;
2675
2676     if (!*filename)
2677         return NULL;
2678
2679     if (stricmp(filename, "/dev/null")==0)
2680         filename = "NUL";
2681
2682     f = fopen(PerlDir_mapA(filename), mode);
2683     /* avoid buffering headaches for child processes */
2684     if (f && *mode == 'a')
2685         win32_fseek(f, 0, SEEK_END);
2686     return f;
2687 }
2688
2689 #ifndef USE_SOCKETS_AS_HANDLES
2690 #undef fdopen
2691 #define fdopen my_fdopen
2692 #endif
2693
2694 DllExport FILE *
2695 win32_fdopen(int handle, const char *mode)
2696 {
2697     dTHX;
2698     FILE *f;
2699     f = fdopen(handle, (char *) mode);
2700     /* avoid buffering headaches for child processes */
2701     if (f && *mode == 'a')
2702         win32_fseek(f, 0, SEEK_END);
2703     return f;
2704 }
2705
2706 DllExport FILE *
2707 win32_freopen(const char *path, const char *mode, FILE *stream)
2708 {
2709     dTHX;
2710     if (stricmp(path, "/dev/null")==0)
2711         path = "NUL";
2712
2713     return freopen(PerlDir_mapA(path), mode, stream);
2714 }
2715
2716 DllExport int
2717 win32_fclose(FILE *pf)
2718 {
2719     return my_fclose(pf);       /* defined in win32sck.c */
2720 }
2721
2722 DllExport int
2723 win32_fputs(const char *s,FILE *pf)
2724 {
2725     return fputs(s, pf);
2726 }
2727
2728 DllExport int
2729 win32_fputc(int c,FILE *pf)
2730 {
2731     return fputc(c,pf);
2732 }
2733
2734 DllExport int
2735 win32_ungetc(int c,FILE *pf)
2736 {
2737     return ungetc(c,pf);
2738 }
2739
2740 DllExport int
2741 win32_getc(FILE *pf)
2742 {
2743     return getc(pf);
2744 }
2745
2746 DllExport int
2747 win32_fileno(FILE *pf)
2748 {
2749     return fileno(pf);
2750 }
2751
2752 DllExport void
2753 win32_clearerr(FILE *pf)
2754 {
2755     clearerr(pf);
2756     return;
2757 }
2758
2759 DllExport int
2760 win32_fflush(FILE *pf)
2761 {
2762     return fflush(pf);
2763 }
2764
2765 DllExport Off_t
2766 win32_ftell(FILE *pf)
2767 {
2768 #if defined(WIN64) || defined(USE_LARGE_FILES)
2769 #if defined(__BORLANDC__) /* buk */
2770     return win32_tell( fileno( pf ) );
2771 #else
2772     fpos_t pos;
2773     if (fgetpos(pf, &pos))
2774         return -1;
2775     return (Off_t)pos;
2776 #endif
2777 #else
2778     return ftell(pf);
2779 #endif
2780 }
2781
2782 DllExport int
2783 win32_fseek(FILE *pf, Off_t offset,int origin)
2784 {
2785 #if defined(WIN64) || defined(USE_LARGE_FILES)
2786 #if defined(__BORLANDC__) /* buk */
2787     return win32_lseek(
2788         fileno(pf),
2789         offset,
2790         origin
2791         );
2792 #else
2793     fpos_t pos;
2794     switch (origin) {
2795     case SEEK_CUR:
2796         if (fgetpos(pf, &pos))
2797             return -1;
2798         offset += pos;
2799         break;
2800     case SEEK_END:
2801         fseek(pf, 0, SEEK_END);
2802         pos = _telli64(fileno(pf));
2803         offset += pos;
2804         break;
2805     case SEEK_SET:
2806         break;
2807     default:
2808         errno = EINVAL;
2809         return -1;
2810     }
2811     return fsetpos(pf, &offset);
2812 #endif
2813 #else
2814     return fseek(pf, (long)offset, origin);
2815 #endif
2816 }
2817
2818 DllExport int
2819 win32_fgetpos(FILE *pf,fpos_t *p)
2820 {
2821 #if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
2822     if( win32_tell(fileno(pf)) == -1L ) {
2823         errno = EBADF;
2824         return -1;
2825     }
2826     return 0;
2827 #else
2828     return fgetpos(pf, p);
2829 #endif
2830 }
2831
2832 DllExport int
2833 win32_fsetpos(FILE *pf,const fpos_t *p)
2834 {
2835 #if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
2836     return win32_lseek(fileno(pf), *p, SEEK_CUR);
2837 #else
2838     return fsetpos(pf, p);
2839 #endif
2840 }
2841
2842 DllExport void
2843 win32_rewind(FILE *pf)
2844 {
2845     rewind(pf);
2846     return;
2847 }
2848
2849 DllExport int
2850 win32_tmpfd(void)
2851 {
2852     dTHX;
2853     char prefix[MAX_PATH+1];
2854     char filename[MAX_PATH+1];
2855     DWORD len = GetTempPath(MAX_PATH, prefix);
2856     if (len && len < MAX_PATH) {
2857         if (GetTempFileName(prefix, "plx", 0, filename)) {
2858             HANDLE fh = CreateFile(filename,
2859                                    DELETE | GENERIC_READ | GENERIC_WRITE,
2860                                    0,
2861                                    NULL,
2862                                    CREATE_ALWAYS,
2863                                    FILE_ATTRIBUTE_NORMAL
2864                                    | FILE_FLAG_DELETE_ON_CLOSE,
2865                                    NULL);
2866             if (fh != INVALID_HANDLE_VALUE) {
2867                 int fd = win32_open_osfhandle((intptr_t)fh, 0);
2868                 if (fd >= 0) {
2869 #if defined(__BORLANDC__)
2870                     setmode(fd,O_BINARY);
2871 #endif
2872                     DEBUG_p(PerlIO_printf(Perl_debug_log,
2873                                           "Created tmpfile=%s\n",filename));
2874                     return fd;
2875                 }
2876             }
2877         }
2878     }
2879     return -1;
2880 }
2881
2882 DllExport FILE*
2883 win32_tmpfile(void)
2884 {
2885     int fd = win32_tmpfd();
2886     if (fd >= 0)
2887         return win32_fdopen(fd, "w+b");
2888     return NULL;
2889 }
2890
2891 DllExport void
2892 win32_abort(void)
2893 {
2894     abort();
2895     return;
2896 }
2897
2898 DllExport int
2899 win32_fstat(int fd, Stat_t *sbufptr)
2900 {
2901 #ifdef __BORLANDC__
2902     /* A file designated by filehandle is not shown as accessible
2903      * for write operations, probably because it is opened for reading.
2904      * --Vadim Konovalov
2905      */
2906     BY_HANDLE_FILE_INFORMATION bhfi;
2907 #if defined(WIN64) || defined(USE_LARGE_FILES)
2908     /* Borland 5.5.1 has a 64-bit stat, but only a 32-bit fstat */
2909     struct stat tmp;
2910     int rc = fstat(fd,&tmp);
2911
2912     sbufptr->st_dev   = tmp.st_dev;
2913     sbufptr->st_ino   = tmp.st_ino;
2914     sbufptr->st_mode  = tmp.st_mode;
2915     sbufptr->st_nlink = tmp.st_nlink;
2916     sbufptr->st_uid   = tmp.st_uid;
2917     sbufptr->st_gid   = tmp.st_gid;
2918     sbufptr->st_rdev  = tmp.st_rdev;
2919     sbufptr->st_size  = tmp.st_size;
2920     sbufptr->st_atime = tmp.st_atime;
2921     sbufptr->st_mtime = tmp.st_mtime;
2922     sbufptr->st_ctime = tmp.st_ctime;
2923 #else
2924     int rc = fstat(fd,sbufptr);
2925 #endif
2926
2927     if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) {
2928 #if defined(WIN64) || defined(USE_LARGE_FILES)
2929         sbufptr->st_size = (bhfi.nFileSizeHigh << 32) + bhfi.nFileSizeLow ;
2930 #endif
2931         sbufptr->st_mode &= 0xFE00;
2932         if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
2933             sbufptr->st_mode |= (S_IREAD + (S_IREAD >> 3) + (S_IREAD >> 6));
2934         else
2935             sbufptr->st_mode |= ((S_IREAD|S_IWRITE) + ((S_IREAD|S_IWRITE) >> 3)
2936               + ((S_IREAD|S_IWRITE) >> 6));
2937     }
2938     return rc;
2939 #else
2940     return my_fstat(fd,sbufptr);
2941 #endif
2942 }
2943
2944 DllExport int
2945 win32_pipe(int *pfd, unsigned int size, int mode)
2946 {
2947     return _pipe(pfd, size, mode);
2948 }
2949
2950 DllExport PerlIO*
2951 win32_popenlist(const char *mode, IV narg, SV **args)
2952 {
2953  dTHX;
2954  Perl_croak(aTHX_ "List form of pipe open not implemented");
2955  return NULL;
2956 }
2957
2958 /*
2959  * a popen() clone that respects PERL5SHELL
2960  *
2961  * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
2962  */
2963
2964 DllExport PerlIO*
2965 win32_popen(const char *command, const char *mode)
2966 {
2967 #ifdef USE_RTL_POPEN
2968     return _popen(command, mode);
2969 #else
2970     dTHX;
2971     int p[2];
2972     int parent, child;
2973     int stdfd, oldfd;
2974     int ourmode;
2975     int childpid;
2976     DWORD nhandle;
2977     HANDLE old_h;
2978     int lock_held = 0;
2979
2980     /* establish which ends read and write */
2981     if (strchr(mode,'w')) {
2982         stdfd = 0;              /* stdin */
2983         parent = 1;
2984         child = 0;
2985         nhandle = STD_INPUT_HANDLE;
2986     }
2987     else if (strchr(mode,'r')) {
2988         stdfd = 1;              /* stdout */
2989         parent = 0;
2990         child = 1;
2991         nhandle = STD_OUTPUT_HANDLE;
2992     }
2993     else
2994         return NULL;
2995
2996     /* set the correct mode */
2997     if (strchr(mode,'b'))
2998         ourmode = O_BINARY;
2999     else if (strchr(mode,'t'))
3000         ourmode = O_TEXT;
3001     else
3002         ourmode = _fmode & (O_TEXT | O_BINARY);
3003
3004     /* the child doesn't inherit handles */
3005     ourmode |= O_NOINHERIT;
3006
3007     if (win32_pipe(p, 512, ourmode) == -1)
3008         return NULL;
3009
3010     /* save the old std handle (this needs to happen before the
3011      * dup2(), since that might call SetStdHandle() too) */
3012     OP_REFCNT_LOCK;
3013     lock_held = 1;
3014     old_h = GetStdHandle(nhandle);
3015
3016     /* save current stdfd */
3017     if ((oldfd = win32_dup(stdfd)) == -1)
3018         goto cleanup;
3019
3020     /* make stdfd go to child end of pipe (implicitly closes stdfd) */
3021     /* stdfd will be inherited by the child */
3022     if (win32_dup2(p[child], stdfd) == -1)
3023         goto cleanup;
3024
3025     /* close the child end in parent */
3026     win32_close(p[child]);
3027
3028     /* set the new std handle (in case dup2() above didn't) */
3029     SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
3030
3031     /* start the child */
3032     {
3033         dTHX;
3034         if ((childpid = do_spawn_nowait((char*)command)) == -1)
3035             goto cleanup;
3036
3037         /* revert stdfd to whatever it was before */
3038         if (win32_dup2(oldfd, stdfd) == -1)
3039             goto cleanup;
3040
3041         /* close saved handle */
3042         win32_close(oldfd);
3043
3044         /* restore the old std handle (this needs to happen after the
3045          * dup2(), since that might call SetStdHandle() too */
3046         if (lock_held) {
3047             SetStdHandle(nhandle, old_h);
3048             OP_REFCNT_UNLOCK;
3049             lock_held = 0;
3050         }
3051
3052         LOCK_FDPID_MUTEX;
3053         sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
3054         UNLOCK_FDPID_MUTEX;
3055
3056         /* set process id so that it can be returned by perl's open() */
3057         PL_forkprocess = childpid;
3058     }
3059
3060     /* we have an fd, return a file stream */
3061     return (PerlIO_fdopen(p[parent], (char *)mode));
3062
3063 cleanup:
3064     /* we don't need to check for errors here */
3065     win32_close(p[0]);
3066     win32_close(p[1]);
3067     if (oldfd != -1) {
3068         win32_dup2(oldfd, stdfd);
3069         win32_close(oldfd);
3070     }
3071     if (lock_held) {
3072         SetStdHandle(nhandle, old_h);
3073         OP_REFCNT_UNLOCK;
3074         lock_held = 0;
3075     }
3076     return (NULL);
3077
3078 #endif /* USE_RTL_POPEN */
3079 }
3080
3081 /*
3082  * pclose() clone
3083  */
3084
3085 DllExport int
3086 win32_pclose(PerlIO *pf)
3087 {
3088 #ifdef USE_RTL_POPEN
3089     return _pclose(pf);
3090 #else
3091     dTHX;
3092     int childpid, status;
3093     SV *sv;
3094
3095     LOCK_FDPID_MUTEX;
3096     sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
3097
3098     if (SvIOK(sv))
3099         childpid = SvIVX(sv);
3100     else
3101         childpid = 0;
3102
3103     if (!childpid) {
3104         UNLOCK_FDPID_MUTEX;
3105         errno = EBADF;
3106         return -1;
3107     }
3108
3109 #ifdef USE_PERLIO
3110     PerlIO_close(pf);
3111 #else
3112     fclose(pf);
3113 #endif
3114     SvIVX(sv) = 0;
3115     UNLOCK_FDPID_MUTEX;
3116
3117     if (win32_waitpid(childpid, &status, 0) == -1)
3118         return -1;
3119
3120     return status;
3121
3122 #endif /* USE_RTL_POPEN */
3123 }
3124
3125 static BOOL WINAPI
3126 Nt4CreateHardLinkW(
3127     LPCWSTR lpFileName,
3128     LPCWSTR lpExistingFileName,
3129     LPSECURITY_ATTRIBUTES lpSecurityAttributes)
3130 {
3131     HANDLE handle;
3132     WCHAR wFullName[MAX_PATH+1];
3133     LPVOID lpContext = NULL;
3134     WIN32_STREAM_ID StreamId;
3135     DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId;
3136     DWORD dwWritten;
3137     DWORD dwLen;
3138     BOOL bSuccess;
3139
3140     BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD,
3141                                      BOOL, BOOL, LPVOID*) =
3142         (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD,
3143                             BOOL, BOOL, LPVOID*))
3144         GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite");
3145     if (pfnBackupWrite == NULL)
3146         return 0;
3147
3148     dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL);
3149     if (dwLen == 0)
3150         return 0;
3151     dwLen = (dwLen+1)*sizeof(WCHAR);
3152
3153     handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES,
3154                          FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
3155                          NULL, OPEN_EXISTING, 0, NULL);
3156     if (handle == INVALID_HANDLE_VALUE)
3157         return 0;
3158
3159     StreamId.dwStreamId = BACKUP_LINK;
3160     StreamId.dwStreamAttributes = 0;
3161     StreamId.dwStreamNameSize = 0;
3162 #if defined(__BORLANDC__) \
3163  ||(defined(__MINGW32__) && !defined(_ANONYMOUS_UNION))
3164     StreamId.Size.u.HighPart = 0;
3165     StreamId.Size.u.LowPart = dwLen;
3166 #else
3167     StreamId.Size.HighPart = 0;
3168     StreamId.Size.LowPart = dwLen;
3169 #endif
3170
3171     bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
3172                               FALSE, FALSE, &lpContext);
3173     if (bSuccess) {
3174         bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten,
3175                                   FALSE, FALSE, &lpContext);
3176         pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext);
3177     }
3178
3179     CloseHandle(handle);
3180     return bSuccess;
3181 }
3182
3183 DllExport int
3184 win32_link(const char *oldname, const char *newname)
3185 {
3186     dTHX;
3187     BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
3188     WCHAR wOldName[MAX_PATH+1];
3189     WCHAR wNewName[MAX_PATH+1];
3190
3191     if (IsWin95())
3192         Perl_croak(aTHX_ PL_no_func, "link");
3193
3194     pfnCreateHardLinkW =
3195         (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES))
3196         GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW");
3197     if (pfnCreateHardLinkW == NULL)
3198         pfnCreateHardLinkW = Nt4CreateHardLinkW;
3199
3200     if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
3201         MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
3202         (wcscpy(wOldName, PerlDir_mapW(wOldName)),
3203         pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
3204     {
3205         return 0;
3206     }
3207     errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
3208     return -1;
3209 }
3210
3211 DllExport int
3212 win32_rename(const char *oname, const char *newname)
3213 {
3214     char szOldName[MAX_PATH+1];
3215     char szNewName[MAX_PATH+1];
3216     BOOL bResult;
3217     dTHX;
3218
3219     /* XXX despite what the documentation says about MoveFileEx(),
3220      * it doesn't work under Windows95!
3221      */
3222     if (IsWinNT()) {
3223         DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
3224         if (stricmp(newname, oname))
3225             dwFlags |= MOVEFILE_REPLACE_EXISTING;
3226         strcpy(szOldName, PerlDir_mapA(oname));
3227         bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
3228         if (!bResult) {
3229             DWORD err = GetLastError();
3230             switch (err) {
3231             case ERROR_BAD_NET_NAME:
3232             case ERROR_BAD_NETPATH:
3233             case ERROR_BAD_PATHNAME:
3234             case ERROR_FILE_NOT_FOUND:
3235             case ERROR_FILENAME_EXCED_RANGE:
3236             case ERROR_INVALID_DRIVE:
3237             case ERROR_NO_MORE_FILES:
3238             case ERROR_PATH_NOT_FOUND:
3239                 errno = ENOENT;
3240                 break;
3241             default:
3242                 errno = EACCES;
3243                 break;
3244             }
3245             return -1;
3246         }
3247         return 0;
3248     }
3249     else {
3250         int retval = 0;
3251         char szTmpName[MAX_PATH+1];
3252         char dname[MAX_PATH+1];
3253         char *endname = Nullch;
3254         STRLEN tmplen = 0;
3255         DWORD from_attr, to_attr;
3256
3257         strcpy(szOldName, PerlDir_mapA(oname));
3258         strcpy(szNewName, PerlDir_mapA(newname));
3259
3260         /* if oname doesn't exist, do nothing */
3261         from_attr = GetFileAttributes(szOldName);
3262         if (from_attr == 0xFFFFFFFF) {
3263             errno = ENOENT;
3264             return -1;
3265         }
3266
3267         /* if newname exists, rename it to a temporary name so that we
3268          * don't delete it in case oname happens to be the same file
3269          * (but perhaps accessed via a different path)
3270          */
3271         to_attr = GetFileAttributes(szNewName);
3272         if (to_attr != 0xFFFFFFFF) {
3273             /* if newname is a directory, we fail
3274              * XXX could overcome this with yet more convoluted logic */
3275             if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
3276                 errno = EACCES;
3277                 return -1;
3278             }
3279             tmplen = strlen(szNewName);
3280             strcpy(szTmpName,szNewName);
3281             endname = szTmpName+tmplen;
3282             for (; endname > szTmpName ; --endname) {
3283                 if (*endname == '/' || *endname == '\\') {
3284                     *endname = '\0';
3285                     break;
3286                 }
3287             }
3288             if (endname > szTmpName)
3289                 endname = strcpy(dname,szTmpName);
3290             else
3291                 endname = ".";
3292
3293             /* get a temporary filename in same directory
3294              * XXX is this really the best we can do? */
3295             if (!GetTempFileName((LPCTSTR)endname, "plr", 0, szTmpName)) {
3296                 errno = ENOENT;
3297                 return -1;
3298             }
3299             DeleteFile(szTmpName);
3300
3301             retval = rename(szNewName, szTmpName);
3302             if (retval != 0) {
3303                 errno = EACCES;
3304                 return retval;
3305             }
3306         }
3307
3308         /* rename oname to newname */
3309         retval = rename(szOldName, szNewName);
3310
3311         /* if we created a temporary file before ... */
3312         if (endname != Nullch) {
3313             /* ...and rename succeeded, delete temporary file/directory */
3314             if (retval == 0)
3315                 DeleteFile(szTmpName);
3316             /* else restore it to what it was */
3317             else
3318                 (void)rename(szTmpName, szNewName);
3319         }
3320         return retval;
3321     }
3322 }
3323
3324 DllExport int
3325 win32_setmode(int fd, int mode)
3326 {
3327     return setmode(fd, mode);
3328 }
3329
3330 DllExport int
3331 win32_chsize(int fd, Off_t size)
3332 {
3333 #if defined(WIN64) || defined(USE_LARGE_FILES)
3334     int retval = 0;
3335     Off_t cur, end, extend;
3336
3337     cur = win32_tell(fd);
3338     if (cur < 0)
3339         return -1;
3340     end = win32_lseek(fd, 0, SEEK_END);
3341     if (end < 0)
3342         return -1;
3343     extend = size - end;
3344     if (extend == 0) {
3345         /* do nothing */
3346     }
3347     else if (extend > 0) {
3348         /* must grow the file, padding with nulls */
3349         char b[4096];
3350         int oldmode = win32_setmode(fd, O_BINARY);
3351         size_t count;
3352         memset(b, '\0', sizeof(b));
3353         do {
3354             count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
3355             count = win32_write(fd, b, count);
3356             if ((int)count < 0) {
3357                 retval = -1;
3358                 break;
3359             }
3360         } while ((extend -= count) > 0);
3361         win32_setmode(fd, oldmode);
3362     }
3363     else {
3364         /* shrink the file */
3365         win32_lseek(fd, size, SEEK_SET);
3366         if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
3367             errno = EACCES;
3368             retval = -1;
3369         }
3370     }
3371 finish:
3372     win32_lseek(fd, cur, SEEK_SET);
3373     return retval;
3374 #else
3375     return chsize(fd, (long)size);
3376 #endif
3377 }
3378
3379 DllExport Off_t
3380 win32_lseek(int fd, Off_t offset, int origin)
3381 {
3382 #if defined(WIN64) || defined(USE_LARGE_FILES)
3383 #if defined(__BORLANDC__) /* buk */
3384     LARGE_INTEGER pos;
3385     pos.QuadPart = offset;
3386     pos.LowPart = SetFilePointer(
3387         (HANDLE)_get_osfhandle(fd),
3388         pos.LowPart,
3389         &pos.HighPart,
3390         origin
3391     );
3392     if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
3393         pos.QuadPart = -1;
3394     }
3395
3396     return pos.QuadPart;
3397 #else
3398     return _lseeki64(fd, offset, origin);
3399 #endif
3400 #else
3401     return lseek(fd, (long)offset, origin);
3402 #endif
3403 }
3404
3405 DllExport Off_t
3406 win32_tell(int fd)
3407 {
3408 #if defined(WIN64) || defined(USE_LARGE_FILES)
3409 #if defined(__BORLANDC__) /* buk */
3410     LARGE_INTEGER pos;
3411     pos.QuadPart = 0;
3412     pos.LowPart = SetFilePointer(
3413         (HANDLE)_get_osfhandle(fd),
3414         pos.LowPart,
3415         &pos.HighPart,
3416         FILE_CURRENT
3417     );
3418     if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
3419         pos.QuadPart = -1;
3420     }
3421
3422     return pos.QuadPart;
3423     /* return tell(fd); */
3424 #else
3425     return _telli64(fd);
3426 #endif
3427 #else
3428     return tell(fd);
3429 #endif
3430 }
3431
3432 DllExport int
3433 win32_open(const char *path, int flag, ...)
3434 {
3435     dTHX;
3436     va_list ap;
3437     int pmode;
3438
3439     va_start(ap, flag);
3440     pmode = va_arg(ap, int);
3441     va_end(ap);
3442
3443     if (stricmp(path, "/dev/null")==0)
3444         path = "NUL";
3445
3446     return open(PerlDir_mapA(path), flag, pmode);
3447 }
3448
3449 /* close() that understands socket */
3450 extern int my_close(int);       /* in win32sck.c */
3451
3452 DllExport int
3453 win32_close(int fd)
3454 {
3455     return my_close(fd);
3456 }
3457
3458 DllExport int
3459 win32_eof(int fd)
3460 {
3461     return eof(fd);
3462 }
3463
3464 DllExport int
3465 win32_dup(int fd)
3466 {
3467     return dup(fd);
3468 }
3469
3470 DllExport int
3471 win32_dup2(int fd1,int fd2)
3472 {
3473     return dup2(fd1,fd2);
3474 }
3475
3476 #ifdef PERL_MSVCRT_READFIX
3477
3478 #define LF              10      /* line feed */
3479 #define CR              13      /* carriage return */
3480 #define CTRLZ           26      /* ctrl-z means eof for text */
3481 #define FOPEN           0x01    /* file handle open */
3482 #define FEOFLAG         0x02    /* end of file has been encountered */
3483 #define FCRLF           0x04    /* CR-LF across read buffer (in text mode) */
3484 #define FPIPE           0x08    /* file handle refers to a pipe */
3485 #define FAPPEND         0x20    /* file handle opened O_APPEND */
3486 #define FDEV            0x40    /* file handle refers to device */
3487 #define FTEXT           0x80    /* file handle is in text mode */
3488 #define MAX_DESCRIPTOR_COUNT    (64*32) /* this is the maximun that MSVCRT can handle */
3489
3490 int __cdecl
3491 _fixed_read(int fh, void *buf, unsigned cnt)
3492 {
3493     int bytes_read;                 /* number of bytes read */
3494     char *buffer;                   /* buffer to read to */
3495     int os_read;                    /* bytes read on OS call */
3496     char *p, *q;                    /* pointers into buffer */
3497     char peekchr;                   /* peek-ahead character */
3498     ULONG filepos;                  /* file position after seek */
3499     ULONG dosretval;                /* o.s. return value */
3500
3501     /* validate handle */
3502     if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) ||
3503          !(_osfile(fh) & FOPEN))
3504     {
3505         /* out of range -- return error */
3506         errno = EBADF;
3507         _doserrno = 0;  /* not o.s. error */
3508         return -1;
3509     }
3510
3511     /*
3512      * If lockinitflag is FALSE, assume fd is device
3513      * lockinitflag is set to TRUE by open.
3514      */
3515     if (_pioinfo(fh)->lockinitflag)
3516         EnterCriticalSection(&(_pioinfo(fh)->lock));  /* lock file */
3517
3518     bytes_read = 0;                 /* nothing read yet */
3519     buffer = (char*)buf;
3520
3521     if (cnt == 0 || (_osfile(fh) & FEOFLAG)) {
3522         /* nothing to read or at EOF, so return 0 read */
3523         goto functionexit;
3524     }
3525
3526     if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) {
3527         /* a pipe/device and pipe lookahead non-empty: read the lookahead
3528          * char */
3529         *buffer++ = _pipech(fh);
3530         ++bytes_read;
3531         --cnt;
3532         _pipech(fh) = LF;           /* mark as empty */
3533     }
3534
3535     /* read the data */
3536
3537     if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL))
3538     {
3539         /* ReadFile has reported an error. recognize two special cases.
3540          *
3541          *      1. map ERROR_ACCESS_DENIED to EBADF
3542          *
3543          *      2. just return 0 if ERROR_BROKEN_PIPE has occurred. it
3544          *         means the handle is a read-handle on a pipe for which
3545          *         all write-handles have been closed and all data has been
3546          *         read. */
3547
3548         if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) {
3549             /* wrong read/write mode should return EBADF, not EACCES */
3550             errno = EBADF;
3551             _doserrno = dosretval;
3552             bytes_read = -1;
3553             goto functionexit;
3554         }
3555         else if (dosretval == ERROR_BROKEN_PIPE) {
3556             bytes_read = 0;
3557             goto functionexit;
3558         }
3559         else {
3560             bytes_read = -1;
3561             goto functionexit;
3562         }
3563     }
3564
3565     bytes_read += os_read;          /* update bytes read */
3566
3567     if (_osfile(fh) & FTEXT) {
3568         /* now must translate CR-LFs to LFs in the buffer */
3569
3570         /* set CRLF flag to indicate LF at beginning of buffer */
3571         /* if ((os_read != 0) && (*(char *)buf == LF))   */
3572         /*    _osfile(fh) |= FCRLF;                      */
3573         /* else                                          */
3574         /*    _osfile(fh) &= ~FCRLF;                     */
3575
3576         _osfile(fh) &= ~FCRLF;
3577
3578         /* convert chars in the buffer: p is src, q is dest */
3579         p = q = (char*)buf;
3580         while (p < (char *)buf + bytes_read) {
3581             if (*p == CTRLZ) {
3582                 /* if fh is not a device, set ctrl-z flag */
3583                 if (!(_osfile(fh) & FDEV))
3584                     _osfile(fh) |= FEOFLAG;
3585                 break;              /* stop translating */
3586             }
3587             else if (*p != CR)
3588                 *q++ = *p++;
3589             else {
3590                 /* *p is CR, so must check next char for LF */
3591                 if (p < (char *)buf + bytes_read - 1) {
3592                     if (*(p+1) == LF) {
3593                         p += 2;
3594                         *q++ = LF;  /* convert CR-LF to LF */
3595                     }
3596                     else
3597                         *q++ = *p++;    /* store char normally */
3598                 }
3599                 else {
3600                     /* This is the hard part.  We found a CR at end of
3601                        buffer.  We must peek ahead to see if next char
3602                        is an LF. */
3603                     ++p;
3604
3605                     dosretval = 0;
3606                     if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1,
3607                                     (LPDWORD)&os_read, NULL))
3608                         dosretval = GetLastError();
3609
3610                     if (dosretval != 0 || os_read == 0) {
3611                         /* couldn't read ahead, store CR */
3612                         *q++ = CR;
3613                     }
3614                     else {
3615                         /* peekchr now has the extra character -- we now
3616                            have several possibilities:
3617                            1. disk file and char is not LF; just seek back
3618                               and copy CR
3619                            2. disk file and char is LF; store LF, don't seek back
3620                            3. pipe/device and char is LF; store LF.
3621                            4. pipe/device and char isn't LF, store CR and
3622                               put char in pipe lookahead buffer. */
3623                         if (_osfile(fh) & (FDEV|FPIPE)) {
3624                             /* non-seekable device */
3625                             if (peekchr == LF)
3626                                 *q++ = LF;
3627                             else {
3628                                 *q++ = CR;
3629                                 _pipech(fh) = peekchr;
3630                             }
3631                         }
3632                         else {
3633                             /* disk file */
3634                             if (peekchr == LF) {
3635                                 /* nothing read yet; must make some
3636                                    progress */
3637                                 *q++ = LF;
3638                                 /* turn on this flag for tell routine */
3639                                 _osfile(fh) |= FCRLF;
3640                             }
3641                             else {
3642                                 HANDLE osHandle;        /* o.s. handle value */
3643                                 /* seek back */
3644                                 if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1)
3645                                 {
3646                                     if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1)
3647                                         dosretval = GetLastError();
3648                                 }
3649                                 if (peekchr != LF)
3650                                     *q++ = CR;
3651                             }
3652                         }
3653                     }
3654                 }
3655             }
3656         }
3657
3658         /* we now change bytes_read to reflect the true number of chars
3659            in the buffer */
3660         bytes_read = q - (char *)buf;
3661     }
3662
3663 functionexit:
3664     if (_pioinfo(fh)->lockinitflag)
3665         LeaveCriticalSection(&(_pioinfo(fh)->lock));    /* unlock file */
3666
3667     return bytes_read;
3668 }
3669
3670 #endif  /* PERL_MSVCRT_READFIX */
3671
3672 DllExport int
3673 win32_read(int fd, void *buf, unsigned int cnt)
3674 {
3675 #ifdef PERL_MSVCRT_READFIX
3676     return _fixed_read(fd, buf, cnt);
3677 #else
3678     return read(fd, buf, cnt);
3679 #endif
3680 }
3681
3682 DllExport int
3683 win32_write(int fd, const void *buf, unsigned int cnt)
3684 {
3685     return write(fd, buf, cnt);
3686 }
3687
3688 DllExport int
3689 win32_mkdir(const char *dir, int mode)
3690 {
3691     dTHX;
3692     return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
3693 }
3694
3695 DllExport int
3696 win32_rmdir(const char *dir)
3697 {
3698     dTHX;
3699     return rmdir(PerlDir_mapA(dir));
3700 }
3701
3702 DllExport int
3703 win32_chdir(const char *dir)
3704 {
3705     dTHX;
3706     if (!dir) {
3707         errno = ENOENT;
3708         return -1;
3709     }
3710     return chdir(dir);
3711 }
3712
3713 DllExport  int
3714 win32_access(const char *path, int mode)
3715 {
3716     dTHX;
3717     return access(PerlDir_mapA(path), mode);
3718 }
3719
3720 DllExport  int
3721 win32_chmod(const char *path, int mode)
3722 {
3723     dTHX;
3724     return chmod(PerlDir_mapA(path), mode);
3725 }
3726
3727
3728 static char *
3729 create_command_line(char *cname, STRLEN clen, const char * const *args)
3730 {
3731     dTHX;
3732     int index, argc;
3733     char *cmd, *ptr;
3734     const char *arg;
3735     STRLEN len = 0;
3736     bool bat_file = FALSE;
3737     bool cmd_shell = FALSE;
3738     bool dumb_shell = FALSE;
3739     bool extra_quotes = FALSE;
3740     bool quote_next = FALSE;
3741
3742     if (!cname)
3743         cname = (char*)args[0];
3744
3745     /* The NT cmd.exe shell has the following peculiarity that needs to be
3746      * worked around.  It strips a leading and trailing dquote when any
3747      * of the following is true:
3748      *    1. the /S switch was used
3749      *    2. there are more than two dquotes
3750      *    3. there is a special character from this set: &<>()@^|
3751      *    4. no whitespace characters within the two dquotes
3752      *    5. string between two dquotes isn't an executable file
3753      * To work around this, we always add a leading and trailing dquote
3754      * to the string, if the first argument is either "cmd.exe" or "cmd",
3755      * and there were at least two or more arguments passed to cmd.exe
3756      * (not including switches).
3757      * XXX the above rules (from "cmd /?") don't seem to be applied
3758      * always, making for the convolutions below :-(
3759      */
3760     if (cname) {
3761         if (!clen)
3762             clen = strlen(cname);
3763
3764         if (clen > 4
3765             && (stricmp(&cname[clen-4], ".bat") == 0
3766                 || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
3767         {
3768             bat_file = TRUE;
3769             if (!IsWin95())
3770                 len += 3;
3771         }
3772         else {
3773             char *exe = strrchr(cname, '/');
3774             char *exe2 = strrchr(cname, '\\');
3775             if (exe2 > exe)
3776                 exe = exe2;
3777             if (exe)
3778                 ++exe;
3779             else
3780                 exe = cname;
3781             if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
3782                 cmd_shell = TRUE;
3783                 len += 3;
3784             }
3785             else if (stricmp(exe, "command.com") == 0
3786                      || stricmp(exe, "command") == 0)
3787             {
3788                 dumb_shell = TRUE;
3789             }
3790         }
3791     }
3792
3793     DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
3794     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3795         STRLEN curlen = strlen(arg);
3796         if (!(arg[0] == '"' && arg[curlen-1] == '"'))
3797             len += 2;   /* assume quoting needed (worst case) */
3798         len += curlen + 1;
3799         DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
3800     }
3801     DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
3802
3803     argc = index;
3804     Newx(cmd, len, char);
3805     ptr = cmd;
3806
3807     if (bat_file && !IsWin95()) {
3808         *ptr++ = '"';
3809         extra_quotes = TRUE;
3810     }
3811
3812     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
3813         bool do_quote = 0;
3814         STRLEN curlen = strlen(arg);
3815
3816         /* we want to protect empty arguments and ones with spaces with
3817          * dquotes, but only if they aren't already there */
3818         if (!dumb_shell) {
3819             if (!curlen) {
3820                 do_quote = 1;
3821             }
3822             else if (quote_next) {
3823                 /* see if it really is multiple arguments pretending to
3824                  * be one and force a set of quotes around it */
3825                 if (*find_next_space(arg))
3826                     do_quote = 1;
3827             }
3828             else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
3829                 STRLEN i = 0;
3830                 while (i < curlen) {
3831                     if (isSPACE(arg[i])) {
3832                         do_quote = 1;
3833                     }
3834                     else if (arg[i] == '"') {
3835                         do_quote = 0;
3836                         break;
3837                     }
3838                     i++;
3839                 }
3840             }
3841         }
3842
3843         if (do_quote)
3844             *ptr++ = '"';
3845
3846         strcpy(ptr, arg);
3847         ptr += curlen;
3848
3849         if (do_quote)
3850             *ptr++ = '"';
3851
3852         if (args[index+1])
3853             *ptr++ = ' ';
3854
3855         if (!extra_quotes
3856             && cmd_shell
3857             && curlen >= 2
3858             && *arg  == '/'     /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
3859             && stricmp(arg+curlen-2, "/c") == 0)
3860         {
3861             /* is there a next argument? */
3862             if (args[index+1]) {
3863                 /* are there two or more next arguments? */
3864                 if (args[index+2]) {
3865                     *ptr++ = '"';
3866                     extra_quotes = TRUE;
3867                 }
3868                 else {
3869                     /* single argument, force quoting if it has spaces */
3870                     quote_next = TRUE;
3871                 }
3872             }
3873         }
3874     }
3875
3876     if (extra_quotes)
3877         *ptr++ = '"';
3878
3879     *ptr = '\0';
3880
3881     return cmd;
3882 }
3883
3884 static char *
3885 qualified_path(const char *cmd)
3886 {
3887     dTHX;
3888     char *pathstr;
3889     char *fullcmd, *curfullcmd;
3890     STRLEN cmdlen = 0;
3891     int has_slash = 0;
3892
3893     if (!cmd)
3894         return Nullch;
3895     fullcmd = (char*)cmd;
3896     while (*fullcmd) {
3897         if (*fullcmd == '/' || *fullcmd == '\\')
3898             has_slash++;
3899         fullcmd++;
3900         cmdlen++;
3901     }
3902
3903     /* look in PATH */
3904     pathstr = PerlEnv_getenv("PATH");
3905
3906     /* worst case: PATH is a single directory; we need additional space
3907      * to append "/", ".exe" and trailing "\0" */
3908     Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
3909     curfullcmd = fullcmd;
3910
3911     while (1) {
3912         DWORD res;
3913
3914         /* start by appending the name to the current prefix */
3915         strcpy(curfullcmd, cmd);
3916         curfullcmd += cmdlen;
3917
3918         /* if it doesn't end with '.', or has no extension, try adding
3919          * a trailing .exe first */
3920         if (cmd[cmdlen-1] != '.'
3921             && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
3922         {
3923             strcpy(curfullcmd, ".exe");
3924             res = GetFileAttributes(fullcmd);
3925             if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3926                 return fullcmd;
3927             *curfullcmd = '\0';
3928         }
3929
3930         /* that failed, try the bare name */
3931         res = GetFileAttributes(fullcmd);
3932         if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
3933             return fullcmd;
3934
3935         /* quit if no other path exists, or if cmd already has path */
3936         if (!pathstr || !*pathstr || has_slash)
3937             break;
3938
3939         /* skip leading semis */
3940         while (*pathstr == ';')
3941             pathstr++;
3942
3943         /* build a new prefix from scratch */
3944         curfullcmd = fullcmd;
3945         while (*pathstr && *pathstr != ';') {
3946             if (*pathstr == '"') {      /* foo;"baz;etc";bar */
3947                 pathstr++;              /* skip initial '"' */
3948                 while (*pathstr && *pathstr != '"') {
3949                     *curfullcmd++ = *pathstr++;
3950                 }
3951                 if (*pathstr)
3952                     pathstr++;          /* skip trailing '"' */
3953             }
3954             else {
3955                 *curfullcmd++ = *pathstr++;
3956             }
3957         }
3958         if (*pathstr)
3959             pathstr++;                  /* skip trailing semi */
3960         if (curfullcmd > fullcmd        /* append a dir separator */
3961             && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
3962         {
3963             *curfullcmd++ = '\\';
3964         }
3965     }
3966
3967     Safefree(fullcmd);
3968     return Nullch;
3969 }
3970
3971 /* The following are just place holders.
3972  * Some hosts may provide and environment that the OS is
3973  * not tracking, therefore, these host must provide that
3974  * environment and the current directory to CreateProcess
3975  */
3976
3977 DllExport void*
3978 win32_get_childenv(void)
3979 {
3980     return NULL;
3981 }
3982
3983 DllExport void
3984 win32_free_childenv(void* d)
3985 {
3986 }
3987
3988 DllExport void
3989 win32_clearenv(void)
3990 {
3991     char *envv = GetEnvironmentStrings();
3992     char *cur = envv;
3993     STRLEN len;
3994     while (*cur) {
3995         char *end = strchr(cur,'=');
3996         if (end && end != cur) {
3997             *end = '\0';
3998             SetEnvironmentVariable(cur, NULL);
3999             *end = '=';
4000             cur = end + strlen(end+1)+2;
4001         }
4002         else if ((len = strlen(cur)))
4003             cur += len+1;
4004     }
4005     FreeEnvironmentStrings(envv);
4006 }
4007
4008 DllExport char*
4009 win32_get_childdir(void)
4010 {
4011     dTHX;
4012     char* ptr;
4013     char szfilename[MAX_PATH+1];
4014
4015     GetCurrentDirectoryA(MAX_PATH+1, szfilename);
4016     Newx(ptr, strlen(szfilename)+1, char);
4017     strcpy(ptr, szfilename);
4018     return ptr;
4019 }
4020
4021 DllExport void
4022 win32_free_childdir(char* d)
4023 {
4024     dTHX;
4025     Safefree(d);
4026 }
4027
4028
4029 /* XXX this needs to be made more compatible with the spawnvp()
4030  * provided by the various RTLs.  In particular, searching for
4031  * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
4032  * This doesn't significantly affect perl itself, because we
4033  * always invoke things using PERL5SHELL if a direct attempt to
4034  * spawn the executable fails.
4035  *
4036  * XXX splitting and rejoining the commandline between do_aspawn()
4037  * and win32_spawnvp() could also be avoided.
4038  */
4039
4040 DllExport int
4041 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
4042 {
4043 #ifdef USE_RTL_SPAWNVP
4044     return spawnvp(mode, cmdname, (char * const *)argv);
4045 #else
4046     dTHX;
4047     int ret;
4048     void* env;
4049     char* dir;
4050     child_IO_table tbl;
4051     STARTUPINFO StartupInfo;
4052     PROCESS_INFORMATION ProcessInformation;
4053     DWORD create = 0;
4054     char *cmd;
4055     char *fullcmd = Nullch;
4056     char *cname = (char *)cmdname;
4057     STRLEN clen = 0;
4058
4059     if (cname) {
4060         clen = strlen(cname);
4061         /* if command name contains dquotes, must remove them */
4062         if (strchr(cname, '"')) {
4063             cmd = cname;
4064             Newx(cname,clen+1,char);
4065             clen = 0;
4066             while (*cmd) {
4067                 if (*cmd != '"') {
4068                     cname[clen] = *cmd;
4069                     ++clen;
4070                 }
4071                 ++cmd;
4072             }
4073             cname[clen] = '\0';
4074         }
4075     }
4076
4077     cmd = create_command_line(cname, clen, argv);
4078
4079     env = PerlEnv_get_childenv();
4080     dir = PerlEnv_get_childdir();
4081
4082     switch(mode) {
4083     case P_NOWAIT:      /* asynch + remember result */
4084         if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
4085             errno = EAGAIN;
4086             ret = -1;
4087             goto RETVAL;
4088         }
4089         /* Create a new process group so we can use GenerateConsoleCtrlEvent()
4090          * in win32_kill()
4091          */
4092         create |= CREATE_NEW_PROCESS_GROUP;
4093         /* FALL THROUGH */
4094
4095     case P_WAIT:        /* synchronous execution */
4096         break;
4097     default:            /* invalid mode */
4098         errno = EINVAL;
4099         ret = -1;
4100         goto RETVAL;
4101     }
4102     memset(&StartupInfo,0,sizeof(StartupInfo));
4103     StartupInfo.cb = sizeof(StartupInfo);
4104     memset(&tbl,0,sizeof(tbl));
4105     PerlEnv_get_child_IO(&tbl);
4106     StartupInfo.dwFlags         = tbl.dwFlags;
4107     StartupInfo.dwX             = tbl.dwX;
4108     StartupInfo.dwY             = tbl.dwY;
4109     StartupInfo.dwXSize         = tbl.dwXSize;
4110     StartupInfo.dwYSize         = tbl.dwYSize;
4111     StartupInfo.dwXCountChars   = tbl.dwXCountChars;
4112     StartupInfo.dwYCountChars   = tbl.dwYCountChars;
4113     StartupInfo.dwFillAttribute = tbl.dwFillAttribute;
4114     StartupInfo.wShowWindow     = tbl.wShowWindow;
4115     StartupInfo.hStdInput       = tbl.childStdIn;
4116     StartupInfo.hStdOutput      = tbl.childStdOut;
4117     StartupInfo.hStdError       = tbl.childStdErr;
4118     if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE &&
4119         StartupInfo.hStdOutput == INVALID_HANDLE_VALUE &&
4120         StartupInfo.hStdError == INVALID_HANDLE_VALUE)
4121     {
4122         create |= CREATE_NEW_CONSOLE;
4123     }
4124     else {
4125         StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
4126     }
4127     if (w32_use_showwindow) {
4128         StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
4129         StartupInfo.wShowWindow = w32_showwindow;
4130     }
4131
4132     DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
4133                           cname,cmd));
4134 RETRY:
4135     if (!CreateProcess(cname,           /* search PATH to find executable */
4136                        cmd,             /* executable, and its arguments */
4137                        NULL,            /* process attributes */
4138                        NULL,            /* thread attributes */
4139                        TRUE,            /* inherit handles */
4140                        create,          /* creation flags */
4141                        (LPVOID)env,     /* inherit environment */
4142                        dir,             /* inherit cwd */
4143                        &StartupInfo,
4144                        &ProcessInformation))
4145     {
4146         /* initial NULL argument to CreateProcess() does a PATH
4147          * search, but it always first looks in the directory
4148          * where the current process was started, which behavior
4149          * is undesirable for backward compatibility.  So we
4150          * jump through our own hoops by picking out the path
4151          * we really want it to use. */
4152         if (!fullcmd) {
4153             fullcmd = qualified_path(cname);
4154             if (fullcmd) {
4155                 if (cname != cmdname)
4156                     Safefree(cname);
4157                 cname = fullcmd;
4158                 DEBUG_p(PerlIO_printf(Perl_debug_log,
4159                                       "Retrying [%s] with same args\n",
4160                                       cname));
4161                 goto RETRY;
4162             }
4163         }
4164         errno = ENOENT;
4165         ret = -1;
4166         goto RETVAL;
4167     }
4168
4169     if (mode == P_NOWAIT) {
4170         /* asynchronous spawn -- store handle, return PID */
4171         ret = (int)ProcessInformation.dwProcessId;
4172         if (IsWin95() && ret < 0)
4173             ret = -ret;
4174
4175         w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
4176         w32_child_pids[w32_num_children] = (DWORD)ret;
4177         ++w32_num_children;
4178     }
4179     else  {
4180         DWORD status;
4181         win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
4182         /* FIXME: if msgwait returned due to message perhaps forward the
4183            "signal" to the process
4184          */
4185         GetExitCodeProcess(ProcessInformation.hProcess, &status);
4186         ret = (int)status;
4187         CloseHandle(ProcessInformation.hProcess);
4188     }
4189
4190     CloseHandle(ProcessInformation.hThread);
4191
4192 RETVAL:
4193     PerlEnv_free_childenv(env);
4194     PerlEnv_free_childdir(dir);
4195     Safefree(cmd);
4196     if (cname != cmdname)
4197         Safefree(cname);
4198     return ret;
4199 #endif
4200 }
4201
4202 DllExport int
4203 win32_execv(const char *cmdname, const char *const *argv)
4204 {
4205 #ifdef USE_ITHREADS
4206     dTHX;
4207     /* if this is a pseudo-forked child, we just want to spawn
4208      * the new program, and return */
4209     if (w32_pseudo_id)
4210 #  ifdef __BORLANDC__
4211         return spawnv(P_WAIT, cmdname, (char *const *)argv);
4212 #  else
4213         return spawnv(P_WAIT, cmdname, argv);
4214 #  endif
4215 #endif
4216 #ifdef __BORLANDC__
4217     return execv(cmdname, (char *const *)argv);
4218 #else
4219     return execv(cmdname, argv);
4220 #endif
4221 }
4222
4223 DllExport int
4224 win32_execvp(const char *cmdname, const char *const *argv)
4225 {
4226 #ifdef USE_ITHREADS
4227     dTHX;
4228     /* if this is a pseudo-forked child, we just want to spawn
4229      * the new program, and return */
4230     if (w32_pseudo_id) {
4231         int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv);
4232         if (status != -1) {
4233             my_exit(status);
4234             return 0;
4235         }
4236         else
4237             return status;
4238     }
4239 #endif
4240 #ifdef __BORLANDC__
4241     return execvp(cmdname, (char *const *)argv);
4242 #else
4243     return execvp(cmdname, argv);
4244 #endif
4245 }
4246
4247 DllExport void
4248 win32_perror(const char *str)
4249 {
4250     perror(str);
4251 }
4252
4253 DllExport void
4254 win32_setbuf(FILE *pf, char *buf)
4255 {
4256     setbuf(pf, buf);
4257 }
4258
4259 DllExport int
4260 win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
4261 {
4262     return setvbuf(pf, buf, type, size);
4263 }
4264
4265 DllExport int
4266 win32_flushall(void)
4267 {
4268     return flushall();
4269 }
4270
4271 DllExport int
4272 win32_fcloseall(void)
4273 {
4274     return fcloseall();
4275 }
4276
4277 DllExport char*
4278 win32_fgets(char *s, int n, FILE *pf)
4279 {
4280     return fgets(s, n, pf);
4281 }
4282
4283 DllExport char*
4284 win32_gets(char *s)
4285 {
4286     return gets(s);
4287 }
4288
4289 DllExport int
4290 win32_fgetc(FILE *pf)
4291 {
4292     return fgetc(pf);
4293 }
4294
4295 DllExport int
4296 win32_putc(int c, FILE *pf)
4297 {
4298     return putc(c,pf);
4299 }
4300
4301 DllExport int
4302 win32_puts(const char *s)
4303 {
4304     return puts(s);
4305 }
4306
4307 DllExport int
4308 win32_getchar(void)
4309 {
4310     return getchar();
4311 }
4312
4313 DllExport int
4314 win32_putchar(int c)
4315 {
4316     return putchar(c);
4317 }
4318
4319 #ifdef MYMALLOC
4320
4321 #ifndef USE_PERL_SBRK
4322
4323 static char *committed = NULL;          /* XXX threadead */
4324 static char *base      = NULL;          /* XXX threadead */
4325 static char *reserved  = NULL;          /* XXX threadead */
4326 static char *brk       = NULL;          /* XXX threadead */
4327 static DWORD pagesize  = 0;             /* XXX threadead */
4328
4329 void *
4330 sbrk(ptrdiff_t need)
4331 {
4332  void *result;
4333  if (!pagesize)
4334   {SYSTEM_INFO info;
4335    GetSystemInfo(&info);
4336    /* Pretend page size is larger so we don't perpetually
4337     * call the OS to commit just one page ...
4338     */
4339    pagesize = info.dwPageSize << 3;
4340   }
4341  if (brk+need >= reserved)
4342   {
4343    DWORD size = brk+need-reserved;
4344    char *addr;
4345    char *prev_committed = NULL;
4346    if (committed && reserved && committed < reserved)
4347     {
4348      /* Commit last of previous chunk cannot span allocations */
4349      addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
4350      if (addr)
4351       {
4352       /* Remember where we committed from in case we want to decommit later */
4353       prev_committed = committed;
4354       committed = reserved;
4355       }
4356     }
4357    /* Reserve some (more) space
4358     * Contiguous blocks give us greater efficiency, so reserve big blocks -
4359     * this is only address space not memory...
4360     * Note this is a little sneaky, 1st call passes NULL as reserved
4361     * so lets system choose where we start, subsequent calls pass
4362     * the old end address so ask for a contiguous block
4363     */
4364 sbrk_reserve:
4365    if (size < 64*1024*1024)
4366     size = 64*1024*1024;
4367    size = ((size + pagesize - 1) / pagesize) * pagesize;
4368    addr  = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
4369    if (addr)
4370     {
4371      reserved = addr+size;
4372      if (!base)
4373       base = addr;
4374      if (!committed)
4375       committed = base;
4376      if (!brk)
4377       brk = committed;
4378     }
4379    else if (reserved)
4380     {
4381       /* The existing block could not be extended far enough, so decommit
4382        * anything that was just committed above and start anew */
4383       if (prev_committed)
4384        {
4385        if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT))
4386         return (void *) -1;
4387        }
4388       reserved = base = committed = brk = NULL;
4389       size = need;
4390       goto sbrk_reserve;
4391     }
4392    else
4393     {
4394      return (void *) -1;
4395     }
4396   }
4397  result = brk;
4398  brk += need;
4399  if (brk > committed)
4400   {
4401    DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
4402    char *addr;
4403    if (committed+size > reserved)
4404     size = reserved-committed;
4405    addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
4406    if (addr)
4407     committed += size;
4408    else
4409     return (void *) -1;
4410   }
4411  return result;
4412 }
4413
4414 #endif
4415 #endif
4416
4417 DllExport void*
4418 win32_malloc(size_t size)
4419 {
4420     return malloc(size);
4421 }
4422
4423 DllExport void*
4424 win32_calloc(size_t numitems, size_t size)
4425 {
4426     return calloc(numitems,size);
4427 }
4428
4429 DllExport void*
4430 win32_realloc(void *block, size_t size)
4431 {
4432     return realloc(block,size);
4433 }
4434
4435 DllExport void
4436 win32_free(void *block)
4437 {
4438     free(block);
4439 }
4440
4441
4442 DllExport int
4443 win32_open_osfhandle(intptr_t handle, int flags)
4444 {
4445 #ifdef USE_FIXED_OSFHANDLE
4446     if (IsWin95())
4447         return my_open_osfhandle(handle, flags);
4448 #endif
4449     return _open_osfhandle(handle, flags);
4450 }
4451
4452 DllExport intptr_t
4453 win32_get_osfhandle(int fd)
4454 {
4455     return (intptr_t)_get_osfhandle(fd);
4456 }
4457
4458 DllExport FILE *
4459 win32_fdupopen(FILE *pf)
4460 {
4461     FILE* pfdup;
4462     fpos_t pos;
4463     char mode[3];
4464     int fileno = win32_dup(win32_fileno(pf));
4465
4466     /* open the file in the same mode */
4467 #ifdef __BORLANDC__
4468     if((pf)->flags & _F_READ) {
4469         mode[0] = 'r';
4470         mode[1] = 0;
4471     }
4472     else if((pf)->flags & _F_WRIT) {
4473         mode[0] = 'a';
4474         mode[1] = 0;
4475     }
4476     else if((pf)->flags & _F_RDWR) {
4477         mode[0] = 'r';
4478         mode[1] = '+';
4479         mode[2] = 0;
4480     }
4481 #else
4482     if((pf)->_flag & _IOREAD) {
4483         mode[0] = 'r';
4484         mode[1] = 0;
4485     }
4486     else if((pf)->_flag & _IOWRT) {
4487         mode[0] = 'a';
4488         mode[1] = 0;
4489     }
4490     else if((pf)->_flag & _IORW) {
4491         mode[0] = 'r';
4492         mode[1] = '+';
4493         mode[2] = 0;
4494     }
4495 #endif
4496
4497     /* it appears that the binmode is attached to the
4498      * file descriptor so binmode files will be handled
4499      * correctly
4500      */
4501     pfdup = win32_fdopen(fileno, mode);
4502
4503     /* move the file pointer to the same position */
4504     if (!fgetpos(pf, &pos)) {
4505         fsetpos(pfdup, &pos);
4506     }
4507     return pfdup;
4508 }
4509
4510 DllExport void*
4511 win32_dynaload(const char* filename)
4512 {
4513     dTHX;
4514     char buf[MAX_PATH+1];
4515     char *first;
4516
4517     /* LoadLibrary() doesn't recognize forward slashes correctly,
4518      * so turn 'em back. */
4519     first = strchr(filename, '/');
4520     if (first) {
4521         STRLEN len = strlen(filename);
4522         if (len <= MAX_PATH) {
4523             strcpy(buf, filename);
4524             filename = &buf[first - filename];
4525             while (*filename) {
4526                 if (*filename == '/')
4527                     *(char*)filename = '\\';
4528                 ++filename;
4529             }
4530             filename = buf;
4531         }
4532     }
4533     return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
4534 }
4535
4536 XS(w32_SetChildShowWindow)
4537 {
4538     dXSARGS;
4539     BOOL use_showwindow = w32_use_showwindow;
4540     /* use "unsigned short" because Perl has redefined "WORD" */
4541     unsigned short showwindow = w32_showwindow;
4542
4543     if (items > 1)
4544         Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
4545
4546     if (items == 0 || !SvOK(ST(0)))
4547         w32_use_showwindow = FALSE;
4548     else {
4549         w32_use_showwindow = TRUE;
4550         w32_showwindow = (unsigned short)SvIV(ST(0));
4551     }
4552
4553     EXTEND(SP, 1);
4554     if (use_showwindow)
4555         ST(0) = sv_2mortal(newSViv(showwindow));
4556     else
4557         ST(0) = &PL_sv_undef;
4558     XSRETURN(1);
4559 }
4560
4561 static void
4562 forward(pTHX_ const char *function)
4563 {
4564     dXSARGS;
4565     Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), newSVnv(0.27));
4566     SPAGAIN;
4567     PUSHMARK(SP-items);
4568     call_pv(function, GIMME_V);
4569 }
4570
4571 #define FORWARD(function) XS(w32_##function){ forward(aTHX_ "Win32::"#function); }
4572 FORWARD(GetCwd)
4573 FORWARD(SetCwd)
4574 FORWARD(GetNextAvailDrive)
4575 FORWARD(GetLastError)
4576 FORWARD(SetLastError)
4577 FORWARD(LoginName)
4578 FORWARD(NodeName)
4579 FORWARD(DomainName)
4580 FORWARD(FsType)
4581 FORWARD(GetOSVersion)
4582 FORWARD(IsWinNT)
4583 FORWARD(IsWin95)
4584 FORWARD(FormatMessage)
4585 FORWARD(Spawn)
4586 FORWARD(GetTickCount)
4587 FORWARD(GetShortPathName)
4588 FORWARD(GetFullPathName)
4589 FORWARD(GetLongPathName)
4590 FORWARD(CopyFile)
4591 FORWARD(Sleep)
4592
4593 /* Don't forward Win32::SetChildShowWindow().  It accesses the internal variable
4594  * w32_showwindow in thread_intern and is therefore not implemented in Win32.xs.
4595  */
4596 /* FORWARD(SetChildShowWindow) */
4597
4598 #undef FORWARD
4599
4600 void
4601 Perl_init_os_extras(void)
4602 {
4603     dTHX;
4604     char *file = __FILE__;
4605     dXSUB_SYS;
4606
4607     /* these names are Activeware compatible */
4608     newXS("Win32::GetCwd", w32_GetCwd, file);
4609     newXS("Win32::SetCwd", w32_SetCwd, file);
4610     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
4611     newXS("Win32::GetLastError", w32_GetLastError, file);
4612     newXS("Win32::SetLastError", w32_SetLastError, file);
4613     newXS("Win32::LoginName", w32_LoginName, file);
4614     newXS("Win32::NodeName", w32_NodeName, file);
4615     newXS("Win32::DomainName", w32_DomainName, file);
4616     newXS("Win32::FsType", w32_FsType, file);
4617     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
4618     newXS("Win32::IsWinNT", w32_IsWinNT, file);
4619     newXS("Win32::IsWin95", w32_IsWin95, file);
4620     newXS("Win32::FormatMessage", w32_FormatMessage, file);
4621     newXS("Win32::Spawn", w32_Spawn, file);
4622     newXS("Win32::GetTickCount", w32_GetTickCount, file);
4623     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
4624     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
4625     newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
4626     newXS("Win32::CopyFile", w32_CopyFile, file);
4627     newXS("Win32::Sleep", w32_Sleep, file);
4628     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
4629 }
4630
4631 void *
4632 win32_signal_context(void)
4633 {
4634     dTHX;
4635 #ifdef MULTIPLICITY
4636     if (!my_perl) {
4637         my_perl = PL_curinterp;
4638         PERL_SET_THX(my_perl);
4639     }
4640     return my_perl;
4641 #else
4642     return PL_curinterp;
4643 #endif
4644 }
4645
4646
4647 BOOL WINAPI
4648 win32_ctrlhandler(DWORD dwCtrlType)
4649 {
4650 #ifdef MULTIPLICITY
4651     dTHXa(PERL_GET_SIG_CONTEXT);
4652
4653     if (!my_perl)
4654         return FALSE;
4655 #endif
4656
4657     switch(dwCtrlType) {
4658     case CTRL_CLOSE_EVENT:
4659      /*  A signal that the system sends to all processes attached to a console when
4660          the user closes the console (either by choosing the Close command from the
4661          console window's System menu, or by choosing the End Task command from the
4662          Task List
4663       */
4664         if (do_raise(aTHX_ 1))        /* SIGHUP */
4665             sig_terminate(aTHX_ 1);
4666         return TRUE;
4667
4668     case CTRL_C_EVENT:
4669         /*  A CTRL+c signal was received */
4670         if (do_raise(aTHX_ SIGINT))
4671             sig_terminate(aTHX_ SIGINT);
4672         return TRUE;
4673
4674     case CTRL_BREAK_EVENT:
4675         /*  A CTRL+BREAK signal was received */
4676         if (do_raise(aTHX_ SIGBREAK))
4677             sig_terminate(aTHX_ SIGBREAK);
4678         return TRUE;
4679
4680     case CTRL_LOGOFF_EVENT:
4681       /*  A signal that the system sends to all console processes when a user is logging
4682           off. This signal does not indicate which user is logging off, so no
4683           assumptions can be made.
4684        */
4685         break;
4686     case CTRL_SHUTDOWN_EVENT:
4687       /*  A signal that the system sends to all console processes when the system is
4688           shutting down.
4689        */
4690         if (do_raise(aTHX_ SIGTERM))
4691             sig_terminate(aTHX_ SIGTERM);
4692         return TRUE;
4693     default:
4694         break;
4695     }
4696     return FALSE;
4697 }
4698
4699
4700 #if _MSC_VER >= 1400
4701 #  include <crtdbg.h>
4702 #endif
4703
4704 void
4705 Perl_win32_init(int *argcp, char ***argvp)
4706 {
4707     HMODULE module;
4708
4709 #if _MSC_VER >= 1400
4710     _invalid_parameter_handler oldHandler, newHandler;
4711     newHandler = my_invalid_parameter_handler;
4712     oldHandler = _set_invalid_parameter_handler(newHandler);
4713     _CrtSetReportMode(_CRT_ASSERT, 0);
4714 #endif
4715     /* Disable floating point errors, Perl will trap the ones we
4716      * care about.  VC++ RTL defaults to switching these off
4717      * already, but the Borland RTL doesn't.  Since we don't
4718      * want to be at the vendor's whim on the default, we set
4719      * it explicitly here.
4720      */
4721 #if !defined(_ALPHA_) && !defined(__GNUC__)
4722     _control87(MCW_EM, MCW_EM);
4723 #endif
4724     MALLOC_INIT;
4725
4726     module = GetModuleHandle("ntdll.dll");
4727     if (module) {
4728         *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation");
4729     }
4730
4731     module = GetModuleHandle("kernel32.dll");
4732     if (module) {
4733         *(FARPROC*)&pfnCreateToolhelp32Snapshot = GetProcAddress(module, "CreateToolhelp32Snapshot");
4734         *(FARPROC*)&pfnProcess32First           = GetProcAddress(module, "Process32First");
4735         *(FARPROC*)&pfnProcess32Next            = GetProcAddress(module, "Process32Next");
4736     }
4737 }
4738
4739 void
4740 Perl_win32_term(void)
4741 {
4742     dTHX;
4743     HINTS_REFCNT_TERM;
4744     OP_REFCNT_TERM;
4745     PERLIO_TERM;
4746     MALLOC_TERM;
4747 }
4748
4749 void
4750 win32_get_child_IO(child_IO_table* ptbl)
4751 {
4752     ptbl->childStdIn    = GetStdHandle(STD_INPUT_HANDLE);
4753     ptbl->childStdOut   = GetStdHandle(STD_OUTPUT_HANDLE);
4754     ptbl->childStdErr   = GetStdHandle(STD_ERROR_HANDLE);
4755 }
4756
4757 Sighandler_t
4758 win32_signal(int sig, Sighandler_t subcode)
4759 {
4760     dTHX;
4761     if (sig < SIG_SIZE) {
4762         int save_errno = errno;
4763         Sighandler_t result = signal(sig, subcode);
4764         if (result == SIG_ERR) {
4765             result = w32_sighandler[sig];
4766             errno = save_errno;
4767         }
4768         w32_sighandler[sig] = subcode;
4769         return result;
4770     }
4771     else {
4772         errno = EINVAL;
4773         return SIG_ERR;
4774     }
4775 }
4776
4777
4778 #ifdef HAVE_INTERP_INTERN
4779
4780
4781 static void
4782 win32_csighandler(int sig)
4783 {
4784 #if 0
4785     dTHXa(PERL_GET_SIG_CONTEXT);
4786     Perl_warn(aTHX_ "Got signal %d",sig);
4787 #endif
4788     /* Does nothing */
4789 }
4790
4791 HWND
4792 win32_create_message_window()
4793 {
4794     /* "message-only" windows have been implemented in Windows 2000 and later.
4795      * On earlier versions we'll continue to post messages to a specific
4796      * thread and use hwnd==NULL.  This is brittle when either an embedding
4797      * application or an XS module is also posting messages to hwnd=NULL
4798      * because once removed from the queue they cannot be delivered to the
4799      * "right" place with DispatchMessage() anymore, as there is no WindowProc
4800      * if there is no window handle.
4801      */
4802     if (g_osver.dwMajorVersion < 5)
4803         return NULL;
4804
4805     return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
4806 }
4807
4808 #if defined(__MINGW32__) && defined(__cplusplus)
4809 #define CAST_HWND__(x) (HWND__*)(x)
4810 #else
4811 #define CAST_HWND__(x) x
4812 #endif
4813
4814 void
4815 Perl_sys_intern_init(pTHX)
4816 {
4817     int i;
4818
4819     if (g_osver.dwOSVersionInfoSize == 0) {
4820         g_osver.dwOSVersionInfoSize = sizeof(g_osver);
4821         GetVersionEx(&g_osver);
4822     }
4823
4824     w32_perlshell_tokens        = Nullch;
4825     w32_perlshell_vec           = (char**)NULL;
4826     w32_perlshell_items         = 0;
4827     w32_fdpid                   = newAV();
4828     Newx(w32_children, 1, child_tab);
4829     w32_num_children            = 0;
4830 #  ifdef USE_ITHREADS
4831     w32_pseudo_id               = 0;
4832     Newx(w32_pseudo_children, 1, pseudo_child_tab);
4833     w32_num_pseudo_children     = 0;
4834 #  endif
4835     w32_timerid                 = 0;
4836     w32_message_hwnd            = CAST_HWND__(INVALID_HANDLE_VALUE);
4837     w32_poll_count              = 0;
4838     for (i=0; i < SIG_SIZE; i++) {
4839         w32_sighandler[i] = SIG_DFL;
4840     }
4841 #  ifdef MULTIPLICTY
4842     if (my_perl == PL_curinterp) {
4843 #  else
4844     {
4845 #  endif
4846         /* Force C runtime signal stuff to set its console handler */
4847         signal(SIGINT,win32_csighandler);
4848         signal(SIGBREAK,win32_csighandler);
4849         /* Push our handler on top */
4850         SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
4851     }
4852 }
4853
4854 void
4855 Perl_sys_intern_clear(pTHX)
4856 {
4857     Safefree(w32_perlshell_tokens);
4858     Safefree(w32_perlshell_vec);
4859     /* NOTE: w32_fdpid is freed by sv_clean_all() */
4860     Safefree(w32_children);
4861     if (w32_timerid) {
4862         KillTimer(w32_message_hwnd, w32_timerid);
4863         w32_timerid = 0;
4864     }
4865     if (w32_message_hwnd != NULL && w32_message_hwnd != INVALID_HANDLE_VALUE)
4866         DestroyWindow(w32_message_hwnd);
4867 #  ifdef MULTIPLICITY
4868     if (my_perl == PL_curinterp) {
4869 #  else
4870     {
4871 #  endif
4872         SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
4873     }
4874 #  ifdef USE_ITHREADS
4875     Safefree(w32_pseudo_children);
4876 #  endif
4877 }
4878
4879 #  ifdef USE_ITHREADS
4880
4881 void
4882 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
4883 {
4884     dst->perlshell_tokens       = Nullch;
4885     dst->perlshell_vec          = (char**)NULL;
4886     dst->perlshell_items        = 0;
4887     dst->fdpid                  = newAV();
4888     Newxz(dst->children, 1, child_tab);
4889     dst->pseudo_id              = 0;
4890     Newxz(dst->pseudo_children, 1, pseudo_child_tab);
4891     dst->timerid                = 0;
4892     dst->message_hwnd           = CAST_HWND__(INVALID_HANDLE_VALUE);
4893     dst->poll_count             = 0;
4894     Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
4895 }
4896 #  endif /* USE_ITHREADS */
4897 #endif /* HAVE_INTERP_INTERN */
4898
4899 static void
4900 win32_free_argvw(pTHX_ void *ptr)
4901 {
4902     char** argv = (char**)ptr;
4903     while(*argv) {
4904         Safefree(*argv);
4905         *argv++ = Nullch;
4906     }
4907 }
4908
4909 void
4910 win32_argv2utf8(int argc, char** argv)
4911 {
4912     dTHX;
4913     char* psz;
4914     int length, wargc;
4915     LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
4916     if (lpwStr && argc) {
4917         while (argc--) {
4918             length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
4919             Newxz(psz, length, char);
4920             WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
4921             argv[argc] = psz;
4922         }
4923         call_atexit(win32_free_argvw, argv);
4924     }
4925     GlobalFree((HGLOBAL)lpwStr);
4926 }