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