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