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