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