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