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