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