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