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