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