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