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