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