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 #include <windows.h>
  15
  16 /* #include "config.h" */
  17
  18 #define PERLIO_NOT_STDIO 0
  19 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
  20 #define PerlIO FILE
  21 #endif
  22
  23 #include "EXTERN.h"
  24 #include "perl.h"
  25 #include "XSUB.h"
  26 #include <fcntl.h>
  27 #include <sys/stat.h>
  28 #include <assert.h>
  29 #include <string.h>
  30 #include <stdarg.h>
  31 #include <float.h>
  32
  33 #define CROAK croak
  34 #define WARN warn
  35
  36 #define EXECF_EXEC 1
  37 #define EXECF_SPAWN 2
  38 #define EXECF_SPAWN_NOWAIT 3
  39
  40 static DWORD IdOS(void);
  41
  42 extern WIN32_IOSUBSYSTEM        win32stdio;
  43 static PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio;
  44
  45 BOOL  ProbeEnv = FALSE;
  46 DWORD Win32System = (DWORD)-1;
  47 char  szShellPath[MAX_PATH+1];
  48 char  szPerlLibRoot[MAX_PATH+1];
  49 HANDLE PerlDllHandle = INVALID_HANDLE_VALUE;
  50
  51 static int do_spawn2(char *cmd, int exectype);
  52
  53 int
  54 IsWin95(void) {
  55     return (IdOS() == VER_PLATFORM_WIN32_WINDOWS);
  56 }
  57
  58 int
  59 IsWinNT(void) {
  60     return (IdOS() == VER_PLATFORM_WIN32_NT);
  61 }
  62
  63 void *
  64 SetIOSubSystem(void *p)
  65 {
  66     PWIN32_IOSUBSYSTEM old = pIOSubSystem;
  67     if (p) {
  68         PWIN32_IOSUBSYSTEM pio = (PWIN32_IOSUBSYSTEM)p;
  69         if (pio->signature_begin == 12345678L
  70             && pio->signature_end == 87654321L) {
  71             pIOSubSystem = pio;
  72         }
  73     }
  74     else {
  75         pIOSubSystem = &win32stdio;
  76     }
  77     return old;
  78 }
  79
  80 char *
  81 win32PerlLibPath(void)
  82 {
  83     char *end;
  84     GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE)
  85                       ? GetModuleHandle(NULL)
  86                       : PerlDllHandle,
  87                       szPerlLibRoot,
  88                       sizeof(szPerlLibRoot));
  89
  90     *(end = strrchr(szPerlLibRoot, '\\')) = '\0';
  91     if (stricmp(end-4,"\\bin") == 0)
  92      end -= 4;
  93     strcpy(end,"\\lib");
  94     return (szPerlLibRoot);
  95 }
  96
  97 char *
  98 win32SiteLibPath(void)
  99 {
 100     static char szPerlSiteLib[MAX_PATH+1];
 101     strcpy(szPerlSiteLib, win32PerlLibPath());
 102     strcat(szPerlSiteLib, "\\site");
 103     return (szPerlSiteLib);
 104 }
 105
 106 BOOL
 107 HasRedirection(char *ptr)
 108 {
 109     int inquote = 0;
 110     char quote = '\0';
 111
 112     /*
 113      * Scan string looking for redirection (< or >) or pipe
 114      * characters (|) that are not in a quoted string
 115      */
 116     while(*ptr) {
 117         switch(*ptr) {
 118         case '\'':
 119         case '\"':
 120             if(inquote) {
 121                 if(quote == *ptr) {
 122                     inquote = 0;
 123                     quote = '\0';
 124                 }
 125             }
 126             else {
 127                 quote = *ptr;
 128                 inquote++;
 129             }
 130             break;
 131         case '>':
 132         case '<':
 133         case '|':
 134             if(!inquote)
 135                 return TRUE;
 136         default:
 137             break;
 138         }
 139         ++ptr;
 140     }
 141     return FALSE;
 142 }
 143
 144 /* since the current process environment is being updated in util.c
 145  * the library functions will get the correct environment
 146  */
 147 PerlIO *
 148 my_popen(char *cmd, char *mode)
 149 {
 150 #ifdef FIXCMD
 151 #define fixcmd(x)       {                                       \
 152                             char *pspace = strchr((x),' ');     \
 153                             if (pspace) {                       \
 154                                 char *p = (x);                  \
 155                                 while (p < pspace) {            \
 156                                     if (*p == '/')              \
 157                                         *p = '\\';              \
 158                                     p++;                        \
 159                                 }                               \
 160                             }                                   \
 161                         }
 162 #else
 163 #define fixcmd(x)
 164 #endif
 165
 166 #if 1
 167 /* was #ifndef PERLDLL, but the #else stuff doesn't work on NT
 168  * GSAR 97/03/13
 169  */
 170     fixcmd(cmd);
 171 #ifdef __BORLANDC__ /* workaround a Borland stdio bug */
 172     win32_fflush(stdout);
 173     win32_fflush(stderr);
 174 #endif
 175     return win32_popen(cmd, mode);
 176 #else
 177 /*
 178  * There seems to be some problems for the _popen call in a DLL
 179  * this trick at the moment seems to work but it is never test
 180  * on NT yet
 181  *
 182  */
 183 #       ifdef __cplusplus
 184 #define EXT_C_FUNC      extern "C"
 185 #       else
 186 #define EXT_C_FUNC      extern
 187 #       endif
 188
 189     EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value);
 190     EXT_C_FUNC void __cdecl _lock_fhandle(int);
 191     EXT_C_FUNC void __cdecl _unlock_fhandle(int);
 192
 193     BOOL        fSuccess;
 194     PerlIO      *pf;            /* to store the _popen return value */
 195     int         tm = 0;         /* flag indicating tDllExport or binary mode */
 196     int         fhNeeded, fhInherited, fhDup;
 197     int         ineeded, iinherited;
 198     DWORD       dwDup;
 199     int         phdls[2];       /* I/O handles for pipe */
 200     HANDLE      hPIn, hPOut, hPErr,
 201                 hSaveStdin, hSaveStdout, hSaveStderr,
 202                 hPNeeded, hPInherited, hPDuped;
 203
 204     /* first check for errors in the arguments */
 205     if ( (cmd == NULL) || (mode == NULL)
 206          || ((*mode != 'w') && (*mode != _T('r'))) )
 207         goto error1;
 208
 209     if ( *(mode + 1) == _T('t') )
 210         tm = O_TEXT;
 211     else if ( *(mode + 1) == _T('b') )
 212         tm = O_BINARY;
 213     else
 214         tm = (*mode == 'w' ? O_BINARY : O_TEXT);
 215
 216
 217     fixcmd(cmd);
 218     if (&win32stdio != pIOSubSystem)
 219         return win32_popen(cmd, mode);
 220
 221 #ifdef EFG
 222     if ( _pipe( phdls, 1024, tm ) == -1 )
 223 #else
 224     if ( win32_pipe( phdls, 1024, tm ) == -1 )
 225 #endif
 226         goto error1;
 227
 228     /* save the current situation */
 229     hSaveStdin = GetStdHandle(STD_INPUT_HANDLE);
 230     hSaveStdout = GetStdHandle(STD_OUTPUT_HANDLE);
 231     hSaveStderr = GetStdHandle(STD_ERROR_HANDLE);
 232
 233     if (*mode == _T('w')) {
 234         ineeded = 1;
 235         dwDup   = STD_INPUT_HANDLE;
 236         iinherited = 0;
 237     }
 238     else {
 239         ineeded = 0;
 240         dwDup   = STD_OUTPUT_HANDLE;
 241         iinherited = 1;
 242     }
 243
 244     fhNeeded = phdls[ineeded];
 245     fhInherited = phdls[iinherited];
 246
 247     fSuccess = DuplicateHandle(GetCurrentProcess(),
 248                                (HANDLE) stolen_get_osfhandle(fhNeeded),
 249                                GetCurrentProcess(),
 250                                &hPNeeded,
 251                                0,
 252                                FALSE,       /* not inherited */
 253                                DUPLICATE_SAME_ACCESS);
 254
 255     if (!fSuccess)
 256         goto error2;
 257
 258     fhDup = stolen_open_osfhandle((long) hPNeeded, tm);
 259     win32_dup2(fhDup, fhNeeded);
 260     win32_close(fhDup);
 261
 262 #ifdef AAA
 263     /* Close the Out pipe, child won't need it */
 264     hPDuped = (HANDLE) stolen_get_osfhandle(fhNeeded);
 265
 266     _lock_fhandle(fhNeeded);
 267     _set_osfhnd(fhNeeded, (long)hPNeeded); /* put in ours duplicated one */
 268     _unlock_fhandle(fhNeeded);
 269
 270     CloseHandle(hPDuped);       /* close the handle first */
 271 #endif
 272
 273     if (!SetStdHandle(dwDup, (HANDLE) stolen_get_osfhandle(fhInherited)))
 274         goto error2;
 275
 276     /*
 277      * make sure the child see the same stderr as the calling program
 278      */
 279     if (!SetStdHandle(STD_ERROR_HANDLE,
 280                       (HANDLE)stolen_get_osfhandle(win32_fileno(win32_stderr()))))
 281         goto error2;
 282
 283     pf = win32_popen(cmd, mode);        /* ask _popen to do the job */
 284
 285     /* restore to where we were */
 286     SetStdHandle(STD_INPUT_HANDLE, hSaveStdin);
 287     SetStdHandle(STD_OUTPUT_HANDLE, hSaveStdout);
 288     SetStdHandle(STD_ERROR_HANDLE, hSaveStderr);
 289
 290     /* we don't need it any more, that's for the child */
 291     win32_close(fhInherited);
 292
 293     if (NULL == pf) {
 294         /* something wrong */
 295         win32_close(fhNeeded);
 296         goto error1;
 297     }
 298     else {
 299         /*
 300          * here we steal the file handle in pf and stuff ours in
 301          */
 302         win32_dup2(fhNeeded, win32_fileno(pf));
 303         win32_close(fhNeeded);
 304     }
 305     return (pf);
 306
 307 error2:
 308     win32_close(fhNeeded);
 309     win32_close(fhInherited);
 310
 311 error1:
 312     return (NULL);
 313
 314 #endif
 315 }
 316
 317 long
 318 my_pclose(PerlIO *fp)
 319 {
 320     return win32_pclose(fp);
 321 }
 322
 323 static DWORD
 324 IdOS(void)
 325 {
 326     static OSVERSIONINFO osver;
 327
 328     if (osver.dwPlatformId != Win32System) {
 329         memset(&osver, 0, sizeof(OSVERSIONINFO));
 330         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
 331         GetVersionEx(&osver);
 332         Win32System = osver.dwPlatformId;
 333     }
 334     return (Win32System);
 335 }
 336
 337 static char *
 338 GetShell(void)
 339 {
 340     if (!ProbeEnv) {
 341         char* defaultshell = (IsWinNT() ? "cmd.exe" : "command.com");
 342         /* we don't use COMSPEC here for two reasons:
 343          *  1. the same reason perl on UNIX doesn't use SHELL--rampant and
 344          *     uncontrolled unportability of the ensuing scripts.
 345          *  2. PERL5SHELL could be set to a shell that may not be fit for
 346          *     interactive use (which is what most programs look in COMSPEC
 347          *     for).
 348          */
 349         char *usershell = getenv("PERL5SHELL");
 350
 351         ProbeEnv = TRUE;
 352         strcpy(szShellPath, usershell ? usershell : defaultshell);
 353     }
 354     return szShellPath;
 355 }
 356
 357 int
 358 do_aspawn(void* really, void** mark, void** arglast)
 359 {
 360     char **argv;
 361     char *strPtr;
 362     char *cmd;
 363     int status;
 364     unsigned int length;
 365     int index = 0;
 366     SV *sv = (SV*)really;
 367     SV** pSv = (SV**)mark;
 368
 369     New(1310, argv, (arglast - mark) + 4, char*);
 370
 371     if(sv != Nullsv) {
 372         cmd = SvPV(sv, length);
 373     }
 374     else {
 375         argv[index++] = cmd = GetShell();
 376         argv[index++] = "/x";   /* always enable command extensions */
 377         argv[index++] = "/c";
 378     }
 379
 380     while(++pSv <= (SV**)arglast) {
 381         sv = *pSv;
 382         strPtr = SvPV(sv, length);
 383         if(strPtr != NULL && *strPtr != '\0')
 384             argv[index++] = strPtr;
 385     }
 386     argv[index++] = 0;
 387
 388     status = win32_spawnvp(P_WAIT, cmd, (const char* const*)argv);
 389
 390     Safefree(argv);
 391
 392     if (status < 0) {
 393         if (dowarn)
 394             warn("Can't spawn \"%s\": %s", cmd, strerror(errno));
 395         status = 255 << 8;
 396     }
 397     return (status);
 398 }
 399
 400 int
 401 do_spawn2(char *cmd, int exectype)
 402 {
 403     char **a;
 404     char *s;
 405     char **argv;
 406     int status = -1;
 407     BOOL needToTry = TRUE;
 408     char *shell, *cmd2;
 409
 410     /* save an extra exec if possible */
 411     shell = GetShell();
 412
 413     /* see if there are shell metacharacters in it */
 414     if(!HasRedirection(cmd)) {
 415         New(1301,argv, strlen(cmd) / 2 + 2, char*);
 416         New(1302,cmd2, strlen(cmd) + 1, char);
 417         strcpy(cmd2, cmd);
 418         a = argv;
 419         for (s = cmd2; *s;) {
 420             while (*s && isspace(*s))
 421                 s++;
 422             if (*s)
 423                 *(a++) = s;
 424             while(*s && !isspace(*s))
 425                 s++;
 426             if(*s)
 427                 *s++ = '\0';
 428         }
 429         *a = Nullch;
 430         if(argv[0]) {
 431             switch (exectype) {
 432             case EXECF_SPAWN:
 433                 status = win32_spawnvp(P_WAIT, argv[0],
 434                                        (const char* const*)argv);
 435                 break;
 436             case EXECF_SPAWN_NOWAIT:
 437                 status = win32_spawnvp(P_NOWAIT, argv[0],
 438                                        (const char* const*)argv);
 439                 break;
 440             case EXECF_EXEC:
 441                 status = win32_execvp(argv[0], (const char* const*)argv);
 442                 break;
 443             }
 444             if(status != -1 || errno == 0)
 445                 needToTry = FALSE;
 446         }
 447         Safefree(argv);
 448         Safefree(cmd2);
 449     }
 450     if(needToTry) {
 451         char *argv[5];
 452         argv[0] = shell; argv[1] = "/x"; argv[2] = "/c";
 453         argv[3] = cmd; argv[4] = Nullch;
 454         switch (exectype) {
 455         case EXECF_SPAWN:
 456             status = win32_spawnvp(P_WAIT, argv[0],
 457                                    (const char* const*)argv);
 458             break;
 459         case EXECF_SPAWN_NOWAIT:
 460             status = win32_spawnvp(P_NOWAIT, argv[0],
 461                                    (const char* const*)argv);
 462             break;
 463         case EXECF_EXEC:
 464             status = win32_execvp(argv[0], (const char* const*)argv);
 465             break;
 466         }
 467     }
 468     if (status < 0) {
 469         if (dowarn)
 470             warn("Can't %s \"%s\": %s",
 471                  (exectype == EXECF_EXEC ? "exec" : "spawn"),
 472                  needToTry ? shell : argv[0],
 473                  strerror(errno));
 474         status = 255 << 8;
 475     }
 476     return (status);
 477 }
 478
 479 int
 480 do_spawn(char *cmd)
 481 {
 482     return do_spawn2(cmd, EXECF_SPAWN);
 483 }
 484
 485 bool
 486 do_exec(char *cmd)
 487 {
 488     do_spawn2(cmd, EXECF_EXEC);
 489     return FALSE;
 490 }
 491
 492
 493 #define PATHLEN 1024
 494
 495 /* The idea here is to read all the directory names into a string table
 496  * (separated by nulls) and when one of the other dir functions is called
 497  * return the pointer to the current file name.
 498  */
 499 DIR *
 500 opendir(char *filename)
 501 {
 502     DIR            *p;
 503     long            len;
 504     long            idx;
 505     char            scannamespc[PATHLEN];
 506     char       *scanname = scannamespc;
 507     struct stat     sbuf;
 508     WIN32_FIND_DATA FindData;
 509     HANDLE          fh;
 510 /*  char            root[_MAX_PATH];*/
 511 /*  char            volname[_MAX_PATH];*/
 512 /*  DWORD           serial, maxname, flags;*/
 513 /*  BOOL            downcase;*/
 514 /*  char           *dummy;*/
 515
 516     /* check to see if filename is a directory */
 517     if (win32_stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) {
 518         return NULL;
 519     }
 520
 521     /* get the file system characteristics */
 522 /*  if(GetFullPathName(filename, MAX_PATH, root, &dummy)) {
 523  *      if(dummy = strchr(root, '\\'))
 524  *          *++dummy = '\0';
 525  *      if(GetVolumeInformation(root, volname, MAX_PATH, &serial,
 526  *                              &maxname, &flags, 0, 0)) {
 527  *          downcase = !(flags & FS_CASE_IS_PRESERVED);
 528  *      }
 529  *  }
 530  *  else {
 531  *      downcase = TRUE;
 532  *  }
 533  */
 534     /* Get us a DIR structure */
 535     Newz(1303, p, 1, DIR);
 536     if(p == NULL)
 537         return NULL;
 538
 539     /* Create the search pattern */
 540     strcpy(scanname, filename);
 541
 542     if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
 543         strcat(scanname, "/*");
 544     else
 545         strcat(scanname, "*");
 546
 547     /* do the FindFirstFile call */
 548     fh = FindFirstFile(scanname, &FindData);
 549     if(fh == INVALID_HANDLE_VALUE) {
 550         return NULL;
 551     }
 552
 553     /* now allocate the first part of the string table for
 554      * the filenames that we find.
 555      */
 556     idx = strlen(FindData.cFileName)+1;
 557     New(1304, p->start, idx, char);
 558     if(p->start == NULL) {
 559         CROAK("opendir: malloc failed!\n");
 560     }
 561     strcpy(p->start, FindData.cFileName);
 562 /*  if(downcase)
 563  *      strlwr(p->start);
 564  */
 565     p->nfiles++;
 566
 567     /* loop finding all the files that match the wildcard
 568      * (which should be all of them in this directory!).
 569      * the variable idx should point one past the null terminator
 570      * of the previous string found.
 571      */
 572     while (FindNextFile(fh, &FindData)) {
 573         len = strlen(FindData.cFileName);
 574         /* bump the string table size by enough for the
 575          * new name and it's null terminator
 576          */
 577         Renew(p->start, idx+len+1, char);
 578         if(p->start == NULL) {
 579             CROAK("opendir: malloc failed!\n");
 580         }
 581         strcpy(&p->start[idx], FindData.cFileName);
 582 /*      if (downcase)
 583  *          strlwr(&p->start[idx]);
 584  */
 585                 p->nfiles++;
 586                 idx += len+1;
 587         }
 588         FindClose(fh);
 589         p->size = idx;
 590         p->curr = p->start;
 591         return p;
 592 }
 593
 594
 595 /* Readdir just returns the current string pointer and bumps the
 596  * string pointer to the nDllExport entry.
 597  */
 598 struct direct *
 599 readdir(DIR *dirp)
 600 {
 601     int         len;
 602     static int  dummy = 0;
 603
 604     if (dirp->curr) {
 605         /* first set up the structure to return */
 606         len = strlen(dirp->curr);
 607         strcpy(dirp->dirstr.d_name, dirp->curr);
 608         dirp->dirstr.d_namlen = len;
 609
 610         /* Fake an inode */
 611         dirp->dirstr.d_ino = dummy++;
 612
 613         /* Now set up for the nDllExport call to readdir */
 614         dirp->curr += len + 1;
 615         if (dirp->curr >= (dirp->start + dirp->size)) {
 616             dirp->curr = NULL;
 617         }
 618
 619         return &(dirp->dirstr);
 620     }
 621     else
 622         return NULL;
 623 }
 624
 625 /* Telldir returns the current string pointer position */
 626 long
 627 telldir(DIR *dirp)
 628 {
 629     return (long) dirp->curr;
 630 }
 631
 632
 633 /* Seekdir moves the string pointer to a previously saved position
 634  *(Saved by telldir).
 635  */
 636 void
 637 seekdir(DIR *dirp, long loc)
 638 {
 639     dirp->curr = (char *)loc;
 640 }
 641
 642 /* Rewinddir resets the string pointer to the start */
 643 void
 644 rewinddir(DIR *dirp)
 645 {
 646     dirp->curr = dirp->start;
 647 }
 648
 649 /* free the memory allocated by opendir */
 650 int
 651 closedir(DIR *dirp)
 652 {
 653     Safefree(dirp->start);
 654     Safefree(dirp);
 655     return 1;
 656 }
 657
 658
 659 /*
 660  * various stubs
 661  */
 662
 663
 664 /* Ownership
 665  *
 666  * Just pretend that everyone is a superuser. NT will let us know if
 667  * we don\'t really have permission to do something.
 668  */
 669
 670 #define ROOT_UID    ((uid_t)0)
 671 #define ROOT_GID    ((gid_t)0)
 672
 673 uid_t
 674 getuid(void)
 675 {
 676     return ROOT_UID;
 677 }
 678
 679 uid_t
 680 geteuid(void)
 681 {
 682     return ROOT_UID;
 683 }
 684
 685 gid_t
 686 getgid(void)
 687 {
 688     return ROOT_GID;
 689 }
 690
 691 gid_t
 692 getegid(void)
 693 {
 694     return ROOT_GID;
 695 }
 696
 697 int
 698 setuid(uid_t uid)
 699 {
 700     return (uid == ROOT_UID ? 0 : -1);
 701 }
 702
 703 int
 704 setgid(gid_t gid)
 705 {
 706     return (gid == ROOT_GID ? 0 : -1);
 707 }
 708
 709 /*
 710  * pretended kill
 711  */
 712 int
 713 kill(int pid, int sig)
 714 {
 715     HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
 716
 717     if (hProcess == NULL) {
 718         CROAK("kill process failed!\n");
 719     }
 720     else {
 721         if (!TerminateProcess(hProcess, sig))
 722             CROAK("kill process failed!\n");
 723         CloseHandle(hProcess);
 724     }
 725     return 0;
 726 }
 727
 728 /*
 729  * File system stuff
 730  */
 731
 732 #if 0
 733 int
 734 ioctl(int i, unsigned int u, char *data)
 735 {
 736     CROAK("ioctl not implemented!\n");
 737     return -1;
 738 }
 739 #endif
 740
 741 unsigned int
 742 sleep(unsigned int t)
 743 {
 744     Sleep(t*1000);
 745     return 0;
 746 }
 747
 748
 749 #undef rename
 750
 751 int
 752 myrename(char *OldFileName, char *newname)
 753 {
 754     if(_access(newname, 0) != -1) {     /* file exists */
 755         _unlink(newname);
 756     }
 757     return rename(OldFileName, newname);
 758 }
 759
 760
 761 DllExport int
 762 win32_stat(const char *path, struct stat *buffer)
 763 {
 764     char                t[MAX_PATH];
 765     const char  *p = path;
 766     int         l = strlen(path);
 767     int         res;
 768
 769     if (l > 1) {
 770         switch(path[l - 1]) {
 771         case '\\':
 772         case '/':
 773             if (path[l - 2] != ':') {
 774                 strncpy(t, path, l - 1);
 775                 t[l - 1] = 0;
 776                 p = t;
 777             };
 778         }
 779     }
 780     res = pIOSubSystem->pfnstat(p,buffer);
 781 #ifdef __BORLANDC__
 782     if (res == 0) {
 783         if (S_ISDIR(buffer->st_mode))
 784             buffer->st_mode |= S_IWRITE | S_IEXEC;
 785         else if (S_ISREG(buffer->st_mode)) {
 786             if (l >= 4 && path[l-4] == '.') {
 787                 const char *e = path + l - 3;
 788                 if (strnicmp(e,"exe",3)
 789                     && strnicmp(e,"bat",3)
 790                     && strnicmp(e,"com",3)
 791                     && (IsWin95() || strnicmp(e,"cmd",3)))
 792                     buffer->st_mode &= ~S_IEXEC;
 793                 else
 794                     buffer->st_mode |= S_IEXEC;
 795             }
 796             else
 797                 buffer->st_mode &= ~S_IEXEC;
 798         }
 799     }
 800 #endif
 801     return res;
 802 }
 803
 804 #ifndef USE_WIN32_RTL_ENV
 805
 806 DllExport char *
 807 win32_getenv(const char *name)
 808 {
 809     static char *curitem = Nullch;
 810     static DWORD curlen = 512;
 811     DWORD needlen;
 812     if (!curitem)
 813         New(1305,curitem,curlen,char);
 814     if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
 815         return Nullch;
 816     while (needlen > curlen) {
 817         Renew(curitem,needlen,char);
 818         curlen = needlen;
 819         needlen = GetEnvironmentVariable(name,curitem,curlen);
 820     }
 821     return curitem;
 822 }
 823
 824 #endif
 825
 826 #undef times
 827 int
 828 mytimes(struct tms *timebuf)
 829 {
 830     clock_t     t = clock();
 831     timebuf->tms_utime = t;
 832     timebuf->tms_stime = 0;
 833     timebuf->tms_cutime = 0;
 834     timebuf->tms_cstime = 0;
 835
 836     return 0;
 837 }
 838
 839 #undef alarm
 840 unsigned int
 841 myalarm(unsigned int sec)
 842 {
 843     /* we warn the usuage of alarm function */
 844     if (sec != 0)
 845         WARN("dummy function alarm called, program might not function as expected\n");
 846     return 0;
 847 }
 848
 849 /*
 850  *  redirected io subsystem for all XS modules
 851  *
 852  */
 853
 854 DllExport int *
 855 win32_errno(void)
 856 {
 857     return (pIOSubSystem->pfnerrno());
 858 }
 859
 860 DllExport char ***
 861 win32_environ(void)
 862 {
 863     return (pIOSubSystem->pfnenviron());
 864 }
 865
 866 /* the rest are the remapped stdio routines */
 867 DllExport FILE *
 868 win32_stderr(void)
 869 {
 870     return (pIOSubSystem->pfnstderr());
 871 }
 872
 873 DllExport FILE *
 874 win32_stdin(void)
 875 {
 876     return (pIOSubSystem->pfnstdin());
 877 }
 878
 879 DllExport FILE *
 880 win32_stdout()
 881 {
 882     return (pIOSubSystem->pfnstdout());
 883 }
 884
 885 DllExport int
 886 win32_ferror(FILE *fp)
 887 {
 888     return (pIOSubSystem->pfnferror(fp));
 889 }
 890
 891
 892 DllExport int
 893 win32_feof(FILE *fp)
 894 {
 895     return (pIOSubSystem->pfnfeof(fp));
 896 }
 897
 898 /*
 899  * Since the errors returned by the socket error function
 900  * WSAGetLastError() are not known by the library routine strerror
 901  * we have to roll our own.
 902  */
 903
 904 __declspec(thread) char strerror_buffer[512];
 905
 906 DllExport char *
 907 win32_strerror(int e)
 908 {
 909 #ifndef __BORLANDC__            /* Borland intolerance */
 910     extern int sys_nerr;
 911 #endif
 912     DWORD source = 0;
 913
 914     if(e < 0 || e > sys_nerr) {
 915         if(e < 0)
 916             e = GetLastError();
 917
 918         if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
 919                          strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
 920             strcpy(strerror_buffer, "Unknown Error");
 921
 922         return strerror_buffer;
 923     }
 924     return pIOSubSystem->pfnstrerror(e);
 925 }
 926
 927 DllExport int
 928 win32_fprintf(FILE *fp, const char *format, ...)
 929 {
 930     va_list marker;
 931     va_start(marker, format);     /* Initialize variable arguments. */
 932
 933     return (pIOSubSystem->pfnvfprintf(fp, format, marker));
 934 }
 935
 936 DllExport int
 937 win32_printf(const char *format, ...)
 938 {
 939     va_list marker;
 940     va_start(marker, format);     /* Initialize variable arguments. */
 941
 942     return (pIOSubSystem->pfnvprintf(format, marker));
 943 }
 944
 945 DllExport int
 946 win32_vfprintf(FILE *fp, const char *format, va_list args)
 947 {
 948     return (pIOSubSystem->pfnvfprintf(fp, format, args));
 949 }
 950
 951 DllExport int
 952 win32_vprintf(const char *format, va_list args)
 953 {
 954     return (pIOSubSystem->pfnvprintf(format, args));
 955 }
 956
 957 DllExport size_t
 958 win32_fread(void *buf, size_t size, size_t count, FILE *fp)
 959 {
 960     return pIOSubSystem->pfnfread(buf, size, count, fp);
 961 }
 962
 963 DllExport size_t
 964 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
 965 {
 966     return pIOSubSystem->pfnfwrite(buf, size, count, fp);
 967 }
 968
 969 DllExport FILE *
 970 win32_fopen(const char *filename, const char *mode)
 971 {
 972     if (stricmp(filename, "/dev/null")==0)
 973         return pIOSubSystem->pfnfopen("NUL", mode);
 974     return pIOSubSystem->pfnfopen(filename, mode);
 975 }
 976
 977 DllExport FILE *
 978 win32_fdopen( int handle, const char *mode)
 979 {
 980     return pIOSubSystem->pfnfdopen(handle, mode);
 981 }
 982
 983 DllExport FILE *
 984 win32_freopen( const char *path, const char *mode, FILE *stream)
 985 {
 986     if (stricmp(path, "/dev/null")==0)
 987         return pIOSubSystem->pfnfreopen("NUL", mode, stream);
 988     return pIOSubSystem->pfnfreopen(path, mode, stream);
 989 }
 990
 991 DllExport int
 992 win32_fclose(FILE *pf)
 993 {
 994     return pIOSubSystem->pfnfclose(pf);
 995 }
 996
 997 DllExport int
 998 win32_fputs(const char *s,FILE *pf)
 999 {
1000     return pIOSubSystem->pfnfputs(s, pf);
1001 }
1002
1003 DllExport int
1004 win32_fputc(int c,FILE *pf)
1005 {
1006     return pIOSubSystem->pfnfputc(c,pf);
1007 }
1008
1009 DllExport int
1010 win32_ungetc(int c,FILE *pf)
1011 {
1012     return pIOSubSystem->pfnungetc(c,pf);
1013 }
1014
1015 DllExport int
1016 win32_getc(FILE *pf)
1017 {
1018     return pIOSubSystem->pfngetc(pf);
1019 }
1020
1021 DllExport int
1022 win32_fileno(FILE *pf)
1023 {
1024     return pIOSubSystem->pfnfileno(pf);
1025 }
1026
1027 DllExport void
1028 win32_clearerr(FILE *pf)
1029 {
1030     pIOSubSystem->pfnclearerr(pf);
1031     return;
1032 }
1033
1034 DllExport int
1035 win32_fflush(FILE *pf)
1036 {
1037     return pIOSubSystem->pfnfflush(pf);
1038 }
1039
1040 DllExport long
1041 win32_ftell(FILE *pf)
1042 {
1043     return pIOSubSystem->pfnftell(pf);
1044 }
1045
1046 DllExport int
1047 win32_fseek(FILE *pf,long offset,int origin)
1048 {
1049     return pIOSubSystem->pfnfseek(pf, offset, origin);
1050 }
1051
1052 DllExport int
1053 win32_fgetpos(FILE *pf,fpos_t *p)
1054 {
1055     return pIOSubSystem->pfnfgetpos(pf, p);
1056 }
1057
1058 DllExport int
1059 win32_fsetpos(FILE *pf,const fpos_t *p)
1060 {
1061     return pIOSubSystem->pfnfsetpos(pf, p);
1062 }
1063
1064 DllExport void
1065 win32_rewind(FILE *pf)
1066 {
1067     pIOSubSystem->pfnrewind(pf);
1068     return;
1069 }
1070
1071 DllExport FILE*
1072 win32_tmpfile(void)
1073 {
1074     return pIOSubSystem->pfntmpfile();
1075 }
1076
1077 DllExport void
1078 win32_abort(void)
1079 {
1080     pIOSubSystem->pfnabort();
1081     return;
1082 }
1083
1084 DllExport int
1085 win32_fstat(int fd,struct stat *bufptr)
1086 {
1087     return pIOSubSystem->pfnfstat(fd,bufptr);
1088 }
1089
1090 DllExport int
1091 win32_pipe(int *pfd, unsigned int size, int mode)
1092 {
1093     return pIOSubSystem->pfnpipe(pfd, size, mode);
1094 }
1095
1096 DllExport FILE*
1097 win32_popen(const char *command, const char *mode)
1098 {
1099     return pIOSubSystem->pfnpopen(command, mode);
1100 }
1101
1102 DllExport int
1103 win32_pclose(FILE *pf)
1104 {
1105     return pIOSubSystem->pfnpclose(pf);
1106 }
1107
1108 DllExport int
1109 win32_setmode(int fd, int mode)
1110 {
1111     return pIOSubSystem->pfnsetmode(fd, mode);
1112 }
1113
1114 DllExport long
1115 win32_lseek(int fd, long offset, int origin)
1116 {
1117     return pIOSubSystem->pfnlseek(fd, offset, origin);
1118 }
1119
1120 DllExport long
1121 win32_tell(int fd)
1122 {
1123     return pIOSubSystem->pfntell(fd);
1124 }
1125
1126 DllExport int
1127 win32_open(const char *path, int flag, ...)
1128 {
1129     va_list ap;
1130     int pmode;
1131
1132     va_start(ap, flag);
1133     pmode = va_arg(ap, int);
1134     va_end(ap);
1135
1136     if (stricmp(path, "/dev/null")==0)
1137         return pIOSubSystem->pfnopen("NUL", flag, pmode);
1138     return pIOSubSystem->pfnopen(path,flag,pmode);
1139 }
1140
1141 DllExport int
1142 win32_close(int fd)
1143 {
1144     return pIOSubSystem->pfnclose(fd);
1145 }
1146
1147 DllExport int
1148 win32_eof(int fd)
1149 {
1150     return pIOSubSystem->pfneof(fd);
1151 }
1152
1153 DllExport int
1154 win32_dup(int fd)
1155 {
1156     return pIOSubSystem->pfndup(fd);
1157 }
1158
1159 DllExport int
1160 win32_dup2(int fd1,int fd2)
1161 {
1162     return pIOSubSystem->pfndup2(fd1,fd2);
1163 }
1164
1165 DllExport int
1166 win32_read(int fd, void *buf, unsigned int cnt)
1167 {
1168     return pIOSubSystem->pfnread(fd, buf, cnt);
1169 }
1170
1171 DllExport int
1172 win32_write(int fd, const void *buf, unsigned int cnt)
1173 {
1174     return pIOSubSystem->pfnwrite(fd, buf, cnt);
1175 }
1176
1177 DllExport int
1178 win32_mkdir(const char *dir, int mode)
1179 {
1180     return pIOSubSystem->pfnmkdir(dir); /* just ignore mode */
1181 }
1182
1183 DllExport int
1184 win32_rmdir(const char *dir)
1185 {
1186     return pIOSubSystem->pfnrmdir(dir);
1187 }
1188
1189 DllExport int
1190 win32_chdir(const char *dir)
1191 {
1192     return pIOSubSystem->pfnchdir(dir);
1193 }
1194
1195 DllExport int
1196 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
1197 {
1198     return pIOSubSystem->pfnspawnvp(mode, cmdname, argv);
1199 }
1200
1201 DllExport int
1202 win32_execvp(const char *cmdname, const char *const *argv)
1203 {
1204     return pIOSubSystem->pfnexecvp(cmdname, argv);
1205 }
1206
1207 int
1208 stolen_open_osfhandle(long handle, int flags)
1209 {
1210     return pIOSubSystem->pfn_open_osfhandle(handle, flags);
1211 }
1212
1213 long
1214 stolen_get_osfhandle(int fd)
1215 {
1216     return pIOSubSystem->pfn_get_osfhandle(fd);
1217 }
1218
1219 /*
1220  * Extras.
1221  */
1222
1223 DllExport int
1224 win32_flock(int fd, int oper)
1225 {
1226     if (!IsWinNT()) {
1227         croak("flock() unimplemented on this platform");
1228         return -1;
1229     }
1230     return pIOSubSystem->pfnflock(fd, oper);
1231 }
1232
1233 static
1234 XS(w32_GetCwd)
1235 {
1236     dXSARGS;
1237     SV *sv = sv_newmortal();
1238     /* Make one call with zero size - return value is required size */
1239     DWORD len = GetCurrentDirectory((DWORD)0,NULL);
1240     SvUPGRADE(sv,SVt_PV);
1241     SvGROW(sv,len);
1242     SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
1243     /*
1244      * If result != 0
1245      *   then it worked, set PV valid,
1246      *   else leave it 'undef'
1247      */
1248     if (SvCUR(sv))
1249         SvPOK_on(sv);
1250     EXTEND(sp,1);
1251     ST(0) = sv;
1252     XSRETURN(1);
1253 }
1254
1255 static
1256 XS(w32_SetCwd)
1257 {
1258     dXSARGS;
1259     if (items != 1)
1260         croak("usage: Win32::SetCurrentDirectory($cwd)");
1261     if (SetCurrentDirectory(SvPV(ST(0),na)))
1262         XSRETURN_YES;
1263
1264     XSRETURN_NO;
1265 }
1266
1267 static
1268 XS(w32_GetNextAvailDrive)
1269 {
1270     dXSARGS;
1271     char ix = 'C';
1272     char root[] = "_:\\";
1273     while (ix <= 'Z') {
1274         root[0] = ix++;
1275         if (GetDriveType(root) == 1) {
1276             root[2] = '\0';
1277             XSRETURN_PV(root);
1278         }
1279     }
1280     XSRETURN_UNDEF;
1281 }
1282
1283 static
1284 XS(w32_GetLastError)
1285 {
1286     dXSARGS;
1287     XSRETURN_IV(GetLastError());
1288 }
1289
1290 static
1291 XS(w32_LoginName)
1292 {
1293     dXSARGS;
1294     char name[256];
1295     DWORD size = sizeof(name);
1296     if (GetUserName(name,&size)) {
1297         /* size includes NULL */
1298         ST(0) = sv_2mortal(newSVpv(name,size-1));
1299         XSRETURN(1);
1300     }
1301     XSRETURN_UNDEF;
1302 }
1303
1304 static
1305 XS(w32_NodeName)
1306 {
1307     dXSARGS;
1308     char name[MAX_COMPUTERNAME_LENGTH+1];
1309     DWORD size = sizeof(name);
1310     if (GetComputerName(name,&size)) {
1311         /* size does NOT include NULL :-( */
1312         ST(0) = sv_2mortal(newSVpv(name,size));
1313         XSRETURN(1);
1314     }
1315     XSRETURN_UNDEF;
1316 }
1317
1318
1319 static
1320 XS(w32_DomainName)
1321 {
1322     dXSARGS;
1323     char name[256];
1324     DWORD size = sizeof(name);
1325     if (GetUserName(name,&size)) {
1326         char sid[1024];
1327         DWORD sidlen = sizeof(sid);
1328         char dname[256];
1329         DWORD dnamelen = sizeof(dname);
1330         SID_NAME_USE snu;
1331         if (LookupAccountName(NULL, name, &sid, &sidlen,
1332                               dname, &dnamelen, &snu)) {
1333             XSRETURN_PV(dname);         /* all that for this */
1334         }
1335     }
1336     XSRETURN_UNDEF;
1337 }
1338
1339 static
1340 XS(w32_FsType)
1341 {
1342     dXSARGS;
1343     char fsname[256];
1344     DWORD flags, filecomplen;
1345     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
1346                          &flags, fsname, sizeof(fsname))) {
1347         if (GIMME == G_ARRAY) {
1348             XPUSHs(sv_2mortal(newSVpv(fsname,0)));
1349             XPUSHs(sv_2mortal(newSViv(flags)));
1350             XPUSHs(sv_2mortal(newSViv(filecomplen)));
1351             PUTBACK;
1352             return;
1353         }
1354         XSRETURN_PV(fsname);
1355     }
1356     XSRETURN_UNDEF;
1357 }
1358
1359 static
1360 XS(w32_GetOSVersion)
1361 {
1362     dXSARGS;
1363     OSVERSIONINFO osver;
1364
1365     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
1366     if (GetVersionEx(&osver)) {
1367         XPUSHs(newSVpv(osver.szCSDVersion, 0));
1368         XPUSHs(newSViv(osver.dwMajorVersion));
1369         XPUSHs(newSViv(osver.dwMinorVersion));
1370         XPUSHs(newSViv(osver.dwBuildNumber));
1371         XPUSHs(newSViv(osver.dwPlatformId));
1372         PUTBACK;
1373         return;
1374     }
1375     XSRETURN_UNDEF;
1376 }
1377
1378 static
1379 XS(w32_IsWinNT)
1380 {
1381     dXSARGS;
1382     XSRETURN_IV(IsWinNT());
1383 }
1384
1385 static
1386 XS(w32_IsWin95)
1387 {
1388     dXSARGS;
1389     XSRETURN_IV(IsWin95());
1390 }
1391
1392 static
1393 XS(w32_FormatMessage)
1394 {
1395     dXSARGS;
1396     DWORD source = 0;
1397     char msgbuf[1024];
1398
1399     if (items != 1)
1400         croak("usage: Win32::FormatMessage($errno)");
1401
1402     if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
1403                       &source, SvIV(ST(0)), 0,
1404                       msgbuf, sizeof(msgbuf)-1, NULL))
1405         XSRETURN_PV(msgbuf);
1406
1407     XSRETURN_UNDEF;
1408 }
1409
1410 static
1411 XS(w32_Spawn)
1412 {
1413     dXSARGS;
1414     char *cmd, *args;
1415     PROCESS_INFORMATION stProcInfo;
1416     STARTUPINFO stStartInfo;
1417     BOOL bSuccess = FALSE;
1418
1419     if(items != 3)
1420         croak("usage: Win32::Spawn($cmdName, $args, $PID)");
1421
1422     cmd = SvPV(ST(0),na);
1423     args = SvPV(ST(1), na);
1424
1425     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
1426     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
1427     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
1428     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
1429
1430     if(CreateProcess(
1431                 cmd,                    /* Image path */
1432                 args,                   /* Arguments for command line */
1433                 NULL,                   /* Default process security */
1434                 NULL,                   /* Default thread security */
1435                 FALSE,                  /* Must be TRUE to use std handles */
1436                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
1437                 NULL,                   /* Inherit our environment block */
1438                 NULL,                   /* Inherit our currrent directory */
1439                 &stStartInfo,           /* -> Startup info */
1440                 &stProcInfo))           /* <- Process info (if OK) */
1441     {
1442         CloseHandle(stProcInfo.hThread);/* library source code does this. */
1443         sv_setiv(ST(2), stProcInfo.dwProcessId);
1444         bSuccess = TRUE;
1445     }
1446     XSRETURN_IV(bSuccess);
1447 }
1448
1449 static
1450 XS(w32_GetTickCount)
1451 {
1452     dXSARGS;
1453     XSRETURN_IV(GetTickCount());
1454 }
1455
1456 static
1457 XS(w32_GetShortPathName)
1458 {
1459     dXSARGS;
1460     SV *shortpath;
1461
1462     if(items != 1)
1463         croak("usage: Win32::GetShortPathName($longPathName)");
1464
1465     shortpath = sv_mortalcopy(ST(0));
1466     SvUPGRADE(shortpath, SVt_PV);
1467     /* src == target is allowed */
1468     if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath)))
1469         ST(0) = shortpath;
1470     else
1471         ST(0) = &sv_undef;
1472     XSRETURN(1);
1473 }
1474
1475 void
1476 init_os_extras()
1477 {
1478     char *file = __FILE__;
1479     dXSUB_SYS;
1480
1481     /* XXX should be removed after checking with Nick */
1482     newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
1483
1484     /* these names are Activeware compatible */
1485     newXS("Win32::GetCwd", w32_GetCwd, file);
1486     newXS("Win32::SetCwd", w32_SetCwd, file);
1487     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
1488     newXS("Win32::GetLastError", w32_GetLastError, file);
1489     newXS("Win32::LoginName", w32_LoginName, file);
1490     newXS("Win32::NodeName", w32_NodeName, file);
1491     newXS("Win32::DomainName", w32_DomainName, file);
1492     newXS("Win32::FsType", w32_FsType, file);
1493     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
1494     newXS("Win32::IsWinNT", w32_IsWinNT, file);
1495     newXS("Win32::IsWin95", w32_IsWin95, file);
1496     newXS("Win32::FormatMessage", w32_FormatMessage, file);
1497     newXS("Win32::Spawn", w32_Spawn, file);
1498     newXS("Win32::GetTickCount", w32_GetTickCount, file);
1499     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
1500
1501     /* XXX Bloat Alert! The following Activeware preloads really
1502      * ought to be part of Win32::Sys::*, so they're not included
1503      * here.
1504      */
1505     /* LookupAccountName
1506      * LookupAccountSID
1507      * InitiateSystemShutdown
1508      * AbortSystemShutdown
1509      * ExpandEnvrironmentStrings
1510      */
1511 }
1512
1513 void
1514 Perl_win32_init(int *argcp, char ***argvp)
1515 {
1516     /* Disable floating point errors, Perl will trap the ones we
1517      * care about.  VC++ RTL defaults to switching these off
1518      * already, but the Borland RTL doesn't.  Since we don't
1519      * want to be at the vendor's whim on the default, we set
1520      * it explicitly here.
1521      */
1522     _control87(MCW_EM, MCW_EM);
1523 }