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