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