home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / win32 / win32.c < prev    next >
C/C++ Source or Header  |  2000-03-09  |  96KB  |  4,096 lines
  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. #ifndef __MINGW32__    /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */
  19. #  include <shellapi.h>
  20. #else
  21.    LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
  22. #endif
  23. #include <winnt.h>
  24. #include <io.h>
  25.  
  26. /* #include "config.h" */
  27.  
  28. #define PERLIO_NOT_STDIO 0 
  29. #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
  30. #define PerlIO FILE
  31. #endif
  32.  
  33. #include <sys/stat.h>
  34. #include "EXTERN.h"
  35. #include "perl.h"
  36.  
  37. #define NO_XSLOCKS
  38. #define PERL_NO_GET_CONTEXT
  39. #include "XSUB.h"
  40.  
  41. #include "Win32iop.h"
  42. #include <fcntl.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. #if defined(__MINGW32__)
  65. /* Mingw32 is missing some prototypes */
  66. FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
  67. FILE * _wfdopen(int nFd, LPCWSTR wszMode);
  68. FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
  69. int _flushall();
  70. int _fcloseall();
  71. #endif
  72.  
  73. #if defined(__BORLANDC__)
  74. #  define _stat stat
  75. #  define _utimbuf utimbuf
  76. #endif
  77.  
  78. #define EXECF_EXEC 1
  79. #define EXECF_SPAWN 2
  80. #define EXECF_SPAWN_NOWAIT 3
  81.  
  82. #if defined(PERL_IMPLICIT_SYS)
  83. #  undef win32_get_privlib
  84. #  define win32_get_privlib g_win32_get_privlib
  85. #  undef win32_get_sitelib
  86. #  define win32_get_sitelib g_win32_get_sitelib
  87. #  undef win32_get_vendorlib
  88. #  define win32_get_vendorlib g_win32_get_vendorlib
  89. #  undef do_spawn
  90. #  define do_spawn g_do_spawn
  91. #  undef getlogin
  92. #  define getlogin g_getlogin
  93. #endif
  94.  
  95. #if defined(PERL_OBJECT)
  96. #  undef do_aspawn
  97. #  define do_aspawn g_do_aspawn
  98. #  undef Perl_do_exec
  99. #  define Perl_do_exec g_do_exec
  100. #endif
  101.  
  102. static void        get_shell(void);
  103. static long        tokenize(const char *str, char **dest, char ***destv);
  104.     int        do_spawn2(char *cmd, int exectype);
  105. static BOOL        has_shell_metachars(char *ptr);
  106. static long        filetime_to_clock(PFILETIME ft);
  107. static BOOL        filetime_from_time(PFILETIME ft, time_t t);
  108. static char *        get_emd_part(SV **leading, char *trailing, ...);
  109. static void        remove_dead_process(long deceased);
  110. static long        find_pid(int pid);
  111. static char *        qualified_path(const char *cmd);
  112. static char *        win32_get_xlib(const char *pl, const char *xlib,
  113.                        const char *libname);
  114.  
  115. #ifdef USE_ITHREADS
  116. static void        remove_dead_pseudo_process(long child);
  117. static long        find_pseudo_pid(int pid);
  118. #endif
  119.  
  120. START_EXTERN_C
  121. HANDLE    w32_perldll_handle = INVALID_HANDLE_VALUE;
  122. char    w32_module_name[MAX_PATH+1];
  123. END_EXTERN_C
  124.  
  125. static DWORD    w32_platform = (DWORD)-1;
  126.  
  127. #define ONE_K_BUFSIZE    1024
  128.  
  129. int 
  130. IsWin95(void)
  131. {
  132.     return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS);
  133. }
  134.  
  135. int
  136. IsWinNT(void)
  137. {
  138.     return (win32_os_id() == VER_PLATFORM_WIN32_NT);
  139. }
  140.  
  141. EXTERN_C void
  142. set_w32_module_name(void)
  143. {
  144.     char* ptr;
  145.     GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
  146.                 ? GetModuleHandle(NULL)
  147.                 : w32_perldll_handle),
  148.               w32_module_name, sizeof(w32_module_name));
  149.  
  150.     /* try to get full path to binary (which may be mangled when perl is
  151.      * run from a 16-bit app) */
  152.     /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
  153.     (void)win32_longpath(w32_module_name);
  154.     /*PerlIO_printf(Perl_debug_log, "After  %s\n", w32_module_name);*/
  155.  
  156.     /* normalize to forward slashes */
  157.     ptr = w32_module_name;
  158.     while (*ptr) {
  159.     if (*ptr == '\\')
  160.         *ptr = '/';
  161.     ++ptr;
  162.     }
  163. }
  164.  
  165. /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
  166. static char*
  167. get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
  168. {
  169.     /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
  170.     HKEY handle;
  171.     DWORD type;
  172.     const char *subkey = "Software\\Perl";
  173.     char *str = Nullch;
  174.     long retval;
  175.  
  176.     retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
  177.     if (retval == ERROR_SUCCESS) {
  178.     DWORD datalen;
  179.     retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen);
  180.     if (retval == ERROR_SUCCESS && type == REG_SZ) {
  181.         dTHXo;
  182.         if (!*svp)
  183.         *svp = sv_2mortal(newSVpvn("",0));
  184.         SvGROW(*svp, datalen);
  185.         retval = RegQueryValueEx(handle, valuename, 0, NULL,
  186.                      (PBYTE)SvPVX(*svp), &datalen);
  187.         if (retval == ERROR_SUCCESS) {
  188.         str = SvPVX(*svp);
  189.         SvCUR_set(*svp,datalen-1);
  190.         }
  191.     }
  192.     RegCloseKey(handle);
  193.     }
  194.     return str;
  195. }
  196.  
  197. /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */
  198. static char*
  199. get_regstr(const char *valuename, SV **svp)
  200. {
  201.     char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp);
  202.     if (!str)
  203.     str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp);
  204.     return str;
  205. }
  206.  
  207. /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
  208. static char *
  209. get_emd_part(SV **prev_pathp, char *trailing_path, ...)
  210. {
  211.     char base[10];
  212.     va_list ap;
  213.     char mod_name[MAX_PATH+1];
  214.     char *ptr;
  215.     char *optr;
  216.     char *strip;
  217.     int oldsize, newsize;
  218.     STRLEN baselen;
  219.  
  220.     va_start(ap, trailing_path);
  221.     strip = va_arg(ap, char *);
  222.  
  223.     sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
  224.     baselen = strlen(base);
  225.  
  226.     if (!*w32_module_name) {
  227.     set_w32_module_name();
  228.     }
  229.     strcpy(mod_name, w32_module_name);
  230.     ptr = strrchr(mod_name, '/');
  231.     while (ptr && strip) {
  232.         /* look for directories to skip back */
  233.     optr = ptr;
  234.     *ptr = '\0';
  235.     ptr = strrchr(mod_name, '/');
  236.     /* avoid stripping component if there is no slash,
  237.      * or it doesn't match ... */
  238.     if (!ptr || stricmp(ptr+1, strip) != 0) {
  239.         /* ... but not if component matches m|5\.$patchlevel.*| */
  240.         if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
  241.               && strncmp(strip, base, baselen) == 0
  242.               && strncmp(ptr+1, base, baselen) == 0))
  243.         {
  244.         *optr = '/';
  245.         ptr = optr;
  246.         }
  247.     }
  248.     strip = va_arg(ap, char *);
  249.     }
  250.     if (!ptr) {
  251.     ptr = mod_name;
  252.     *ptr++ = '.';
  253.     *ptr = '/';
  254.     }
  255.     va_end(ap);
  256.     strcpy(++ptr, trailing_path);
  257.  
  258.     /* only add directory if it exists */
  259.     if (GetFileAttributes(mod_name) != (DWORD) -1) {
  260.     /* directory exists */
  261.     dTHXo;
  262.     if (!*prev_pathp)
  263.         *prev_pathp = sv_2mortal(newSVpvn("",0));
  264.     sv_catpvn(*prev_pathp, ";", 1);
  265.     sv_catpv(*prev_pathp, mod_name);
  266.     return SvPVX(*prev_pathp);
  267.     }
  268.  
  269.     return Nullch;
  270. }
  271.  
  272. char *
  273. win32_get_privlib(const char *pl)
  274. {
  275.     dTHXo;
  276.     char *stdlib = "lib";
  277.     char buffer[MAX_PATH+1];
  278.     SV *sv = Nullsv;
  279.  
  280.     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
  281.     sprintf(buffer, "%s-%s", stdlib, pl);
  282.     if (!get_regstr(buffer, &sv))
  283.     (void)get_regstr(stdlib, &sv);
  284.  
  285.     /* $stdlib .= ";$EMD/../../lib" */
  286.     return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
  287. }
  288.  
  289. static char *
  290. win32_get_xlib(const char *pl, const char *xlib, const char *libname)
  291. {
  292.     dTHXo;
  293.     char regstr[40];
  294.     char pathstr[MAX_PATH+1];
  295.     DWORD datalen;
  296.     int len, newsize;
  297.     SV *sv1 = Nullsv;
  298.     SV *sv2 = Nullsv;
  299.  
  300.     /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
  301.     sprintf(regstr, "%s-%s", xlib, pl);
  302.     (void)get_regstr(regstr, &sv1);
  303.  
  304.     /* $xlib .=
  305.      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib";  */
  306.     sprintf(pathstr, "%s/%s/lib", libname, pl);
  307.     (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
  308.  
  309.     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
  310.     (void)get_regstr(xlib, &sv2);
  311.  
  312.     /* $xlib .=
  313.      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib";  */
  314.     sprintf(pathstr, "%s/lib", libname);
  315.     (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
  316.  
  317.     if (!sv1 && !sv2)
  318.     return Nullch;
  319.     if (!sv1)
  320.     return SvPVX(sv2);
  321.     if (!sv2)
  322.     return SvPVX(sv1);
  323.  
  324.     sv_catpvn(sv1, ";", 1);
  325.     sv_catsv(sv1, sv2);
  326.  
  327.     return SvPVX(sv1);
  328. }
  329.  
  330. char *
  331. win32_get_sitelib(const char *pl)
  332. {
  333.     return win32_get_xlib(pl, "sitelib", "site");
  334. }
  335.  
  336. #ifndef PERL_VENDORLIB_NAME
  337. #  define PERL_VENDORLIB_NAME    "vendor"
  338. #endif
  339.  
  340. char *
  341. win32_get_vendorlib(const char *pl)
  342. {
  343.     return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
  344. }
  345.  
  346. static BOOL
  347. has_shell_metachars(char *ptr)
  348. {
  349.     int inquote = 0;
  350.     char quote = '\0';
  351.  
  352.     /*
  353.      * Scan string looking for redirection (< or >) or pipe
  354.      * characters (|) that are not in a quoted string.
  355.      * Shell variable interpolation (%VAR%) can also happen inside strings.
  356.      */
  357.     while (*ptr) {
  358.     switch(*ptr) {
  359.     case '%':
  360.         return TRUE;
  361.     case '\'':
  362.     case '\"':
  363.         if (inquote) {
  364.         if (quote == *ptr) {
  365.             inquote = 0;
  366.             quote = '\0';
  367.         }
  368.         }
  369.         else {
  370.         quote = *ptr;
  371.         inquote++;
  372.         }
  373.         break;
  374.     case '>':
  375.     case '<':
  376.     case '|':
  377.         if (!inquote)
  378.         return TRUE;
  379.     default:
  380.         break;
  381.     }
  382.     ++ptr;
  383.     }
  384.     return FALSE;
  385. }
  386.  
  387. #if !defined(PERL_IMPLICIT_SYS)
  388. /* since the current process environment is being updated in util.c
  389.  * the library functions will get the correct environment
  390.  */
  391. PerlIO *
  392. Perl_my_popen(pTHX_ char *cmd, char *mode)
  393. {
  394. #ifdef FIXCMD
  395. #define fixcmd(x)   {                    \
  396.             char *pspace = strchr((x),' ');    \
  397.             if (pspace) {            \
  398.                 char *p = (x);        \
  399.                 while (p < pspace) {    \
  400.                 if (*p == '/')        \
  401.                     *p = '\\';        \
  402.                 p++;            \
  403.                 }                \
  404.             }                \
  405.             }
  406. #else
  407. #define fixcmd(x)
  408. #endif
  409.     fixcmd(cmd);
  410.     PERL_FLUSHALL_FOR_CHILD;
  411.     return win32_popen(cmd, mode);
  412. }
  413.  
  414. long
  415. Perl_my_pclose(pTHX_ PerlIO *fp)
  416. {
  417.     return win32_pclose(fp);
  418. }
  419. #endif
  420.  
  421. DllExport unsigned long
  422. win32_os_id(void)
  423. {
  424.     static OSVERSIONINFO osver;
  425.  
  426.     if (osver.dwPlatformId != w32_platform) {
  427.     memset(&osver, 0, sizeof(OSVERSIONINFO));
  428.     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  429.     GetVersionEx(&osver);
  430.     w32_platform = osver.dwPlatformId;
  431.     }
  432.     return (unsigned long)w32_platform;
  433. }
  434.  
  435. DllExport int
  436. win32_getpid(void)
  437. {
  438. #ifdef USE_ITHREADS
  439.     dTHXo;
  440.     if (w32_pseudo_id)
  441.     return -((int)w32_pseudo_id);
  442. #endif
  443.     return _getpid();
  444. }
  445.  
  446. /* Tokenize a string.  Words are null-separated, and the list
  447.  * ends with a doubled null.  Any character (except null and
  448.  * including backslash) may be escaped by preceding it with a
  449.  * backslash (the backslash will be stripped).
  450.  * Returns number of words in result buffer.
  451.  */
  452. static long
  453. tokenize(const char *str, char **dest, char ***destv)
  454. {
  455.     char *retstart = Nullch;
  456.     char **retvstart = 0;
  457.     int items = -1;
  458.     if (str) {
  459.     dTHXo;
  460.     int slen = strlen(str);
  461.     register char *ret;
  462.     register char **retv;
  463.     New(1307, ret, slen+2, char);
  464.     New(1308, retv, (slen+3)/2, char*);
  465.  
  466.     retstart = ret;
  467.     retvstart = retv;
  468.     *retv = ret;
  469.     items = 0;
  470.     while (*str) {
  471.         *ret = *str++;
  472.         if (*ret == '\\' && *str)
  473.         *ret = *str++;
  474.         else if (*ret == ' ') {
  475.         while (*str == ' ')
  476.             str++;
  477.         if (ret == retstart)
  478.             ret--;
  479.         else {
  480.             *ret = '\0';
  481.             ++items;
  482.             if (*str)
  483.             *++retv = ret+1;
  484.         }
  485.         }
  486.         else if (!*str)
  487.         ++items;
  488.         ret++;
  489.     }
  490.     retvstart[items] = Nullch;
  491.     *ret++ = '\0';
  492.     *ret = '\0';
  493.     }
  494.     *dest = retstart;
  495.     *destv = retvstart;
  496.     return items;
  497. }
  498.  
  499. static void
  500. get_shell(void)
  501. {
  502.     dTHXo;
  503.     if (!w32_perlshell_tokens) {
  504.     /* we don't use COMSPEC here for two reasons:
  505.      *  1. the same reason perl on UNIX doesn't use SHELL--rampant and
  506.      *     uncontrolled unportability of the ensuing scripts.
  507.      *  2. PERL5SHELL could be set to a shell that may not be fit for
  508.      *     interactive use (which is what most programs look in COMSPEC
  509.      *     for).
  510.      */
  511.     const char* defaultshell = (IsWinNT()
  512.                     ? "cmd.exe /x/c" : "command.com /c");
  513.     const char *usershell = getenv("PERL5SHELL");
  514.     w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
  515.                        &w32_perlshell_tokens,
  516.                        &w32_perlshell_vec);
  517.     }
  518. }
  519.  
  520. int
  521. do_aspawn(void *vreally, void **vmark, void **vsp)
  522. {
  523.     dTHXo;
  524.     SV *really = (SV*)vreally;
  525.     SV **mark = (SV**)vmark;
  526.     SV **sp = (SV**)vsp;
  527.     char **argv;
  528.     char *str;
  529.     int status;
  530.     int flag = P_WAIT;
  531.     int index = 0;
  532.  
  533.     if (sp <= mark)
  534.     return -1;
  535.  
  536.     get_shell();
  537.     New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
  538.  
  539.     if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
  540.     ++mark;
  541.     flag = SvIVx(*mark);
  542.     }
  543.  
  544.     while (++mark <= sp) {
  545.     if (*mark && (str = SvPV_nolen(*mark)))
  546.         argv[index++] = str;
  547.     else
  548.         argv[index++] = "";
  549.     }
  550.     argv[index++] = 0;
  551.    
  552.     status = win32_spawnvp(flag,
  553.                (const char*)(really ? SvPV_nolen(really) : argv[0]),
  554.                (const char* const*)argv);
  555.  
  556.     if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
  557.     /* possible shell-builtin, invoke with shell */
  558.     int sh_items;
  559.     sh_items = w32_perlshell_items;
  560.     while (--index >= 0)
  561.         argv[index+sh_items] = argv[index];
  562.     while (--sh_items >= 0)
  563.         argv[sh_items] = w32_perlshell_vec[sh_items];
  564.    
  565.     status = win32_spawnvp(flag,
  566.                    (const char*)(really ? SvPV_nolen(really) : argv[0]),
  567.                    (const char* const*)argv);
  568.     }
  569.  
  570.     if (flag != P_NOWAIT) {
  571.     if (status < 0) {
  572.             dTHR;
  573.         if (ckWARN(WARN_EXEC))
  574.         Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno));
  575.         status = 255 * 256;
  576.     }
  577.     else
  578.         status *= 256;
  579.     PL_statusvalue = status;
  580.     }
  581.     Safefree(argv);
  582.     return (status);
  583. }
  584.  
  585. int
  586. do_spawn2(char *cmd, int exectype)
  587. {
  588.     dTHXo;
  589.     char **a;
  590.     char *s;
  591.     char **argv;
  592.     int status = -1;
  593.     BOOL needToTry = TRUE;
  594.     char *cmd2;
  595.  
  596.     /* Save an extra exec if possible. See if there are shell
  597.      * metacharacters in it */
  598.     if (!has_shell_metachars(cmd)) {
  599.     New(1301,argv, strlen(cmd) / 2 + 2, char*);
  600.     New(1302,cmd2, strlen(cmd) + 1, char);
  601.     strcpy(cmd2, cmd);
  602.     a = argv;
  603.     for (s = cmd2; *s;) {
  604.         while (*s && isSPACE(*s))
  605.         s++;
  606.         if (*s)
  607.         *(a++) = s;
  608.         while (*s && !isSPACE(*s))
  609.         s++;
  610.         if (*s)
  611.         *s++ = '\0';
  612.     }
  613.     *a = Nullch;
  614.     if (argv[0]) {
  615.         switch (exectype) {
  616.         case EXECF_SPAWN:
  617.         status = win32_spawnvp(P_WAIT, argv[0],
  618.                        (const char* const*)argv);
  619.         break;
  620.         case EXECF_SPAWN_NOWAIT:
  621.         status = win32_spawnvp(P_NOWAIT, argv[0],
  622.                        (const char* const*)argv);
  623.         break;
  624.         case EXECF_EXEC:
  625.         status = win32_execvp(argv[0], (const char* const*)argv);
  626.         break;
  627.         }
  628.         if (status != -1 || errno == 0)
  629.         needToTry = FALSE;
  630.     }
  631.     Safefree(argv);
  632.     Safefree(cmd2);
  633.     }
  634.     if (needToTry) {
  635.     char **argv;
  636.     int i = -1;
  637.     get_shell();
  638.     New(1306, argv, w32_perlshell_items + 2, char*);
  639.     while (++i < w32_perlshell_items)
  640.         argv[i] = w32_perlshell_vec[i];
  641.     argv[i++] = cmd;
  642.     argv[i] = Nullch;
  643.     switch (exectype) {
  644.     case EXECF_SPAWN:
  645.         status = win32_spawnvp(P_WAIT, argv[0],
  646.                    (const char* const*)argv);
  647.         break;
  648.     case EXECF_SPAWN_NOWAIT:
  649.         status = win32_spawnvp(P_NOWAIT, argv[0],
  650.                    (const char* const*)argv);
  651.         break;
  652.     case EXECF_EXEC:
  653.         status = win32_execvp(argv[0], (const char* const*)argv);
  654.         break;
  655.     }
  656.     cmd = argv[0];
  657.     Safefree(argv);
  658.     }
  659.     if (exectype != EXECF_SPAWN_NOWAIT) {
  660.     if (status < 0) {
  661.             dTHR;
  662.         if (ckWARN(WARN_EXEC))
  663.         Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
  664.              (exectype == EXECF_EXEC ? "exec" : "spawn"),
  665.              cmd, strerror(errno));
  666.         status = 255 * 256;
  667.     }
  668.     else
  669.         status *= 256;
  670.     PL_statusvalue = status;
  671.     }
  672.     return (status);
  673. }
  674.  
  675. int
  676. do_spawn(char *cmd)
  677. {
  678.     return do_spawn2(cmd, EXECF_SPAWN);
  679. }
  680.  
  681. int
  682. do_spawn_nowait(char *cmd)
  683. {
  684.     return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
  685. }
  686.  
  687. bool
  688. Perl_do_exec(pTHX_ char *cmd)
  689. {
  690.     do_spawn2(cmd, EXECF_EXEC);
  691.     return FALSE;
  692. }
  693.  
  694. /* The idea here is to read all the directory names into a string table
  695.  * (separated by nulls) and when one of the other dir functions is called
  696.  * return the pointer to the current file name.
  697.  */
  698. DllExport DIR *
  699. win32_opendir(char *filename)
  700. {
  701.     dTHXo;
  702.     DIR            *dirp;
  703.     long        len;
  704.     long        idx;
  705.     char        scanname[MAX_PATH+3];
  706.     struct stat        sbuf;
  707.     WIN32_FIND_DATAA    aFindData;
  708.     WIN32_FIND_DATAW    wFindData;
  709.     HANDLE        fh;
  710.     char        buffer[MAX_PATH*2];
  711.     WCHAR        wbuffer[MAX_PATH+1];
  712.     char*        ptr;
  713.  
  714.     len = strlen(filename);
  715.     if (len > MAX_PATH)
  716.     return NULL;
  717.  
  718.     /* check to see if filename is a directory */
  719.     if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
  720.     return NULL;
  721.  
  722.     /* Get us a DIR structure */
  723.     Newz(1303, dirp, 1, DIR);
  724.  
  725.     /* Create the search pattern */
  726.     strcpy(scanname, filename);
  727.  
  728.     /* bare drive name means look in cwd for drive */
  729.     if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') {
  730.     scanname[len++] = '.';
  731.     scanname[len++] = '/';
  732.     }
  733.     else if (scanname[len-1] != '/' && scanname[len-1] != '\\') {
  734.     scanname[len++] = '/';
  735.     }
  736.     scanname[len++] = '*';
  737.     scanname[len] = '\0';
  738.  
  739.     /* do the FindFirstFile call */
  740.     if (USING_WIDE()) {
  741.     A2WHELPER(scanname, wbuffer, sizeof(wbuffer));
  742.     fh = FindFirstFileW(PerlDir_mapW(wbuffer), &wFindData);
  743.     }
  744.     else {
  745.     fh = FindFirstFileA(PerlDir_mapA(scanname), &aFindData);
  746.     }
  747.     dirp->handle = fh;
  748.     if (fh == INVALID_HANDLE_VALUE) {
  749.     DWORD err = GetLastError();
  750.     /* FindFirstFile() fails on empty drives! */
  751.     switch (err) {
  752.     case ERROR_FILE_NOT_FOUND:
  753.         return dirp;
  754.     case ERROR_NO_MORE_FILES:
  755.     case ERROR_PATH_NOT_FOUND:
  756.         errno = ENOENT;
  757.         break;
  758.     case ERROR_NOT_ENOUGH_MEMORY:
  759.         errno = ENOMEM;
  760.         break;
  761.     default:
  762.         errno = EINVAL;
  763.         break;
  764.     }
  765.     Safefree(dirp);
  766.     return NULL;
  767.     }
  768.  
  769.     /* now allocate the first part of the string table for
  770.      * the filenames that we find.
  771.      */
  772.     if (USING_WIDE()) {
  773.     W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
  774.     ptr = buffer;
  775.     }
  776.     else {
  777.     ptr = aFindData.cFileName;
  778.     }
  779.     idx = strlen(ptr)+1;
  780.     if (idx < 256)
  781.     dirp->size = 128;
  782.     else
  783.     dirp->size = idx;
  784.     New(1304, dirp->start, dirp->size, char);
  785.     strcpy(dirp->start, ptr);
  786.     dirp->nfiles++;
  787.     dirp->end = dirp->curr = dirp->start;
  788.     dirp->end += idx;
  789.     return dirp;
  790. }
  791.  
  792.  
  793. /* Readdir just returns the current string pointer and bumps the
  794.  * string pointer to the nDllExport entry.
  795.  */
  796. DllExport struct direct *
  797. win32_readdir(DIR *dirp)
  798. {
  799.     long         len;
  800.  
  801.     if (dirp->curr) {
  802.     /* first set up the structure to return */
  803.     len = strlen(dirp->curr);
  804.     strcpy(dirp->dirstr.d_name, dirp->curr);
  805.     dirp->dirstr.d_namlen = len;
  806.  
  807.     /* Fake an inode */
  808.     dirp->dirstr.d_ino = dirp->curr - dirp->start;
  809.  
  810.     /* Now set up for the next call to readdir */
  811.     dirp->curr += len + 1;
  812.     if (dirp->curr >= dirp->end) {
  813.         dTHXo;
  814.         char*        ptr;
  815.         BOOL        res;
  816.         WIN32_FIND_DATAW    wFindData;
  817.         WIN32_FIND_DATAA    aFindData;
  818.         char        buffer[MAX_PATH*2];
  819.  
  820.         /* finding the next file that matches the wildcard
  821.          * (which should be all of them in this directory!).
  822.          */
  823.         if (USING_WIDE()) {
  824.         res = FindNextFileW(dirp->handle, &wFindData);
  825.         if (res) {
  826.             W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer));
  827.             ptr = buffer;
  828.         }
  829.         }
  830.         else {
  831.         res = FindNextFileA(dirp->handle, &aFindData);
  832.         if (res)
  833.             ptr = aFindData.cFileName;
  834.         }
  835.         if (res) {
  836.         long endpos = dirp->end - dirp->start;
  837.         long newsize = endpos + strlen(ptr) + 1;
  838.         /* bump the string table size by enough for the
  839.          * new name and it's null terminator */
  840.         while (newsize > dirp->size) {
  841.             long curpos = dirp->curr - dirp->start;
  842.             dirp->size *= 2;
  843.             Renew(dirp->start, dirp->size, char);
  844.             dirp->curr = dirp->start + curpos;
  845.         }
  846.         strcpy(dirp->start + endpos, ptr);
  847.         dirp->end = dirp->start + newsize;
  848.         dirp->nfiles++;
  849.         }
  850.         else
  851.         dirp->curr = NULL;
  852.     }
  853.     return &(dirp->dirstr);
  854.     } 
  855.     else
  856.     return NULL;
  857. }
  858.  
  859. /* Telldir returns the current string pointer position */
  860. DllExport long
  861. win32_telldir(DIR *dirp)
  862. {
  863.     return (dirp->curr - dirp->start);
  864. }
  865.  
  866.  
  867. /* Seekdir moves the string pointer to a previously saved position
  868.  * (returned by telldir).
  869.  */
  870. DllExport void
  871. win32_seekdir(DIR *dirp, long loc)
  872. {
  873.     dirp->curr = dirp->start + loc;
  874. }
  875.  
  876. /* Rewinddir resets the string pointer to the start */
  877. DllExport void
  878. win32_rewinddir(DIR *dirp)
  879. {
  880.     dirp->curr = dirp->start;
  881. }
  882.  
  883. /* free the memory allocated by opendir */
  884. DllExport int
  885. win32_closedir(DIR *dirp)
  886. {
  887.     dTHXo;
  888.     if (dirp->handle != INVALID_HANDLE_VALUE)
  889.     FindClose(dirp->handle);
  890.     Safefree(dirp->start);
  891.     Safefree(dirp);
  892.     return 1;
  893. }
  894.  
  895.  
  896. /*
  897.  * various stubs
  898.  */
  899.  
  900.  
  901. /* Ownership
  902.  *
  903.  * Just pretend that everyone is a superuser. NT will let us know if
  904.  * we don\'t really have permission to do something.
  905.  */
  906.  
  907. #define ROOT_UID    ((uid_t)0)
  908. #define ROOT_GID    ((gid_t)0)
  909.  
  910. uid_t
  911. getuid(void)
  912. {
  913.     return ROOT_UID;
  914. }
  915.  
  916. uid_t
  917. geteuid(void)
  918. {
  919.     return ROOT_UID;
  920. }
  921.  
  922. gid_t
  923. getgid(void)
  924. {
  925.     return ROOT_GID;
  926. }
  927.  
  928. gid_t
  929. getegid(void)
  930. {
  931.     return ROOT_GID;
  932. }
  933.  
  934. int
  935. setuid(uid_t auid)
  936. { 
  937.     return (auid == ROOT_UID ? 0 : -1);
  938. }
  939.  
  940. int
  941. setgid(gid_t agid)
  942. {
  943.     return (agid == ROOT_GID ? 0 : -1);
  944. }
  945.  
  946. char *
  947. getlogin(void)
  948. {
  949.     dTHXo;
  950.     char *buf = w32_getlogin_buffer;
  951.     DWORD size = sizeof(w32_getlogin_buffer);
  952.     if (GetUserName(buf,&size))
  953.     return buf;
  954.     return (char*)NULL;
  955. }
  956.  
  957. int
  958. chown(const char *path, uid_t owner, gid_t group)
  959. {
  960.     /* XXX noop */
  961.     return 0;
  962. }
  963.  
  964. static long
  965. find_pid(int pid)
  966. {
  967.     dTHXo;
  968.     long child = w32_num_children;
  969.     while (--child >= 0) {
  970.     if (w32_child_pids[child] == pid)
  971.         return child;
  972.     }
  973.     return -1;
  974. }
  975.  
  976. static void
  977. remove_dead_process(long child)
  978. {
  979.     if (child >= 0) {
  980.     dTHXo;
  981.     CloseHandle(w32_child_handles[child]);
  982.     Move(&w32_child_handles[child+1], &w32_child_handles[child],
  983.          (w32_num_children-child-1), HANDLE);
  984.     Move(&w32_child_pids[child+1], &w32_child_pids[child],
  985.          (w32_num_children-child-1), DWORD);
  986.     w32_num_children--;
  987.     }
  988. }
  989.  
  990. #ifdef USE_ITHREADS
  991. static long
  992. find_pseudo_pid(int pid)
  993. {
  994.     dTHXo;
  995.     long child = w32_num_pseudo_children;
  996.     while (--child >= 0) {
  997.     if (w32_pseudo_child_pids[child] == pid)
  998.         return child;
  999.     }
  1000.     return -1;
  1001. }
  1002.  
  1003. static void
  1004. remove_dead_pseudo_process(long child)
  1005. {
  1006.     if (child >= 0) {
  1007.     dTHXo;
  1008.     CloseHandle(w32_pseudo_child_handles[child]);
  1009.     Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
  1010.          (w32_num_pseudo_children-child-1), HANDLE);
  1011.     Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
  1012.          (w32_num_pseudo_children-child-1), DWORD);
  1013.     w32_num_pseudo_children--;
  1014.     }
  1015. }
  1016. #endif
  1017.  
  1018. DllExport int
  1019. win32_kill(int pid, int sig)
  1020. {
  1021.     dTHXo;
  1022.     HANDLE hProcess;
  1023. #ifdef USE_ITHREADS
  1024.     if (pid < 0) {
  1025.     /* it is a pseudo-forked child */
  1026.     long child = find_pseudo_pid(-pid);
  1027.     if (child >= 0) {
  1028.         if (!sig)
  1029.         return 0;
  1030.         hProcess = w32_pseudo_child_handles[child];
  1031.         if (TerminateThread(hProcess, sig)) {
  1032.         remove_dead_pseudo_process(child);
  1033.         return 0;
  1034.         }
  1035.     }
  1036.     }
  1037.     else
  1038. #endif
  1039.     {
  1040.     long child = find_pid(pid);
  1041.     if (child >= 0) {
  1042.         if (!sig)
  1043.         return 0;
  1044.         hProcess = w32_child_handles[child];
  1045.         if (TerminateProcess(hProcess, sig)) {
  1046.         remove_dead_process(child);
  1047.         return 0;
  1048.         }
  1049.     }
  1050.     else {
  1051.         hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
  1052.         if (hProcess) {
  1053.         if (!sig)
  1054.             return 0;
  1055.         if (TerminateProcess(hProcess, sig)) {
  1056.             CloseHandle(hProcess);
  1057.             return 0;
  1058.         }
  1059.         }
  1060.     }
  1061.     }
  1062.     errno = EINVAL;
  1063.     return -1;
  1064. }
  1065.  
  1066. /*
  1067.  * File system stuff
  1068.  */
  1069.  
  1070. DllExport unsigned int
  1071. win32_sleep(unsigned int t)
  1072. {
  1073.     Sleep(t*1000);
  1074.     return 0;
  1075. }
  1076.  
  1077. DllExport int
  1078. win32_stat(const char *path, struct stat *sbuf)
  1079. {
  1080.     dTHXo;
  1081.     char    buffer[MAX_PATH+1]; 
  1082.     int        l = strlen(path);
  1083.     int        res;
  1084.     WCHAR    wbuffer[MAX_PATH+1];
  1085.     WCHAR*    pwbuffer;
  1086.     HANDLE      handle;
  1087.     int         nlink = 1;
  1088.  
  1089.     if (l > 1) {
  1090.     switch(path[l - 1]) {
  1091.     /* FindFirstFile() and stat() are buggy with a trailing
  1092.      * backslash, so change it to a forward slash :-( */
  1093.     case '\\':
  1094.         strncpy(buffer, path, l-1);
  1095.         buffer[l - 1] = '/';
  1096.         buffer[l] = '\0';
  1097.         path = buffer;
  1098.         break;
  1099.     /* FindFirstFile() is buggy with "x:", so add a dot :-( */
  1100.     case ':':
  1101.         if (l == 2 && isALPHA(path[0])) {
  1102.         buffer[0] = path[0];
  1103.         buffer[1] = ':';
  1104.         buffer[2] = '.';
  1105.         buffer[3] = '\0';
  1106.         l = 3;
  1107.         path = buffer;
  1108.         }
  1109.         break;
  1110.     }
  1111.     }
  1112.  
  1113.     /* We *must* open & close the file once; otherwise file attribute changes */
  1114.     /* might not yet have propagated to "other" hard links of the same file.  */
  1115.     /* This also gives us an opportunity to determine the number of links.    */
  1116.     if (USING_WIDE()) {
  1117.     A2WHELPER(path, wbuffer, sizeof(wbuffer));
  1118.     pwbuffer = PerlDir_mapW(wbuffer);
  1119.     handle = CreateFileW(pwbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
  1120.     }
  1121.     else {
  1122.     path = PerlDir_mapA(path);
  1123.     l = strlen(path);
  1124.     handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
  1125.     }
  1126.     if (handle != INVALID_HANDLE_VALUE) {
  1127.     BY_HANDLE_FILE_INFORMATION bhi;
  1128.     if (GetFileInformationByHandle(handle, &bhi))
  1129.         nlink = bhi.nNumberOfLinks;
  1130.     CloseHandle(handle);
  1131.     }
  1132.  
  1133.     /* pwbuffer or path will be mapped correctly above */
  1134.     if (USING_WIDE()) {
  1135.     res = _wstat(pwbuffer, (struct _stat *)sbuf);
  1136.     }
  1137.     else {
  1138.     res = stat(path, sbuf);
  1139.     }
  1140.     sbuf->st_nlink = nlink;
  1141.  
  1142.     if (res < 0) {
  1143.     /* CRT is buggy on sharenames, so make sure it really isn't.
  1144.      * XXX using GetFileAttributesEx() will enable us to set
  1145.      * sbuf->st_*time (but note that's not available on the
  1146.      * Windows of 1995) */
  1147.     DWORD r;
  1148.     if (USING_WIDE()) {
  1149.         r = GetFileAttributesW(pwbuffer);
  1150.     }
  1151.     else {
  1152.         r = GetFileAttributesA(path);
  1153.     }
  1154.     if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
  1155.         /* sbuf may still contain old garbage since stat() failed */
  1156.         Zero(sbuf, 1, struct stat);
  1157.         sbuf->st_mode = S_IFDIR | S_IREAD;
  1158.         errno = 0;
  1159.         if (!(r & FILE_ATTRIBUTE_READONLY))
  1160.         sbuf->st_mode |= S_IWRITE | S_IEXEC;
  1161.         return 0;
  1162.     }
  1163.     }
  1164.     else {
  1165.     if (l == 3 && isALPHA(path[0]) && path[1] == ':'
  1166.         && (path[2] == '\\' || path[2] == '/'))
  1167.     {
  1168.         /* The drive can be inaccessible, some _stat()s are buggy */
  1169.         if (USING_WIDE()
  1170.         ? !GetVolumeInformationW(pwbuffer,NULL,0,NULL,NULL,NULL,NULL,0)
  1171.         : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
  1172.         errno = ENOENT;
  1173.         return -1;
  1174.         }
  1175.     }
  1176. #ifdef __BORLANDC__
  1177.     if (S_ISDIR(sbuf->st_mode))
  1178.         sbuf->st_mode |= S_IWRITE | S_IEXEC;
  1179.     else if (S_ISREG(sbuf->st_mode)) {
  1180.         int perms;
  1181.         if (l >= 4 && path[l-4] == '.') {
  1182.         const char *e = path + l - 3;
  1183.         if (strnicmp(e,"exe",3)
  1184.             && strnicmp(e,"bat",3)
  1185.             && strnicmp(e,"com",3)
  1186.             && (IsWin95() || strnicmp(e,"cmd",3)))
  1187.             sbuf->st_mode &= ~S_IEXEC;
  1188.         else
  1189.             sbuf->st_mode |= S_IEXEC;
  1190.         }
  1191.         else
  1192.         sbuf->st_mode &= ~S_IEXEC;
  1193.         /* Propagate permissions to _group_ and _others_ */
  1194.         perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC);
  1195.         sbuf->st_mode |= (perms>>3) | (perms>>6);
  1196.     }
  1197. #endif
  1198.     }
  1199.     return res;
  1200. }
  1201.  
  1202. /* Find the longname of a given path.  path is destructively modified.
  1203.  * It should have space for at least MAX_PATH characters. */
  1204. DllExport char *
  1205. win32_longpath(char *path)
  1206. {
  1207.     WIN32_FIND_DATA fdata;
  1208.     HANDLE fhand;
  1209.     char tmpbuf[MAX_PATH+1];
  1210.     char *tmpstart = tmpbuf;
  1211.     char *start = path;
  1212.     char sep;
  1213.     if (!path)
  1214.     return Nullch;
  1215.  
  1216.     /* drive prefix */
  1217.     if (isALPHA(path[0]) && path[1] == ':' &&
  1218.     (path[2] == '/' || path[2] == '\\'))
  1219.     {
  1220.     start = path + 2;
  1221.     *tmpstart++ = path[0];
  1222.     *tmpstart++ = ':';
  1223.     }
  1224.     /* UNC prefix */
  1225.     else if ((path[0] == '/' || path[0] == '\\') &&
  1226.          (path[1] == '/' || path[1] == '\\'))
  1227.     {
  1228.     start = path + 2;
  1229.     *tmpstart++ = path[0];
  1230.     *tmpstart++ = path[1];
  1231.     /* copy machine name */
  1232.     while (*start && *start != '/' && *start != '\\')
  1233.         *tmpstart++ = *start++;
  1234.     if (*start) {
  1235.         *tmpstart++ = *start;
  1236.         start++;
  1237.         /* copy share name */
  1238.         while (*start && *start != '/' && *start != '\\')
  1239.         *tmpstart++ = *start++;
  1240.     }
  1241.     }
  1242.     sep = *start++;
  1243.     if (sep == '/' || sep == '\\')
  1244.     *tmpstart++ = sep;
  1245.     *tmpstart = '\0';
  1246.     while (sep) {
  1247.     /* walk up to slash */
  1248.     while (*start && *start != '/' && *start != '\\')
  1249.         ++start;
  1250.  
  1251.     /* discard doubled slashes */
  1252.     while (*start && (start[1] == '/' || start[1] == '\\'))
  1253.         ++start;
  1254.     sep = *start;
  1255.  
  1256.     /* stop and find full name of component */
  1257.     *start = '\0';
  1258.     fhand = FindFirstFile(path,&fdata);
  1259.     if (fhand != INVALID_HANDLE_VALUE) {
  1260.         strcpy(tmpstart, fdata.cFileName);
  1261.         tmpstart += strlen(fdata.cFileName);
  1262.         if (sep)
  1263.         *tmpstart++ = sep;
  1264.         *tmpstart = '\0';
  1265.         *start++ = sep;
  1266.         FindClose(fhand);
  1267.     }
  1268.     else {
  1269.         /* failed a step, just return without side effects */
  1270.         /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
  1271.         *start = sep;
  1272.         return Nullch;
  1273.     }
  1274.     }
  1275.     strcpy(path,tmpbuf);
  1276.     return path;
  1277. }
  1278.  
  1279. #ifndef USE_WIN32_RTL_ENV
  1280.  
  1281. DllExport char *
  1282. win32_getenv(const char *name)
  1283. {
  1284.     dTHXo;
  1285.     WCHAR wBuffer[MAX_PATH+1];
  1286.     DWORD needlen;
  1287.     SV *curitem = Nullsv;
  1288.  
  1289.     if (USING_WIDE()) {
  1290.     A2WHELPER(name, wBuffer, sizeof(wBuffer));
  1291.     needlen = GetEnvironmentVariableW(wBuffer, NULL, 0);
  1292.     }
  1293.     else
  1294.     needlen = GetEnvironmentVariableA(name,NULL,0);
  1295.     if (needlen != 0) {
  1296.     curitem = sv_2mortal(newSVpvn("", 0));
  1297.     if (USING_WIDE()) {
  1298.         SV *acuritem;
  1299.         do {
  1300.         SvGROW(curitem, (needlen+1)*sizeof(WCHAR));
  1301.         needlen = GetEnvironmentVariableW(wBuffer,
  1302.                           (WCHAR*)SvPVX(curitem),
  1303.                           needlen);
  1304.         } while (needlen >= SvLEN(curitem)/sizeof(WCHAR));
  1305.         SvCUR_set(curitem, (needlen*sizeof(WCHAR))+1);
  1306.         acuritem = sv_2mortal(newSVsv(curitem));
  1307.         W2AHELPER((WCHAR*)SvPVX(acuritem), SvPVX(curitem), SvCUR(curitem));
  1308.     }
  1309.     else {
  1310.         do {
  1311.         SvGROW(curitem, needlen+1);
  1312.         needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
  1313.                           needlen);
  1314.         } while (needlen >= SvLEN(curitem));
  1315.         SvCUR_set(curitem, needlen);
  1316.     }
  1317.     }
  1318.     else {
  1319.     /* allow any environment variables that begin with 'PERL'
  1320.        to be stored in the registry */
  1321.     if (strncmp(name, "PERL", 4) == 0)
  1322.         (void)get_regstr(name, &curitem);
  1323.     }
  1324.     if (curitem && SvCUR(curitem))
  1325.     return SvPVX(curitem);
  1326.  
  1327.     return Nullch;
  1328. }
  1329.  
  1330. DllExport int
  1331. win32_putenv(const char *name)
  1332. {
  1333.     dTHXo;
  1334.     char* curitem;
  1335.     char* val;
  1336.     WCHAR* wCuritem;
  1337.     WCHAR* wVal;
  1338.     int length, relval = -1;
  1339.  
  1340.     if (name) {
  1341.     if (USING_WIDE()) {
  1342.         length = strlen(name)+1;
  1343.         New(1309,wCuritem,length,WCHAR);
  1344.         A2WHELPER(name, wCuritem, length*sizeof(WCHAR));
  1345.         wVal = wcschr(wCuritem, '=');
  1346.         if (wVal) {
  1347.         *wVal++ = '\0';
  1348.         if (SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
  1349.             relval = 0;
  1350.         }
  1351.         Safefree(wCuritem);
  1352.     }
  1353.     else {
  1354.         New(1309,curitem,strlen(name)+1,char);
  1355.         strcpy(curitem, name);
  1356.         val = strchr(curitem, '=');
  1357.         if (val) {
  1358.         /* The sane way to deal with the environment.
  1359.          * Has these advantages over putenv() & co.:
  1360.          *  * enables us to store a truly empty value in the
  1361.          *    environment (like in UNIX).
  1362.          *  * we don't have to deal with RTL globals, bugs and leaks.
  1363.          *  * Much faster.
  1364.          * Why you may want to enable USE_WIN32_RTL_ENV:
  1365.          *  * environ[] and RTL functions will not reflect changes,
  1366.          *    which might be an issue if extensions want to access
  1367.          *    the env. via RTL.  This cuts both ways, since RTL will
  1368.          *    not see changes made by extensions that call the Win32
  1369.          *    functions directly, either.
  1370.          * GSAR 97-06-07
  1371.          */
  1372.         *val++ = '\0';
  1373.         if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
  1374.             relval = 0;
  1375.         }
  1376.         Safefree(curitem);
  1377.     }
  1378.     }
  1379.     return relval;
  1380. }
  1381.  
  1382. #endif
  1383.  
  1384. static long
  1385. filetime_to_clock(PFILETIME ft)
  1386. {
  1387.     __int64 qw = ft->dwHighDateTime;
  1388.     qw <<= 32;
  1389.     qw |= ft->dwLowDateTime;
  1390.     qw /= 10000;  /* File time ticks at 0.1uS, clock at 1mS */
  1391.     return (long) qw;
  1392. }
  1393.  
  1394. DllExport int
  1395. win32_times(struct tms *timebuf)
  1396. {
  1397.     FILETIME user;
  1398.     FILETIME kernel;
  1399.     FILETIME dummy;
  1400.     if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, 
  1401.                         &kernel,&user)) {
  1402.     timebuf->tms_utime = filetime_to_clock(&user);
  1403.     timebuf->tms_stime = filetime_to_clock(&kernel);
  1404.     timebuf->tms_cutime = 0;
  1405.     timebuf->tms_cstime = 0;
  1406.         
  1407.     } else { 
  1408.         /* That failed - e.g. Win95 fallback to clock() */
  1409.         clock_t t = clock();
  1410.     timebuf->tms_utime = t;
  1411.     timebuf->tms_stime = 0;
  1412.     timebuf->tms_cutime = 0;
  1413.     timebuf->tms_cstime = 0;
  1414.     }
  1415.     return 0;
  1416. }
  1417.  
  1418. /* fix utime() so it works on directories in NT */
  1419. static BOOL
  1420. filetime_from_time(PFILETIME pFileTime, time_t Time)
  1421. {
  1422.     struct tm *pTM = localtime(&Time);
  1423.     SYSTEMTIME SystemTime;
  1424.     FILETIME LocalTime;
  1425.  
  1426.     if (pTM == NULL)
  1427.     return FALSE;
  1428.  
  1429.     SystemTime.wYear   = pTM->tm_year + 1900;
  1430.     SystemTime.wMonth  = pTM->tm_mon + 1;
  1431.     SystemTime.wDay    = pTM->tm_mday;
  1432.     SystemTime.wHour   = pTM->tm_hour;
  1433.     SystemTime.wMinute = pTM->tm_min;
  1434.     SystemTime.wSecond = pTM->tm_sec;
  1435.     SystemTime.wMilliseconds = 0;
  1436.  
  1437.     return SystemTimeToFileTime(&SystemTime, &LocalTime) &&
  1438.            LocalFileTimeToFileTime(&LocalTime, pFileTime);
  1439. }
  1440.  
  1441. DllExport int
  1442. win32_unlink(const char *filename)
  1443. {
  1444.     dTHXo;
  1445.     int ret;
  1446.     DWORD attrs;
  1447.  
  1448.     if (USING_WIDE()) {
  1449.     WCHAR wBuffer[MAX_PATH+1];
  1450.     WCHAR* pwBuffer;
  1451.  
  1452.     A2WHELPER(filename, wBuffer, sizeof(wBuffer));
  1453.     pwBuffer = PerlDir_mapW(wBuffer);
  1454.     attrs = GetFileAttributesW(pwBuffer);
  1455.     if (attrs == 0xFFFFFFFF)
  1456.         goto fail;
  1457.     if (attrs & FILE_ATTRIBUTE_READONLY) {
  1458.         (void)SetFileAttributesW(pwBuffer, attrs & ~FILE_ATTRIBUTE_READONLY);
  1459.         ret = _wunlink(pwBuffer);
  1460.         if (ret == -1)
  1461.         (void)SetFileAttributesW(pwBuffer, attrs);
  1462.     }
  1463.     else
  1464.         ret = _wunlink(pwBuffer);
  1465.     }
  1466.     else {
  1467.     filename = PerlDir_mapA(filename);
  1468.     attrs = GetFileAttributesA(filename);
  1469.     if (attrs == 0xFFFFFFFF)
  1470.         goto fail;
  1471.     if (attrs & FILE_ATTRIBUTE_READONLY) {
  1472.         (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
  1473.         ret = unlink(filename);
  1474.         if (ret == -1)
  1475.         (void)SetFileAttributesA(filename, attrs);
  1476.     }
  1477.     else
  1478.         ret = unlink(filename);
  1479.     }
  1480.     return ret;
  1481. fail:
  1482.     errno = ENOENT;
  1483.     return -1;
  1484. }
  1485.  
  1486. DllExport int
  1487. win32_utime(const char *filename, struct utimbuf *times)
  1488. {
  1489.     dTHXo;
  1490.     HANDLE handle;
  1491.     FILETIME ftCreate;
  1492.     FILETIME ftAccess;
  1493.     FILETIME ftWrite;
  1494.     struct utimbuf TimeBuffer;
  1495.     WCHAR wbuffer[MAX_PATH+1];
  1496.     WCHAR* pwbuffer;
  1497.  
  1498.     int rc;
  1499.     if (USING_WIDE()) {
  1500.     A2WHELPER(filename, wbuffer, sizeof(wbuffer));
  1501.     pwbuffer = PerlDir_mapW(wbuffer);
  1502.     rc = _wutime(pwbuffer, (struct _utimbuf*)times);
  1503.     }
  1504.     else {
  1505.     filename = PerlDir_mapA(filename);
  1506.     rc = utime(filename, times);
  1507.     }
  1508.     /* EACCES: path specifies directory or readonly file */
  1509.     if (rc == 0 || errno != EACCES /* || !IsWinNT() */)
  1510.     return rc;
  1511.  
  1512.     if (times == NULL) {
  1513.     times = &TimeBuffer;
  1514.     time(×->actime);
  1515.     times->modtime = times->actime;
  1516.     }
  1517.  
  1518.     /* This will (and should) still fail on readonly files */
  1519.     if (USING_WIDE()) {
  1520.     handle = CreateFileW(pwbuffer, GENERIC_READ | GENERIC_WRITE,
  1521.                 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
  1522.                 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
  1523.     }
  1524.     else {
  1525.     handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE,
  1526.                 FILE_SHARE_READ | FILE_SHARE_DELETE, NULL,
  1527.                 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
  1528.     }
  1529.     if (handle == INVALID_HANDLE_VALUE)
  1530.     return rc;
  1531.  
  1532.     if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) &&
  1533.     filetime_from_time(&ftAccess, times->actime) &&
  1534.     filetime_from_time(&ftWrite, times->modtime) &&
  1535.     SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite))
  1536.     {
  1537.     rc = 0;
  1538.     }
  1539.  
  1540.     CloseHandle(handle);
  1541.     return rc;
  1542. }
  1543.  
  1544. DllExport int
  1545. win32_uname(struct utsname *name)
  1546. {
  1547.     struct hostent *hep;
  1548.     STRLEN nodemax = sizeof(name->nodename)-1;
  1549.     OSVERSIONINFO osver;
  1550.  
  1551.     memset(&osver, 0, sizeof(OSVERSIONINFO));
  1552.     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  1553.     if (GetVersionEx(&osver)) {
  1554.     /* sysname */
  1555.     switch (osver.dwPlatformId) {
  1556.     case VER_PLATFORM_WIN32_WINDOWS:
  1557.         strcpy(name->sysname, "Windows");
  1558.         break;
  1559.     case VER_PLATFORM_WIN32_NT:
  1560.         strcpy(name->sysname, "Windows NT");
  1561.         break;
  1562.     case VER_PLATFORM_WIN32s:
  1563.         strcpy(name->sysname, "Win32s");
  1564.         break;
  1565.     default:
  1566.         strcpy(name->sysname, "Win32 Unknown");
  1567.         break;
  1568.     }
  1569.  
  1570.     /* release */
  1571.     sprintf(name->release, "%d.%d",
  1572.         osver.dwMajorVersion, osver.dwMinorVersion);
  1573.  
  1574.     /* version */
  1575.     sprintf(name->version, "Build %d",
  1576.         osver.dwPlatformId == VER_PLATFORM_WIN32_NT
  1577.         ? osver.dwBuildNumber : (osver.dwBuildNumber & 0xffff));
  1578.     if (osver.szCSDVersion[0]) {
  1579.         char *buf = name->version + strlen(name->version);
  1580.         sprintf(buf, " (%s)", osver.szCSDVersion);
  1581.     }
  1582.     }
  1583.     else {
  1584.     *name->sysname = '\0';
  1585.     *name->version = '\0';
  1586.     *name->release = '\0';
  1587.     }
  1588.  
  1589.     /* nodename */
  1590.     hep = win32_gethostbyname("localhost");
  1591.     if (hep) {
  1592.     STRLEN len = strlen(hep->h_name);
  1593.     if (len <= nodemax) {
  1594.         strcpy(name->nodename, hep->h_name);
  1595.     }
  1596.     else {
  1597.         strncpy(name->nodename, hep->h_name, nodemax);
  1598.         name->nodename[nodemax] = '\0';
  1599.     }
  1600.     }
  1601.     else {
  1602.     DWORD sz = nodemax;
  1603.     if (!GetComputerName(name->nodename, &sz))
  1604.         *name->nodename = '\0';
  1605.     }
  1606.  
  1607.     /* machine (architecture) */
  1608.     {
  1609.     SYSTEM_INFO info;
  1610.     char *arch;
  1611.     GetSystemInfo(&info);
  1612.  
  1613. #if defined(__BORLANDC__) || defined(__MINGW32__)
  1614.     switch (info.u.s.wProcessorArchitecture) {
  1615. #else
  1616.     switch (info.wProcessorArchitecture) {
  1617. #endif
  1618.     case PROCESSOR_ARCHITECTURE_INTEL:
  1619.         arch = "x86"; break;
  1620.     case PROCESSOR_ARCHITECTURE_MIPS:
  1621.         arch = "mips"; break;
  1622.     case PROCESSOR_ARCHITECTURE_ALPHA:
  1623.         arch = "alpha"; break;
  1624.     case PROCESSOR_ARCHITECTURE_PPC:
  1625.         arch = "ppc"; break;
  1626.     default:
  1627.         arch = "unknown"; break;
  1628.     }
  1629.     strcpy(name->machine, arch);
  1630.     }
  1631.     return 0;
  1632. }
  1633.  
  1634. DllExport int
  1635. win32_waitpid(int pid, int *status, int flags)
  1636. {
  1637.     dTHXo;
  1638.     int retval = -1;
  1639.     if (pid == -1)                /* XXX threadid == 1 ? */
  1640.     return win32_wait(status);
  1641. #ifdef USE_ITHREADS
  1642.     else if (pid < 0) {
  1643.     long child = find_pseudo_pid(-pid);
  1644.     if (child >= 0) {
  1645.         HANDLE hThread = w32_pseudo_child_handles[child];
  1646.         DWORD waitcode = WaitForSingleObject(hThread, INFINITE);
  1647.         if (waitcode != WAIT_FAILED) {
  1648.         if (GetExitCodeThread(hThread, &waitcode)) {
  1649.             *status = (int)((waitcode & 0xff) << 8);
  1650.             retval = (int)w32_pseudo_child_pids[child];
  1651.             remove_dead_pseudo_process(child);
  1652.             return retval;
  1653.         }
  1654.         }
  1655.         else
  1656.         errno = ECHILD;
  1657.     }
  1658.     }
  1659. #endif
  1660.     else {
  1661.     long child = find_pid(pid);
  1662.     if (child >= 0) {
  1663.         HANDLE hProcess = w32_child_handles[child];
  1664.         DWORD waitcode = WaitForSingleObject(hProcess, INFINITE);
  1665.         if (waitcode != WAIT_FAILED) {
  1666.         if (GetExitCodeProcess(hProcess, &waitcode)) {
  1667.             *status = (int)((waitcode & 0xff) << 8);
  1668.             retval = (int)w32_child_pids[child];
  1669.             remove_dead_process(child);
  1670.             return retval;
  1671.         }
  1672.         }
  1673.         else
  1674.         errno = ECHILD;
  1675.     }
  1676.     else {
  1677.         retval = cwait(status, pid, WAIT_CHILD);
  1678.         /* cwait() returns "correctly" on Borland */
  1679. #ifndef __BORLANDC__
  1680.         if (status)
  1681.         *status *= 256;
  1682. #endif
  1683.     }
  1684.     }
  1685.     return retval >= 0 ? pid : retval;                
  1686. }
  1687.  
  1688. DllExport int
  1689. win32_wait(int *status)
  1690. {
  1691.     /* XXX this wait emulation only knows about processes
  1692.      * spawned via win32_spawnvp(P_NOWAIT, ...).
  1693.      */
  1694.     dTHXo;
  1695.     int i, retval;
  1696.     DWORD exitcode, waitcode;
  1697.  
  1698. #ifdef USE_ITHREADS
  1699.     if (w32_num_pseudo_children) {
  1700.     waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
  1701.                       w32_pseudo_child_handles,
  1702.                       FALSE,
  1703.                       INFINITE);
  1704.     if (waitcode != WAIT_FAILED) {
  1705.         if (waitcode >= WAIT_ABANDONED_0
  1706.         && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
  1707.         i = waitcode - WAIT_ABANDONED_0;
  1708.         else
  1709.         i = waitcode - WAIT_OBJECT_0;
  1710.         if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
  1711.         *status = (int)((exitcode & 0xff) << 8);
  1712.         retval = (int)w32_pseudo_child_pids[i];
  1713.         remove_dead_pseudo_process(i);
  1714.         return retval;
  1715.         }
  1716.     }
  1717.     }
  1718. #endif
  1719.  
  1720.     if (!w32_num_children) {
  1721.     errno = ECHILD;
  1722.     return -1;
  1723.     }
  1724.  
  1725.     /* if a child exists, wait for it to die */
  1726.     waitcode = WaitForMultipleObjects(w32_num_children,
  1727.                       w32_child_handles,
  1728.                       FALSE,
  1729.                       INFINITE);
  1730.     if (waitcode != WAIT_FAILED) {
  1731.     if (waitcode >= WAIT_ABANDONED_0
  1732.         && waitcode < WAIT_ABANDONED_0 + w32_num_children)
  1733.         i = waitcode - WAIT_ABANDONED_0;
  1734.     else
  1735.         i = waitcode - WAIT_OBJECT_0;
  1736.     if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
  1737.         *status = (int)((exitcode & 0xff) << 8);
  1738.         retval = (int)w32_child_pids[i];
  1739.         remove_dead_process(i);
  1740.         return retval;
  1741.     }
  1742.     }
  1743.  
  1744. FAILED:
  1745.     errno = GetLastError();
  1746.     return -1;
  1747. }
  1748.  
  1749. #ifndef PERL_OBJECT
  1750.  
  1751. static UINT timerid = 0;
  1752.  
  1753. static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
  1754. {
  1755.     dTHXo;
  1756.     KillTimer(NULL,timerid);
  1757.     timerid=0;  
  1758.     sighandler(14);
  1759. }
  1760. #endif    /* !PERL_OBJECT */
  1761.  
  1762. DllExport unsigned int
  1763. win32_alarm(unsigned int sec)
  1764. {
  1765. #ifndef PERL_OBJECT
  1766.     /* 
  1767.      * the 'obvious' implentation is SetTimer() with a callback
  1768.      * which does whatever receiving SIGALRM would do 
  1769.      * we cannot use SIGALRM even via raise() as it is not 
  1770.      * one of the supported codes in <signal.h>
  1771.      *
  1772.      * Snag is unless something is looking at the message queue
  1773.      * nothing happens :-(
  1774.      */ 
  1775.     dTHXo;
  1776.     if (sec)
  1777.      {
  1778.       timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
  1779.       if (!timerid)
  1780.        Perl_croak_nocontext("Cannot set timer");
  1781.      } 
  1782.     else
  1783.      {
  1784.       if (timerid)
  1785.        {
  1786.         KillTimer(NULL,timerid);
  1787.         timerid=0;  
  1788.        }
  1789.      }
  1790. #endif    /* !PERL_OBJECT */
  1791.     return 0;
  1792. }
  1793.  
  1794. #ifdef HAVE_DES_FCRYPT
  1795. extern char *    des_fcrypt(const char *txt, const char *salt, char *cbuf);
  1796. #endif
  1797.  
  1798. DllExport char *
  1799. win32_crypt(const char *txt, const char *salt)
  1800. {
  1801.     dTHXo;
  1802. #ifdef HAVE_DES_FCRYPT
  1803.     dTHR;
  1804.     return des_fcrypt(txt, salt, w32_crypt_buffer);
  1805. #else
  1806.     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
  1807.     return Nullch;
  1808. #endif
  1809. }
  1810.  
  1811. /* C doesn't like repeat struct definitions */
  1812.  
  1813. #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
  1814.  
  1815. #ifndef _CRTIMP
  1816. #define _CRTIMP __declspec(dllimport)
  1817. #endif
  1818.  
  1819. /*
  1820.  * Control structure for lowio file handles
  1821.  */
  1822. typedef struct {
  1823.     long osfhnd;    /* underlying OS file HANDLE */
  1824.     char osfile;    /* attributes of file (e.g., open in text mode?) */
  1825.     char pipech;    /* one char buffer for handles opened on pipes */
  1826.     int lockinitflag;
  1827.     CRITICAL_SECTION lock;
  1828. } ioinfo;
  1829.  
  1830.  
  1831. /*
  1832.  * Array of arrays of control structures for lowio files.
  1833.  */
  1834. EXTERN_C _CRTIMP ioinfo* __pioinfo[];
  1835.  
  1836. /*
  1837.  * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
  1838.  * array of ioinfo structs.
  1839.  */
  1840. #define IOINFO_L2E        5
  1841.  
  1842. /*
  1843.  * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
  1844.  */
  1845. #define IOINFO_ARRAY_ELTS   (1 << IOINFO_L2E)
  1846.  
  1847. /*
  1848.  * Access macros for getting at an ioinfo struct and its fields from a
  1849.  * file handle
  1850.  */
  1851. #define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
  1852. #define _osfhnd(i)  (_pioinfo(i)->osfhnd)
  1853. #define _osfile(i)  (_pioinfo(i)->osfile)
  1854. #define _pipech(i)  (_pioinfo(i)->pipech)
  1855.  
  1856. #endif
  1857.  
  1858. #ifdef USE_FIXED_OSFHANDLE
  1859.  
  1860. #define FOPEN            0x01    /* file handle open */
  1861. #define FNOINHERIT        0x10    /* file handle opened O_NOINHERIT */
  1862. #define FAPPEND            0x20    /* file handle opened O_APPEND */
  1863. #define FDEV            0x40    /* file handle refers to device */
  1864. #define FTEXT            0x80    /* file handle is in text mode */
  1865.  
  1866. /***
  1867. *int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle
  1868. *
  1869. *Purpose:
  1870. *       This function allocates a free C Runtime file handle and associates
  1871. *       it with the Win32 HANDLE specified by the first parameter. This is a
  1872. *    temperary fix for WIN95's brain damage GetFileType() error on socket
  1873. *    we just bypass that call for socket
  1874. *
  1875. *    This works with MSVC++ 4.0+ or GCC/Mingw32
  1876. *
  1877. *Entry:
  1878. *       long osfhandle - Win32 HANDLE to associate with C Runtime file handle.
  1879. *       int flags      - flags to associate with C Runtime file handle.
  1880. *
  1881. *Exit:
  1882. *       returns index of entry in fh, if successful
  1883. *       return -1, if no free entry is found
  1884. *
  1885. *Exceptions:
  1886. *
  1887. *******************************************************************************/
  1888.  
  1889. /*
  1890.  * we fake up some parts of the CRT that aren't exported by MSVCRT.dll
  1891.  * this lets sockets work on Win9X with GCC and should fix the problems
  1892.  * with perl95.exe
  1893.  *    -- BKS, 1-23-2000
  1894. */
  1895.  
  1896. /* since we are not doing a dup2(), this works fine */
  1897.  
  1898. #define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = osfh)
  1899.  
  1900. /* create an ioinfo entry, kill its handle, and steal the entry */
  1901.  
  1902. static int
  1903. _alloc_osfhnd(void)
  1904. {
  1905.     HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL);
  1906.     int fh = _open_osfhandle((long)hF, 0);
  1907.     CloseHandle(hF);
  1908.     if (fh == -1)
  1909.         return fh;
  1910.     EnterCriticalSection(&(_pioinfo(fh)->lock));
  1911.     return fh;
  1912. }
  1913.  
  1914. static int
  1915. my_open_osfhandle(long osfhandle, int flags)
  1916. {
  1917.     int fh;
  1918.     char fileflags;        /* _osfile flags */
  1919.  
  1920.     /* copy relevant flags from second parameter */
  1921.     fileflags = FDEV;
  1922.  
  1923.     if (flags & O_APPEND)
  1924.     fileflags |= FAPPEND;
  1925.  
  1926.     if (flags & O_TEXT)
  1927.     fileflags |= FTEXT;
  1928.  
  1929.     if (flags & O_NOINHERIT)
  1930.     fileflags |= FNOINHERIT;
  1931.  
  1932.     /* attempt to allocate a C Runtime file handle */
  1933.     if ((fh = _alloc_osfhnd()) == -1) {
  1934.     errno = EMFILE;        /* too many open files */
  1935.     _doserrno = 0L;        /* not an OS error */
  1936.     return -1;        /* return error to caller */
  1937.     }
  1938.  
  1939.     /* the file is open. now, set the info in _osfhnd array */
  1940.     _set_osfhnd(fh, osfhandle);
  1941.  
  1942.     fileflags |= FOPEN;        /* mark as open */
  1943.  
  1944.     _osfile(fh) = fileflags;    /* set osfile entry */
  1945.     LeaveCriticalSection(&_pioinfo(fh)->lock);
  1946.  
  1947.     return fh;            /* return handle */
  1948. }
  1949.  
  1950. #endif    /* USE_FIXED_OSFHANDLE */
  1951.  
  1952. /* simulate flock by locking a range on the file */
  1953.  
  1954. #define LK_ERR(f,i)    ((f) ? (i = 0) : (errno = GetLastError()))
  1955. #define LK_LEN        0xffff0000
  1956.  
  1957. DllExport int
  1958. win32_flock(int fd, int oper)
  1959. {
  1960.     OVERLAPPED o;
  1961.     int i = -1;
  1962.     HANDLE fh;
  1963.  
  1964.     if (!IsWinNT()) {
  1965.     dTHXo;
  1966.     Perl_croak_nocontext("flock() unimplemented on this platform");
  1967.     return -1;
  1968.     }
  1969.     fh = (HANDLE)_get_osfhandle(fd);
  1970.     memset(&o, 0, sizeof(o));
  1971.  
  1972.     switch(oper) {
  1973.     case LOCK_SH:        /* shared lock */
  1974.     LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
  1975.     break;
  1976.     case LOCK_EX:        /* exclusive lock */
  1977.     LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
  1978.     break;
  1979.     case LOCK_SH|LOCK_NB:    /* non-blocking shared lock */
  1980.     LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
  1981.     break;
  1982.     case LOCK_EX|LOCK_NB:    /* non-blocking exclusive lock */
  1983.     LK_ERR(LockFileEx(fh,
  1984.                LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
  1985.                0, LK_LEN, 0, &o),i);
  1986.     break;
  1987.     case LOCK_UN:        /* unlock lock */
  1988.     LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
  1989.     break;
  1990.     default:            /* unknown */
  1991.     errno = EINVAL;
  1992.     break;
  1993.     }
  1994.     return i;
  1995. }
  1996.  
  1997. #undef LK_ERR
  1998. #undef LK_LEN
  1999.  
  2000. /*
  2001.  *  redirected io subsystem for all XS modules
  2002.  *
  2003.  */
  2004.  
  2005. DllExport int *
  2006. win32_errno(void)
  2007. {
  2008.     return (&errno);
  2009. }
  2010.  
  2011. DllExport char ***
  2012. win32_environ(void)
  2013. {
  2014.     return (&(_environ));
  2015. }
  2016.  
  2017. /* the rest are the remapped stdio routines */
  2018. DllExport FILE *
  2019. win32_stderr(void)
  2020. {
  2021.     return (stderr);
  2022. }
  2023.  
  2024. DllExport FILE *
  2025. win32_stdin(void)
  2026. {
  2027.     return (stdin);
  2028. }
  2029.  
  2030. DllExport FILE *
  2031. win32_stdout()
  2032. {
  2033.     return (stdout);
  2034. }
  2035.  
  2036. DllExport int
  2037. win32_ferror(FILE *fp)
  2038. {
  2039.     return (ferror(fp));
  2040. }
  2041.  
  2042.  
  2043. DllExport int
  2044. win32_feof(FILE *fp)
  2045. {
  2046.     return (feof(fp));
  2047. }
  2048.  
  2049. /*
  2050.  * Since the errors returned by the socket error function 
  2051.  * WSAGetLastError() are not known by the library routine strerror
  2052.  * we have to roll our own.
  2053.  */
  2054.  
  2055. DllExport char *
  2056. win32_strerror(int e) 
  2057. {
  2058. #ifndef __BORLANDC__        /* Borland intolerance */
  2059.     extern int sys_nerr;
  2060. #endif
  2061.     DWORD source = 0;
  2062.  
  2063.     if (e < 0 || e > sys_nerr) {
  2064.         dTHXo;
  2065.     if (e < 0)
  2066.         e = GetLastError();
  2067.  
  2068.     if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
  2069.               w32_strerror_buffer,
  2070.               sizeof(w32_strerror_buffer), NULL) == 0) 
  2071.         strcpy(w32_strerror_buffer, "Unknown Error");
  2072.  
  2073.     return w32_strerror_buffer;
  2074.     }
  2075.     return strerror(e);
  2076. }
  2077.  
  2078. DllExport void
  2079. win32_str_os_error(void *sv, DWORD dwErr)
  2080. {
  2081.     DWORD dwLen;
  2082.     char *sMsg;
  2083.     dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
  2084.               |FORMAT_MESSAGE_IGNORE_INSERTS
  2085.               |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
  2086.                dwErr, 0, (char *)&sMsg, 1, NULL);
  2087.     /* strip trailing whitespace and period */
  2088.     if (0 < dwLen) {
  2089.     do {
  2090.         --dwLen;    /* dwLen doesn't include trailing null */
  2091.     } while (0 < dwLen && isSPACE(sMsg[dwLen]));
  2092.     if ('.' != sMsg[dwLen])
  2093.         dwLen++;
  2094.     sMsg[dwLen] = '\0';
  2095.     }
  2096.     if (0 == dwLen) {
  2097.     sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
  2098.     if (sMsg)
  2099.         dwLen = sprintf(sMsg,
  2100.                 "Unknown error #0x%lX (lookup 0x%lX)",
  2101.                 dwErr, GetLastError());
  2102.     }
  2103.     if (sMsg) {
  2104.     dTHXo;
  2105.     sv_setpvn((SV*)sv, sMsg, dwLen);
  2106.     LocalFree(sMsg);
  2107.     }
  2108. }
  2109.  
  2110.  
  2111. DllExport int
  2112. win32_fprintf(FILE *fp, const char *format, ...)
  2113. {
  2114.     va_list marker;
  2115.     va_start(marker, format);     /* Initialize variable arguments. */
  2116.  
  2117.     return (vfprintf(fp, format, marker));
  2118. }
  2119.  
  2120. DllExport int
  2121. win32_printf(const char *format, ...)
  2122. {
  2123.     va_list marker;
  2124.     va_start(marker, format);     /* Initialize variable arguments. */
  2125.  
  2126.     return (vprintf(format, marker));
  2127. }
  2128.  
  2129. DllExport int
  2130. win32_vfprintf(FILE *fp, const char *format, va_list args)
  2131. {
  2132.     return (vfprintf(fp, format, args));
  2133. }
  2134.  
  2135. DllExport int
  2136. win32_vprintf(const char *format, va_list args)
  2137. {
  2138.     return (vprintf(format, args));
  2139. }
  2140.  
  2141. DllExport size_t
  2142. win32_fread(void *buf, size_t size, size_t count, FILE *fp)
  2143. {
  2144.     return fread(buf, size, count, fp);
  2145. }
  2146.  
  2147. DllExport size_t
  2148. win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
  2149. {
  2150.     return fwrite(buf, size, count, fp);
  2151. }
  2152.  
  2153. #define MODE_SIZE 10
  2154.  
  2155. DllExport FILE *
  2156. win32_fopen(const char *filename, const char *mode)
  2157. {
  2158.     dTHXo;
  2159.     WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1];
  2160.     FILE *f;
  2161.     
  2162.     if (!*filename)
  2163.     return NULL;
  2164.  
  2165.     if (stricmp(filename, "/dev/null")==0)
  2166.     filename = "NUL";
  2167.  
  2168.     if (USING_WIDE()) {
  2169.     A2WHELPER(mode, wMode, sizeof(wMode));
  2170.     A2WHELPER(filename, wBuffer, sizeof(wBuffer));
  2171.     f = _wfopen(PerlDir_mapW(wBuffer), wMode);
  2172.     }
  2173.     else
  2174.     f = fopen(PerlDir_mapA(filename), mode);
  2175.     /* avoid buffering headaches for child processes */
  2176.     if (f && *mode == 'a')
  2177.     win32_fseek(f, 0, SEEK_END);
  2178.     return f;
  2179. }
  2180.  
  2181. #ifndef USE_SOCKETS_AS_HANDLES
  2182. #undef fdopen
  2183. #define fdopen my_fdopen
  2184. #endif
  2185.  
  2186. DllExport FILE *
  2187. win32_fdopen(int handle, const char *mode)
  2188. {
  2189.     dTHXo;
  2190.     WCHAR wMode[MODE_SIZE];
  2191.     FILE *f;
  2192.     if (USING_WIDE()) {
  2193.     A2WHELPER(mode, wMode, sizeof(wMode));
  2194.     f = _wfdopen(handle, wMode);
  2195.     }
  2196.     else
  2197.     f = fdopen(handle, (char *) mode);
  2198.     /* avoid buffering headaches for child processes */
  2199.     if (f && *mode == 'a')
  2200.     win32_fseek(f, 0, SEEK_END);
  2201.     return f;
  2202. }
  2203.  
  2204. DllExport FILE *
  2205. win32_freopen(const char *path, const char *mode, FILE *stream)
  2206. {
  2207.     dTHXo;
  2208.     WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1];
  2209.     if (stricmp(path, "/dev/null")==0)
  2210.     path = "NUL";
  2211.  
  2212.     if (USING_WIDE()) {
  2213.     A2WHELPER(mode, wMode, sizeof(wMode));
  2214.     A2WHELPER(path, wBuffer, sizeof(wBuffer));
  2215.     return _wfreopen(PerlDir_mapW(wBuffer), wMode, stream);
  2216.     }
  2217.     return freopen(PerlDir_mapA(path), mode, stream);
  2218. }
  2219.  
  2220. DllExport int
  2221. win32_fclose(FILE *pf)
  2222. {
  2223.     return my_fclose(pf);    /* defined in win32sck.c */
  2224. }
  2225.  
  2226. DllExport int
  2227. win32_fputs(const char *s,FILE *pf)
  2228. {
  2229.     return fputs(s, pf);
  2230. }
  2231.  
  2232. DllExport int
  2233. win32_fputc(int c,FILE *pf)
  2234. {
  2235.     return fputc(c,pf);
  2236. }
  2237.  
  2238. DllExport int
  2239. win32_ungetc(int c,FILE *pf)
  2240. {
  2241.     return ungetc(c,pf);
  2242. }
  2243.  
  2244. DllExport int
  2245. win32_getc(FILE *pf)
  2246. {
  2247.     return getc(pf);
  2248. }
  2249.  
  2250. DllExport int
  2251. win32_fileno(FILE *pf)
  2252. {
  2253.     return fileno(pf);
  2254. }
  2255.  
  2256. DllExport void
  2257. win32_clearerr(FILE *pf)
  2258. {
  2259.     clearerr(pf);
  2260.     return;
  2261. }
  2262.  
  2263. DllExport int
  2264. win32_fflush(FILE *pf)
  2265. {
  2266.     return fflush(pf);
  2267. }
  2268.  
  2269. DllExport long
  2270. win32_ftell(FILE *pf)
  2271. {
  2272.     return ftell(pf);
  2273. }
  2274.  
  2275. DllExport int
  2276. win32_fseek(FILE *pf,long offset,int origin)
  2277. {
  2278.     return fseek(pf, offset, origin);
  2279. }
  2280.  
  2281. DllExport int
  2282. win32_fgetpos(FILE *pf,fpos_t *p)
  2283. {
  2284.     return fgetpos(pf, p);
  2285. }
  2286.  
  2287. DllExport int
  2288. win32_fsetpos(FILE *pf,const fpos_t *p)
  2289. {
  2290.     return fsetpos(pf, p);
  2291. }
  2292.  
  2293. DllExport void
  2294. win32_rewind(FILE *pf)
  2295. {
  2296.     rewind(pf);
  2297.     return;
  2298. }
  2299.  
  2300. DllExport FILE*
  2301. win32_tmpfile(void)
  2302. {
  2303.     return tmpfile();
  2304. }
  2305.  
  2306. DllExport void
  2307. win32_abort(void)
  2308. {
  2309.     abort();
  2310.     return;
  2311. }
  2312.  
  2313. DllExport int
  2314. win32_fstat(int fd,struct stat *sbufptr)
  2315. {
  2316.     return fstat(fd,sbufptr);
  2317. }
  2318.  
  2319. DllExport int
  2320. win32_pipe(int *pfd, unsigned int size, int mode)
  2321. {
  2322.     return _pipe(pfd, size, mode);
  2323. }
  2324.  
  2325. /*
  2326.  * a popen() clone that respects PERL5SHELL
  2327.  */
  2328.  
  2329. DllExport FILE*
  2330. win32_popen(const char *command, const char *mode)
  2331. {
  2332. #ifdef USE_RTL_POPEN
  2333.     return _popen(command, mode);
  2334. #else
  2335.     int p[2];
  2336.     int parent, child;
  2337.     int stdfd, oldfd;
  2338.     int ourmode;
  2339.     int childpid;
  2340.  
  2341.     /* establish which ends read and write */
  2342.     if (strchr(mode,'w')) {
  2343.         stdfd = 0;        /* stdin */
  2344.         parent = 1;
  2345.         child = 0;
  2346.     }
  2347.     else if (strchr(mode,'r')) {
  2348.         stdfd = 1;        /* stdout */
  2349.         parent = 0;
  2350.         child = 1;
  2351.     }
  2352.     else
  2353.         return NULL;
  2354.  
  2355.     /* set the correct mode */
  2356.     if (strchr(mode,'b'))
  2357.         ourmode = O_BINARY;
  2358.     else if (strchr(mode,'t'))
  2359.         ourmode = O_TEXT;
  2360.     else
  2361.         ourmode = _fmode & (O_TEXT | O_BINARY);
  2362.  
  2363.     /* the child doesn't inherit handles */
  2364.     ourmode |= O_NOINHERIT;
  2365.  
  2366.     if (win32_pipe( p, 512, ourmode) == -1)
  2367.         return NULL;
  2368.  
  2369.     /* save current stdfd */
  2370.     if ((oldfd = win32_dup(stdfd)) == -1)
  2371.         goto cleanup;
  2372.  
  2373.     /* make stdfd go to child end of pipe (implicitly closes stdfd) */
  2374.     /* stdfd will be inherited by the child */
  2375.     if (win32_dup2(p[child], stdfd) == -1)
  2376.         goto cleanup;
  2377.  
  2378.     /* close the child end in parent */
  2379.     win32_close(p[child]);
  2380.  
  2381.     /* start the child */
  2382.     {
  2383.     dTHXo;
  2384.     if ((childpid = do_spawn_nowait((char*)command)) == -1)
  2385.         goto cleanup;
  2386.  
  2387.     /* revert stdfd to whatever it was before */
  2388.     if (win32_dup2(oldfd, stdfd) == -1)
  2389.         goto cleanup;
  2390.  
  2391.     /* close saved handle */
  2392.     win32_close(oldfd);
  2393.  
  2394.     sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
  2395.  
  2396.     /* set process id so that it can be returned by perl's open() */
  2397.     PL_forkprocess = childpid;
  2398.     }
  2399.  
  2400.     /* we have an fd, return a file stream */
  2401.     return (win32_fdopen(p[parent], (char *)mode));
  2402.  
  2403. cleanup:
  2404.     /* we don't need to check for errors here */
  2405.     win32_close(p[0]);
  2406.     win32_close(p[1]);
  2407.     if (oldfd != -1) {
  2408.         win32_dup2(oldfd, stdfd);
  2409.         win32_close(oldfd);
  2410.     }
  2411.     return (NULL);
  2412.  
  2413. #endif /* USE_RTL_POPEN */
  2414. }
  2415.  
  2416. /*
  2417.  * pclose() clone
  2418.  */
  2419.  
  2420. DllExport int
  2421. win32_pclose(FILE *pf)
  2422. {
  2423. #ifdef USE_RTL_POPEN
  2424.     return _pclose(pf);
  2425. #else
  2426.     dTHXo;
  2427.     int childpid, status;
  2428.     SV *sv;
  2429.  
  2430.     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
  2431.     if (SvIOK(sv))
  2432.     childpid = SvIVX(sv);
  2433.     else
  2434.     childpid = 0;
  2435.  
  2436.     if (!childpid) {
  2437.     errno = EBADF;
  2438.         return -1;
  2439.     }
  2440.  
  2441.     win32_fclose(pf);
  2442.     SvIVX(sv) = 0;
  2443.  
  2444.     if (win32_waitpid(childpid, &status, 0) == -1)
  2445.         return -1;
  2446.  
  2447.     return status;
  2448.  
  2449. #endif /* USE_RTL_POPEN */
  2450. }
  2451.  
  2452. static BOOL WINAPI
  2453. Nt4CreateHardLinkW(
  2454.     LPCWSTR lpFileName,
  2455.     LPCWSTR lpExistingFileName,
  2456.     LPSECURITY_ATTRIBUTES lpSecurityAttributes)
  2457. {
  2458.     HANDLE handle;
  2459.     WCHAR wFullName[MAX_PATH+1];
  2460.     LPVOID lpContext = NULL;
  2461.     WIN32_STREAM_ID StreamId;
  2462.     DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId;
  2463.     DWORD dwWritten;
  2464.     DWORD dwLen;
  2465.     BOOL bSuccess;
  2466.  
  2467.     BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD,
  2468.                      BOOL, BOOL, LPVOID*) =
  2469.     (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD,
  2470.                 BOOL, BOOL, LPVOID*))
  2471.     GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite");
  2472.     if (pfnBackupWrite == NULL)
  2473.     return 0;
  2474.  
  2475.     dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL);
  2476.     if (dwLen == 0)
  2477.     return 0;
  2478.     dwLen = (dwLen+1)*sizeof(WCHAR);
  2479.  
  2480.     handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES,
  2481.              FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
  2482.              NULL, OPEN_EXISTING, 0, NULL);
  2483.     if (handle == INVALID_HANDLE_VALUE)
  2484.     return 0;
  2485.  
  2486.     StreamId.dwStreamId = BACKUP_LINK;
  2487.     StreamId.dwStreamAttributes = 0;
  2488.     StreamId.dwStreamNameSize = 0;
  2489. #if defined(__BORLANDC__) || defined(__MINGW32__)
  2490.     StreamId.Size.u.HighPart = 0;
  2491.     StreamId.Size.u.LowPart = dwLen;
  2492. #else
  2493.     StreamId.Size.HighPart = 0;
  2494.     StreamId.Size.LowPart = dwLen;
  2495. #endif
  2496.  
  2497.     bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
  2498.                   FALSE, FALSE, &lpContext);
  2499.     if (bSuccess) {
  2500.     bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten,
  2501.                   FALSE, FALSE, &lpContext);
  2502.     pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext);
  2503.     }
  2504.  
  2505.     CloseHandle(handle);
  2506.     return bSuccess;
  2507. }
  2508.  
  2509. DllExport int
  2510. win32_link(const char *oldname, const char *newname)
  2511. {
  2512.     dTHXo;
  2513.     BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
  2514.     WCHAR wOldName[MAX_PATH+1];
  2515.     WCHAR wNewName[MAX_PATH+1];
  2516.  
  2517.     if (IsWin95())
  2518.     Perl_croak(aTHX_ PL_no_func, "link");
  2519.  
  2520.     pfnCreateHardLinkW =
  2521.     (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES))
  2522.     GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW");
  2523.     if (pfnCreateHardLinkW == NULL)
  2524.     pfnCreateHardLinkW = Nt4CreateHardLinkW;
  2525.  
  2526.     if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) &&
  2527.     (A2WHELPER(newname, wNewName, sizeof(wNewName))) &&
  2528.     (wcscpy(wOldName, PerlDir_mapW(wOldName)),
  2529.     pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
  2530.     {
  2531.     return 0;
  2532.     }
  2533.     errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
  2534.     return -1;
  2535. }
  2536.  
  2537. DllExport int
  2538. win32_rename(const char *oname, const char *newname)
  2539. {
  2540.     WCHAR wOldName[MAX_PATH+1];
  2541.     WCHAR wNewName[MAX_PATH+1];
  2542.     char szOldName[MAX_PATH+1];
  2543.     char szNewName[MAX_PATH+1];
  2544.     BOOL bResult;
  2545.     dTHXo;
  2546.  
  2547.     /* XXX despite what the documentation says about MoveFileEx(),
  2548.      * it doesn't work under Windows95!
  2549.      */
  2550.     if (IsWinNT()) {
  2551.     DWORD dwFlags = MOVEFILE_COPY_ALLOWED;
  2552.     if (USING_WIDE()) {
  2553.         A2WHELPER(oname, wOldName, sizeof(wOldName));
  2554.         A2WHELPER(newname, wNewName, sizeof(wNewName));
  2555.         if (wcsicmp(wNewName, wOldName))
  2556.         dwFlags |= MOVEFILE_REPLACE_EXISTING;
  2557.         wcscpy(wOldName, PerlDir_mapW(wOldName));
  2558.         bResult = MoveFileExW(wOldName,PerlDir_mapW(wNewName), dwFlags);
  2559.     }
  2560.     else {
  2561.         if (stricmp(newname, oname))
  2562.         dwFlags |= MOVEFILE_REPLACE_EXISTING;
  2563.         strcpy(szOldName, PerlDir_mapA(oname));
  2564.         bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), dwFlags);
  2565.     }
  2566.     if (!bResult) {
  2567.         DWORD err = GetLastError();
  2568.         switch (err) {
  2569.         case ERROR_BAD_NET_NAME:
  2570.         case ERROR_BAD_NETPATH:
  2571.         case ERROR_BAD_PATHNAME:
  2572.         case ERROR_FILE_NOT_FOUND:
  2573.         case ERROR_FILENAME_EXCED_RANGE:
  2574.         case ERROR_INVALID_DRIVE:
  2575.         case ERROR_NO_MORE_FILES:
  2576.         case ERROR_PATH_NOT_FOUND:
  2577.         errno = ENOENT;
  2578.         break;
  2579.         default:
  2580.         errno = EACCES;
  2581.         break;
  2582.         }
  2583.         return -1;
  2584.     }
  2585.     return 0;
  2586.     }
  2587.     else {
  2588.     int retval = 0;
  2589.     char szTmpName[MAX_PATH+1];
  2590.     char dname[MAX_PATH+1];
  2591.     char *endname = Nullch;
  2592.     STRLEN tmplen = 0;
  2593.     DWORD from_attr, to_attr;
  2594.  
  2595.     strcpy(szOldName, PerlDir_mapA(oname));
  2596.     strcpy(szNewName, PerlDir_mapA(newname));
  2597.  
  2598.     /* if oname doesn't exist, do nothing */
  2599.     from_attr = GetFileAttributes(szOldName);
  2600.     if (from_attr == 0xFFFFFFFF) {
  2601.         errno = ENOENT;
  2602.         return -1;
  2603.     }
  2604.  
  2605.     /* if newname exists, rename it to a temporary name so that we
  2606.      * don't delete it in case oname happens to be the same file
  2607.      * (but perhaps accessed via a different path)
  2608.      */
  2609.     to_attr = GetFileAttributes(szNewName);
  2610.     if (to_attr != 0xFFFFFFFF) {
  2611.         /* if newname is a directory, we fail
  2612.          * XXX could overcome this with yet more convoluted logic */
  2613.         if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
  2614.         errno = EACCES;
  2615.         return -1;
  2616.         }
  2617.         tmplen = strlen(szNewName);
  2618.         strcpy(szTmpName,szNewName);
  2619.         endname = szTmpName+tmplen;
  2620.         for (; endname > szTmpName ; --endname) {
  2621.         if (*endname == '/' || *endname == '\\') {
  2622.             *endname = '\0';
  2623.             break;
  2624.         }
  2625.         }
  2626.         if (endname > szTmpName)
  2627.         endname = strcpy(dname,szTmpName);
  2628.         else
  2629.         endname = ".";
  2630.  
  2631.         /* get a temporary filename in same directory
  2632.          * XXX is this really the best we can do? */
  2633.         if (!GetTempFileName((LPCTSTR)endname, "plr", 0, szTmpName)) {
  2634.         errno = ENOENT;
  2635.         return -1;
  2636.         }
  2637.         DeleteFile(szTmpName);
  2638.  
  2639.         retval = rename(szNewName, szTmpName);
  2640.         if (retval != 0) {
  2641.         errno = EACCES;
  2642.         return retval;
  2643.         }
  2644.     }
  2645.  
  2646.     /* rename oname to newname */
  2647.     retval = rename(szOldName, szNewName);
  2648.  
  2649.     /* if we created a temporary file before ... */
  2650.     if (endname != Nullch) {
  2651.         /* ...and rename succeeded, delete temporary file/directory */
  2652.         if (retval == 0)
  2653.         DeleteFile(szTmpName);
  2654.         /* else restore it to what it was */
  2655.         else
  2656.         (void)rename(szTmpName, szNewName);
  2657.     }
  2658.     return retval;
  2659.     }
  2660. }
  2661.  
  2662. DllExport int
  2663. win32_setmode(int fd, int mode)
  2664. {
  2665.     return setmode(fd, mode);
  2666. }
  2667.  
  2668. DllExport long
  2669. win32_lseek(int fd, long offset, int origin)
  2670. {
  2671.     return lseek(fd, offset, origin);
  2672. }
  2673.  
  2674. DllExport long
  2675. win32_tell(int fd)
  2676. {
  2677.     return tell(fd);
  2678. }
  2679.  
  2680. DllExport int
  2681. win32_open(const char *path, int flag, ...)
  2682. {
  2683.     dTHXo;
  2684.     va_list ap;
  2685.     int pmode;
  2686.     WCHAR wBuffer[MAX_PATH+1];
  2687.  
  2688.     va_start(ap, flag);
  2689.     pmode = va_arg(ap, int);
  2690.     va_end(ap);
  2691.  
  2692.     if (stricmp(path, "/dev/null")==0)
  2693.     path = "NUL";
  2694.  
  2695.     if (USING_WIDE()) {
  2696.     A2WHELPER(path, wBuffer, sizeof(wBuffer));
  2697.     return _wopen(PerlDir_mapW(wBuffer), flag, pmode);
  2698.     }
  2699.     return open(PerlDir_mapA(path), flag, pmode);
  2700. }
  2701.  
  2702. DllExport int
  2703. win32_close(int fd)
  2704. {
  2705.     return close(fd);
  2706. }
  2707.  
  2708. DllExport int
  2709. win32_eof(int fd)
  2710. {
  2711.     return eof(fd);
  2712. }
  2713.  
  2714. DllExport int
  2715. win32_dup(int fd)
  2716. {
  2717.     return dup(fd);
  2718. }
  2719.  
  2720. DllExport int
  2721. win32_dup2(int fd1,int fd2)
  2722. {
  2723.     return dup2(fd1,fd2);
  2724. }
  2725.  
  2726. #ifdef PERL_MSVCRT_READFIX
  2727.  
  2728. #define LF        10    /* line feed */
  2729. #define CR        13    /* carriage return */
  2730. #define CTRLZ        26      /* ctrl-z means eof for text */
  2731. #define FOPEN        0x01    /* file handle open */
  2732. #define FEOFLAG        0x02    /* end of file has been encountered */
  2733. #define FCRLF        0x04    /* CR-LF across read buffer (in text mode) */
  2734. #define FPIPE        0x08    /* file handle refers to a pipe */
  2735. #define FAPPEND        0x20    /* file handle opened O_APPEND */
  2736. #define FDEV        0x40    /* file handle refers to device */
  2737. #define FTEXT        0x80    /* file handle is in text mode */
  2738. #define MAX_DESCRIPTOR_COUNT    (64*32) /* this is the maximun that MSVCRT can handle */
  2739.  
  2740. int __cdecl
  2741. _fixed_read(int fh, void *buf, unsigned cnt)
  2742. {
  2743.     int bytes_read;                 /* number of bytes read */
  2744.     char *buffer;                   /* buffer to read to */
  2745.     int os_read;                    /* bytes read on OS call */
  2746.     char *p, *q;                    /* pointers into buffer */
  2747.     char peekchr;                   /* peek-ahead character */
  2748.     ULONG filepos;                  /* file position after seek */
  2749.     ULONG dosretval;                /* o.s. return value */
  2750.  
  2751.     /* validate handle */
  2752.     if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) ||
  2753.          !(_osfile(fh) & FOPEN))
  2754.     {
  2755.     /* out of range -- return error */
  2756.     errno = EBADF;
  2757.     _doserrno = 0;  /* not o.s. error */
  2758.     return -1;
  2759.     }
  2760.  
  2761.     /*
  2762.      * If lockinitflag is FALSE, assume fd is device
  2763.      * lockinitflag is set to TRUE by open.
  2764.      */
  2765.     if (_pioinfo(fh)->lockinitflag)
  2766.     EnterCriticalSection(&(_pioinfo(fh)->lock));  /* lock file */
  2767.  
  2768.     bytes_read = 0;                 /* nothing read yet */
  2769.     buffer = (char*)buf;
  2770.  
  2771.     if (cnt == 0 || (_osfile(fh) & FEOFLAG)) {
  2772.         /* nothing to read or at EOF, so return 0 read */
  2773.         goto functionexit;
  2774.     }
  2775.  
  2776.     if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) {
  2777.         /* a pipe/device and pipe lookahead non-empty: read the lookahead
  2778.          * char */
  2779.         *buffer++ = _pipech(fh);
  2780.         ++bytes_read;
  2781.         --cnt;
  2782.         _pipech(fh) = LF;           /* mark as empty */
  2783.     }
  2784.  
  2785.     /* read the data */
  2786.  
  2787.     if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL))
  2788.     {
  2789.         /* ReadFile has reported an error. recognize two special cases.
  2790.          *
  2791.          *      1. map ERROR_ACCESS_DENIED to EBADF
  2792.          *
  2793.          *      2. just return 0 if ERROR_BROKEN_PIPE has occurred. it
  2794.          *         means the handle is a read-handle on a pipe for which
  2795.          *         all write-handles have been closed and all data has been
  2796.          *         read. */
  2797.  
  2798.         if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) {
  2799.             /* wrong read/write mode should return EBADF, not EACCES */
  2800.             errno = EBADF;
  2801.             _doserrno = dosretval;
  2802.             bytes_read = -1;
  2803.         goto functionexit;
  2804.         }
  2805.         else if (dosretval == ERROR_BROKEN_PIPE) {
  2806.             bytes_read = 0;
  2807.         goto functionexit;
  2808.         }
  2809.         else {
  2810.             bytes_read = -1;
  2811.         goto functionexit;
  2812.         }
  2813.     }
  2814.  
  2815.     bytes_read += os_read;          /* update bytes read */
  2816.  
  2817.     if (_osfile(fh) & FTEXT) {
  2818.         /* now must translate CR-LFs to LFs in the buffer */
  2819.  
  2820.         /* set CRLF flag to indicate LF at beginning of buffer */
  2821.         /* if ((os_read != 0) && (*(char *)buf == LF))   */
  2822.         /*    _osfile(fh) |= FCRLF;                      */
  2823.         /* else                                          */
  2824.         /*    _osfile(fh) &= ~FCRLF;                     */
  2825.  
  2826.         _osfile(fh) &= ~FCRLF;
  2827.  
  2828.         /* convert chars in the buffer: p is src, q is dest */
  2829.         p = q = (char*)buf;
  2830.         while (p < (char *)buf + bytes_read) {
  2831.             if (*p == CTRLZ) {
  2832.                 /* if fh is not a device, set ctrl-z flag */
  2833.                 if (!(_osfile(fh) & FDEV))
  2834.                     _osfile(fh) |= FEOFLAG;
  2835.                 break;              /* stop translating */
  2836.             }
  2837.             else if (*p != CR)
  2838.                 *q++ = *p++;
  2839.             else {
  2840.                 /* *p is CR, so must check next char for LF */
  2841.                 if (p < (char *)buf + bytes_read - 1) {
  2842.                     if (*(p+1) == LF) {
  2843.                         p += 2;
  2844.                         *q++ = LF;  /* convert CR-LF to LF */
  2845.                     }
  2846.                     else
  2847.                         *q++ = *p++;    /* store char normally */
  2848.                 }
  2849.                 else {
  2850.                     /* This is the hard part.  We found a CR at end of
  2851.                        buffer.  We must peek ahead to see if next char
  2852.                        is an LF. */
  2853.                     ++p;
  2854.  
  2855.                     dosretval = 0;
  2856.                     if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1,
  2857.                                     (LPDWORD)&os_read, NULL))
  2858.                         dosretval = GetLastError();
  2859.  
  2860.                     if (dosretval != 0 || os_read == 0) {
  2861.                         /* couldn't read ahead, store CR */
  2862.                         *q++ = CR;
  2863.                     }
  2864.                     else {
  2865.                         /* peekchr now has the extra character -- we now
  2866.                            have several possibilities:
  2867.                            1. disk file and char is not LF; just seek back
  2868.                               and copy CR
  2869.                            2. disk file and char is LF; store LF, don't seek back
  2870.                            3. pipe/device and char is LF; store LF.
  2871.                            4. pipe/device and char isn't LF, store CR and
  2872.                               put char in pipe lookahead buffer. */
  2873.                         if (_osfile(fh) & (FDEV|FPIPE)) {
  2874.                             /* non-seekable device */
  2875.                             if (peekchr == LF)
  2876.                                 *q++ = LF;
  2877.                             else {
  2878.                                 *q++ = CR;
  2879.                                 _pipech(fh) = peekchr;
  2880.                             }
  2881.                         }
  2882.                         else {
  2883.                             /* disk file */
  2884.                             if (peekchr == LF) {
  2885.                                 /* nothing read yet; must make some
  2886.                                    progress */
  2887.                                 *q++ = LF;
  2888.                                 /* turn on this flag for tell routine */
  2889.                                 _osfile(fh) |= FCRLF;
  2890.                             }
  2891.                             else {
  2892.                 HANDLE osHandle;        /* o.s. handle value */
  2893.                                 /* seek back */
  2894.                 if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1)
  2895.                 {
  2896.                     if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1)
  2897.                     dosretval = GetLastError();
  2898.                 }
  2899.                                 if (peekchr != LF)
  2900.                                     *q++ = CR;
  2901.                             }
  2902.                         }
  2903.                     }
  2904.                 }
  2905.             }
  2906.         }
  2907.  
  2908.         /* we now change bytes_read to reflect the true number of chars
  2909.            in the buffer */
  2910.         bytes_read = q - (char *)buf;
  2911.     }
  2912.  
  2913. functionexit:    
  2914.     if (_pioinfo(fh)->lockinitflag)
  2915.     LeaveCriticalSection(&(_pioinfo(fh)->lock));    /* unlock file */
  2916.  
  2917.     return bytes_read;
  2918. }
  2919.  
  2920. #endif    /* PERL_MSVCRT_READFIX */
  2921.  
  2922. DllExport int
  2923. win32_read(int fd, void *buf, unsigned int cnt)
  2924. {
  2925. #ifdef PERL_MSVCRT_READFIX
  2926.     return _fixed_read(fd, buf, cnt);
  2927. #else
  2928.     return read(fd, buf, cnt);
  2929. #endif
  2930. }
  2931.  
  2932. DllExport int
  2933. win32_write(int fd, const void *buf, unsigned int cnt)
  2934. {
  2935.     return write(fd, buf, cnt);
  2936. }
  2937.  
  2938. DllExport int
  2939. win32_mkdir(const char *dir, int mode)
  2940. {
  2941.     dTHXo;
  2942.     if (USING_WIDE()) {
  2943.     WCHAR wBuffer[MAX_PATH+1];
  2944.     A2WHELPER(dir, wBuffer, sizeof(wBuffer));
  2945.     return _wmkdir(PerlDir_mapW(wBuffer));
  2946.     }
  2947.     return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
  2948. }
  2949.  
  2950. DllExport int
  2951. win32_rmdir(const char *dir)
  2952. {
  2953.     dTHXo;
  2954.     if (USING_WIDE()) {
  2955.     WCHAR wBuffer[MAX_PATH+1];
  2956.     A2WHELPER(dir, wBuffer, sizeof(wBuffer));
  2957.     return _wrmdir(PerlDir_mapW(wBuffer));
  2958.     }
  2959.     return rmdir(PerlDir_mapA(dir));
  2960. }
  2961.  
  2962. DllExport int
  2963. win32_chdir(const char *dir)
  2964. {
  2965.     dTHXo;
  2966.     if (USING_WIDE()) {
  2967.     WCHAR wBuffer[MAX_PATH+1];
  2968.     A2WHELPER(dir, wBuffer, sizeof(wBuffer));
  2969.     return _wchdir(wBuffer);
  2970.     }
  2971.     return chdir(dir);
  2972. }
  2973.  
  2974. DllExport  int
  2975. win32_access(const char *path, int mode)
  2976. {
  2977.     dTHXo;
  2978.     if (USING_WIDE()) {
  2979.     WCHAR wBuffer[MAX_PATH+1];
  2980.     A2WHELPER(path, wBuffer, sizeof(wBuffer));
  2981.     return _waccess(PerlDir_mapW(wBuffer), mode);
  2982.     }
  2983.     return access(PerlDir_mapA(path), mode);
  2984. }
  2985.  
  2986. DllExport  int
  2987. win32_chmod(const char *path, int mode)
  2988. {
  2989.     dTHXo;
  2990.     if (USING_WIDE()) {
  2991.     WCHAR wBuffer[MAX_PATH+1];
  2992.     A2WHELPER(path, wBuffer, sizeof(wBuffer));
  2993.     return _wchmod(PerlDir_mapW(wBuffer), mode);
  2994.     }
  2995.     return chmod(PerlDir_mapA(path), mode);
  2996. }
  2997.  
  2998.  
  2999. static char *
  3000. create_command_line(const char* command, const char * const *args)
  3001. {
  3002.     dTHXo;
  3003.     int index;
  3004.     char *cmd, *ptr, *arg;
  3005.     STRLEN len = strlen(command) + 1;
  3006.  
  3007.     for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
  3008.     len += strlen(ptr) + 1;
  3009.  
  3010.     New(1310, cmd, len, char);
  3011.     ptr = cmd;
  3012.     strcpy(ptr, command);
  3013.  
  3014.     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
  3015.     ptr += strlen(ptr);
  3016.     *ptr++ = ' ';
  3017.     strcpy(ptr, arg);
  3018.     }
  3019.  
  3020.     return cmd;
  3021. }
  3022.  
  3023. static char *
  3024. qualified_path(const char *cmd)
  3025. {
  3026.     dTHXo;
  3027.     char *pathstr;
  3028.     char *fullcmd, *curfullcmd;
  3029.     STRLEN cmdlen = 0;
  3030.     int has_slash = 0;
  3031.  
  3032.     if (!cmd)
  3033.     return Nullch;
  3034.     fullcmd = (char*)cmd;
  3035.     while (*fullcmd) {
  3036.     if (*fullcmd == '/' || *fullcmd == '\\')
  3037.         has_slash++;
  3038.     fullcmd++;
  3039.     cmdlen++;
  3040.     }
  3041.  
  3042.     /* look in PATH */
  3043.     pathstr = win32_getenv("PATH");
  3044.     New(0, fullcmd, MAX_PATH+1, char);
  3045.     curfullcmd = fullcmd;
  3046.  
  3047.     while (1) {
  3048.     DWORD res;
  3049.  
  3050.     /* start by appending the name to the current prefix */
  3051.     strcpy(curfullcmd, cmd);
  3052.     curfullcmd += cmdlen;
  3053.  
  3054.     /* if it doesn't end with '.', or has no extension, try adding
  3055.      * a trailing .exe first */
  3056.     if (cmd[cmdlen-1] != '.'
  3057.         && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
  3058.     {
  3059.         strcpy(curfullcmd, ".exe");
  3060.         res = GetFileAttributes(fullcmd);
  3061.         if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
  3062.         return fullcmd;
  3063.         *curfullcmd = '\0';
  3064.     }
  3065.  
  3066.     /* that failed, try the bare name */
  3067.     res = GetFileAttributes(fullcmd);
  3068.     if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
  3069.         return fullcmd;
  3070.  
  3071.     /* quit if no other path exists, or if cmd already has path */
  3072.     if (!pathstr || !*pathstr || has_slash)
  3073.         break;
  3074.  
  3075.     /* skip leading semis */
  3076.     while (*pathstr == ';')
  3077.         pathstr++;
  3078.  
  3079.     /* build a new prefix from scratch */
  3080.     curfullcmd = fullcmd;
  3081.     while (*pathstr && *pathstr != ';') {
  3082.         if (*pathstr == '"') {    /* foo;"baz;etc";bar */
  3083.         pathstr++;        /* skip initial '"' */
  3084.         while (*pathstr && *pathstr != '"') {
  3085.             if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
  3086.             *curfullcmd++ = *pathstr;
  3087.             pathstr++;
  3088.         }
  3089.         if (*pathstr)
  3090.             pathstr++;        /* skip trailing '"' */
  3091.         }
  3092.         else {
  3093.         if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
  3094.             *curfullcmd++ = *pathstr;
  3095.         pathstr++;
  3096.         }
  3097.     }
  3098.     if (*pathstr)
  3099.         pathstr++;            /* skip trailing semi */
  3100.     if (curfullcmd > fullcmd    /* append a dir separator */
  3101.         && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
  3102.     {
  3103.         *curfullcmd++ = '\\';
  3104.     }
  3105.     }
  3106. GIVE_UP:
  3107.     Safefree(fullcmd);
  3108.     return Nullch;
  3109. }
  3110.  
  3111. /* The following are just place holders.
  3112.  * Some hosts may provide and environment that the OS is
  3113.  * not tracking, therefore, these host must provide that
  3114.  * environment and the current directory to CreateProcess
  3115.  */
  3116.  
  3117. void*
  3118. get_childenv(void)
  3119. {
  3120.     return NULL;
  3121. }
  3122.  
  3123. void
  3124. free_childenv(void* d)
  3125. {
  3126. }
  3127.  
  3128. char*
  3129. get_childdir(void)
  3130. {
  3131.     dTHXo;
  3132.     char* ptr;
  3133.     char szfilename[(MAX_PATH+1)*2];
  3134.     if (USING_WIDE()) {
  3135.     WCHAR wfilename[MAX_PATH+1];
  3136.     GetCurrentDirectoryW(MAX_PATH+1, wfilename);
  3137.     W2AHELPER(wfilename, szfilename, sizeof(szfilename));
  3138.     }
  3139.     else {
  3140.     GetCurrentDirectoryA(MAX_PATH+1, szfilename);
  3141.     }
  3142.  
  3143.     New(0, ptr, strlen(szfilename)+1, char);
  3144.     strcpy(ptr, szfilename);
  3145.     return ptr;
  3146. }
  3147.  
  3148. void
  3149. free_childdir(char* d)
  3150. {
  3151.     dTHXo;
  3152.     Safefree(d);
  3153. }
  3154.  
  3155.  
  3156. /* XXX this needs to be made more compatible with the spawnvp()
  3157.  * provided by the various RTLs.  In particular, searching for
  3158.  * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
  3159.  * This doesn't significantly affect perl itself, because we
  3160.  * always invoke things using PERL5SHELL if a direct attempt to
  3161.  * spawn the executable fails.
  3162.  * 
  3163.  * XXX splitting and rejoining the commandline between do_aspawn()
  3164.  * and win32_spawnvp() could also be avoided.
  3165.  */
  3166.  
  3167. DllExport int
  3168. win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
  3169. {
  3170. #ifdef USE_RTL_SPAWNVP
  3171.     return spawnvp(mode, cmdname, (char * const *)argv);
  3172. #else
  3173.     dTHXo;
  3174.     int ret;
  3175.     void* env;
  3176.     char* dir;
  3177.     child_IO_table tbl;
  3178.     STARTUPINFO StartupInfo;
  3179.     PROCESS_INFORMATION ProcessInformation;
  3180.     DWORD create = 0;
  3181.  
  3182.     char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
  3183.                                   ? &argv[1] : argv);
  3184.     char *fullcmd = Nullch;
  3185.  
  3186.     env = PerlEnv_get_childenv();
  3187.     dir = PerlEnv_get_childdir();
  3188.  
  3189.     switch(mode) {
  3190.     case P_NOWAIT:    /* asynch + remember result */
  3191.     if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
  3192.         errno = EAGAIN;
  3193.         ret = -1;
  3194.         goto RETVAL;
  3195.     }
  3196.     /* FALL THROUGH */
  3197.     case P_WAIT:    /* synchronous execution */
  3198.     break;
  3199.     default:        /* invalid mode */
  3200.     errno = EINVAL;
  3201.     ret = -1;
  3202.     goto RETVAL;
  3203.     }
  3204.     memset(&StartupInfo,0,sizeof(StartupInfo));
  3205.     StartupInfo.cb = sizeof(StartupInfo);
  3206.     memset(&tbl,0,sizeof(tbl));
  3207.     PerlEnv_get_child_IO(&tbl);
  3208.     StartupInfo.dwFlags        = tbl.dwFlags;
  3209.     StartupInfo.dwX        = tbl.dwX; 
  3210.     StartupInfo.dwY        = tbl.dwY; 
  3211.     StartupInfo.dwXSize        = tbl.dwXSize; 
  3212.     StartupInfo.dwYSize        = tbl.dwYSize; 
  3213.     StartupInfo.dwXCountChars    = tbl.dwXCountChars; 
  3214.     StartupInfo.dwYCountChars    = tbl.dwYCountChars; 
  3215.     StartupInfo.dwFillAttribute    = tbl.dwFillAttribute; 
  3216.     StartupInfo.wShowWindow    = tbl.wShowWindow; 
  3217.     StartupInfo.hStdInput    = tbl.childStdIn;
  3218.     StartupInfo.hStdOutput    = tbl.childStdOut;
  3219.     StartupInfo.hStdError    = tbl.childStdErr;
  3220.     if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE &&
  3221.     StartupInfo.hStdOutput != INVALID_HANDLE_VALUE &&
  3222.     StartupInfo.hStdError != INVALID_HANDLE_VALUE)
  3223.     {
  3224.     StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
  3225.     }
  3226.     else {
  3227.     create |= CREATE_NEW_CONSOLE;
  3228.     }
  3229.  
  3230. RETRY:
  3231.     if (!CreateProcess(cmdname,        /* search PATH to find executable */
  3232.                cmd,        /* executable, and its arguments */
  3233.                NULL,        /* process attributes */
  3234.                NULL,        /* thread attributes */
  3235.                TRUE,        /* inherit handles */
  3236.                create,        /* creation flags */
  3237.                (LPVOID)env,    /* inherit environment */
  3238.                dir,        /* inherit cwd */
  3239.                &StartupInfo,
  3240.                &ProcessInformation))
  3241.     {
  3242.     /* initial NULL argument to CreateProcess() does a PATH
  3243.      * search, but it always first looks in the directory
  3244.      * where the current process was started, which behavior
  3245.      * is undesirable for backward compatibility.  So we
  3246.      * jump through our own hoops by picking out the path
  3247.      * we really want it to use. */
  3248.     if (!fullcmd) {
  3249.         fullcmd = qualified_path(cmdname);
  3250.         if (fullcmd) {
  3251.         cmdname = fullcmd;
  3252.         goto RETRY;
  3253.         }
  3254.     }
  3255.     errno = ENOENT;
  3256.     ret = -1;
  3257.     goto RETVAL;
  3258.     }
  3259.  
  3260.     if (mode == P_NOWAIT) {
  3261.     /* asynchronous spawn -- store handle, return PID */
  3262.     w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
  3263.     w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
  3264.     ret = (int)ProcessInformation.dwProcessId;
  3265.     ++w32_num_children;
  3266.     }
  3267.     else  {
  3268.     DWORD status;
  3269.     WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
  3270.     GetExitCodeProcess(ProcessInformation.hProcess, &status);
  3271.     ret = (int)status;
  3272.     CloseHandle(ProcessInformation.hProcess);
  3273.     }
  3274.  
  3275.     CloseHandle(ProcessInformation.hThread);
  3276.  
  3277. RETVAL:
  3278.     PerlEnv_free_childenv(env);
  3279.     PerlEnv_free_childdir(dir);
  3280.     Safefree(cmd);
  3281.     Safefree(fullcmd);
  3282.     return ret;
  3283. #endif
  3284. }
  3285.  
  3286. DllExport int
  3287. win32_execv(const char *cmdname, const char *const *argv)
  3288. {
  3289. #ifdef USE_ITHREADS
  3290.     dTHXo;
  3291.     /* if this is a pseudo-forked child, we just want to spawn
  3292.      * the new program, and return */
  3293.     if (w32_pseudo_id)
  3294.     return spawnv(P_WAIT, cmdname, (char *const *)argv);
  3295. #endif
  3296.     return execv(cmdname, (char *const *)argv);
  3297. }
  3298.  
  3299. DllExport int
  3300. win32_execvp(const char *cmdname, const char *const *argv)
  3301. {
  3302. #ifdef USE_ITHREADS
  3303.     dTHXo;
  3304.     /* if this is a pseudo-forked child, we just want to spawn
  3305.      * the new program, and return */
  3306.     if (w32_pseudo_id)
  3307.     return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv);
  3308. #endif
  3309.     return execvp(cmdname, (char *const *)argv);
  3310. }
  3311.  
  3312. DllExport void
  3313. win32_perror(const char *str)
  3314. {
  3315.     perror(str);
  3316. }
  3317.  
  3318. DllExport void
  3319. win32_setbuf(FILE *pf, char *buf)
  3320. {
  3321.     setbuf(pf, buf);
  3322. }
  3323.  
  3324. DllExport int
  3325. win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
  3326. {
  3327.     return setvbuf(pf, buf, type, size);
  3328. }
  3329.  
  3330. DllExport int
  3331. win32_flushall(void)
  3332. {
  3333.     return flushall();
  3334. }
  3335.  
  3336. DllExport int
  3337. win32_fcloseall(void)
  3338. {
  3339.     return fcloseall();
  3340. }
  3341.  
  3342. DllExport char*
  3343. win32_fgets(char *s, int n, FILE *pf)
  3344. {
  3345.     return fgets(s, n, pf);
  3346. }
  3347.  
  3348. DllExport char*
  3349. win32_gets(char *s)
  3350. {
  3351.     return gets(s);
  3352. }
  3353.  
  3354. DllExport int
  3355. win32_fgetc(FILE *pf)
  3356. {
  3357.     return fgetc(pf);
  3358. }
  3359.  
  3360. DllExport int
  3361. win32_putc(int c, FILE *pf)
  3362. {
  3363.     return putc(c,pf);
  3364. }
  3365.  
  3366. DllExport int
  3367. win32_puts(const char *s)
  3368. {
  3369.     return puts(s);
  3370. }
  3371.  
  3372. DllExport int
  3373. win32_getchar(void)
  3374. {
  3375.     return getchar();
  3376. }
  3377.  
  3378. DllExport int
  3379. win32_putchar(int c)
  3380. {
  3381.     return putchar(c);
  3382. }
  3383.  
  3384. #ifdef MYMALLOC
  3385.  
  3386. #ifndef USE_PERL_SBRK
  3387.  
  3388. static char *committed = NULL;
  3389. static char *base      = NULL;
  3390. static char *reserved  = NULL;
  3391. static char *brk       = NULL;
  3392. static DWORD pagesize  = 0;
  3393. static DWORD allocsize = 0;
  3394.  
  3395. void *
  3396. sbrk(int need)
  3397. {
  3398.  void *result;
  3399.  if (!pagesize)
  3400.   {SYSTEM_INFO info;
  3401.    GetSystemInfo(&info);
  3402.    /* Pretend page size is larger so we don't perpetually
  3403.     * call the OS to commit just one page ...
  3404.     */
  3405.    pagesize = info.dwPageSize << 3;
  3406.    allocsize = info.dwAllocationGranularity;
  3407.   }
  3408.  /* This scheme fails eventually if request for contiguous
  3409.   * block is denied so reserve big blocks - this is only 
  3410.   * address space not memory ...
  3411.   */
  3412.  if (brk+need >= reserved)
  3413.   {
  3414.    DWORD size = 64*1024*1024;
  3415.    char *addr;
  3416.    if (committed && reserved && committed < reserved)
  3417.     {
  3418.      /* Commit last of previous chunk cannot span allocations */
  3419.      addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
  3420.      if (addr)
  3421.       committed = reserved;
  3422.     }
  3423.    /* Reserve some (more) space 
  3424.     * Note this is a little sneaky, 1st call passes NULL as reserved
  3425.     * so lets system choose where we start, subsequent calls pass
  3426.     * the old end address so ask for a contiguous block
  3427.     */
  3428.    addr  = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
  3429.    if (addr)
  3430.     {
  3431.      reserved = addr+size;
  3432.      if (!base)
  3433.       base = addr;
  3434.      if (!committed)
  3435.       committed = base;
  3436.      if (!brk)
  3437.       brk = committed;
  3438.     }
  3439.    else
  3440.     {
  3441.      return (void *) -1;
  3442.     }
  3443.   }
  3444.  result = brk;
  3445.  brk += need;
  3446.  if (brk > committed)
  3447.   {
  3448.    DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
  3449.    char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
  3450.    if (addr)
  3451.     {
  3452.      committed += size;
  3453.     }
  3454.    else
  3455.     return (void *) -1;
  3456.   }
  3457.  return result;
  3458. }
  3459.  
  3460. #endif
  3461. #endif
  3462.  
  3463. DllExport void*
  3464. win32_malloc(size_t size)
  3465. {
  3466.     return malloc(size);
  3467. }
  3468.  
  3469. DllExport void*
  3470. win32_calloc(size_t numitems, size_t size)
  3471. {
  3472.     return calloc(numitems,size);
  3473. }
  3474.  
  3475. DllExport void*
  3476. win32_realloc(void *block, size_t size)
  3477. {
  3478.     return realloc(block,size);
  3479. }
  3480.  
  3481. DllExport void
  3482. win32_free(void *block)
  3483. {
  3484.     free(block);
  3485. }
  3486.  
  3487.  
  3488. int
  3489. win32_open_osfhandle(long handle, int flags)
  3490. {
  3491. #ifdef USE_FIXED_OSFHANDLE
  3492.     if (IsWin95())
  3493.     return my_open_osfhandle(handle, flags);
  3494. #endif
  3495.     return _open_osfhandle(handle, flags);
  3496. }
  3497.  
  3498. long
  3499. win32_get_osfhandle(int fd)
  3500. {
  3501.     return _get_osfhandle(fd);
  3502. }
  3503.  
  3504. DllExport void*
  3505. win32_dynaload(const char* filename)
  3506. {
  3507.     dTHXo;
  3508.     HMODULE hModule;
  3509.     if (USING_WIDE()) {
  3510.     WCHAR wfilename[MAX_PATH+1];
  3511.     A2WHELPER(filename, wfilename, sizeof(wfilename));
  3512.     hModule = LoadLibraryExW(PerlDir_mapW(wfilename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
  3513.     }
  3514.     else {
  3515.     hModule = LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
  3516.     }
  3517.     return hModule;
  3518. }
  3519.  
  3520. /*
  3521.  * Extras.
  3522.  */
  3523.  
  3524. static
  3525. XS(w32_GetCwd)
  3526. {
  3527.     dXSARGS;
  3528.     /* Make the host for current directory */
  3529.     char* ptr = PerlEnv_get_childdir();
  3530.     /* 
  3531.      * If ptr != Nullch 
  3532.      *   then it worked, set PV valid, 
  3533.      *   else return 'undef' 
  3534.      */
  3535.     if (ptr) {
  3536.     SV *sv = sv_newmortal();
  3537.     sv_setpv(sv, ptr);
  3538.     PerlEnv_free_childdir(ptr);
  3539.  
  3540.     EXTEND(SP,1);
  3541.     SvPOK_on(sv);
  3542.     ST(0) = sv;
  3543.     XSRETURN(1);
  3544.     }
  3545.     XSRETURN_UNDEF;
  3546. }
  3547.  
  3548. static
  3549. XS(w32_SetCwd)
  3550. {
  3551.     dXSARGS;
  3552.     if (items != 1)
  3553.     Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
  3554.     if (!PerlDir_chdir(SvPV_nolen(ST(0))))
  3555.     XSRETURN_YES;
  3556.  
  3557.     XSRETURN_NO;
  3558. }
  3559.  
  3560. static
  3561. XS(w32_GetNextAvailDrive)
  3562. {
  3563.     dXSARGS;
  3564.     char ix = 'C';
  3565.     char root[] = "_:\\";
  3566.  
  3567.     EXTEND(SP,1);
  3568.     while (ix <= 'Z') {
  3569.     root[0] = ix++;
  3570.     if (GetDriveType(root) == 1) {
  3571.         root[2] = '\0';
  3572.         XSRETURN_PV(root);
  3573.     }
  3574.     }
  3575.     XSRETURN_UNDEF;
  3576. }
  3577.  
  3578. static
  3579. XS(w32_GetLastError)
  3580. {
  3581.     dXSARGS;
  3582.     EXTEND(SP,1);
  3583.     XSRETURN_IV(GetLastError());
  3584. }
  3585.  
  3586. static
  3587. XS(w32_SetLastError)
  3588. {
  3589.     dXSARGS;
  3590.     if (items != 1)
  3591.     Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
  3592.     SetLastError(SvIV(ST(0)));
  3593.     XSRETURN_EMPTY;
  3594. }
  3595.  
  3596. static
  3597. XS(w32_LoginName)
  3598. {
  3599.     dXSARGS;
  3600.     char *name = w32_getlogin_buffer;
  3601.     DWORD size = sizeof(w32_getlogin_buffer);
  3602.     EXTEND(SP,1);
  3603.     if (GetUserName(name,&size)) {
  3604.     /* size includes NULL */
  3605.     ST(0) = sv_2mortal(newSVpvn(name,size-1));
  3606.     XSRETURN(1);
  3607.     }
  3608.     XSRETURN_UNDEF;
  3609. }
  3610.  
  3611. static
  3612. XS(w32_NodeName)
  3613. {
  3614.     dXSARGS;
  3615.     char name[MAX_COMPUTERNAME_LENGTH+1];
  3616.     DWORD size = sizeof(name);
  3617.     EXTEND(SP,1);
  3618.     if (GetComputerName(name,&size)) {
  3619.     /* size does NOT include NULL :-( */
  3620.     ST(0) = sv_2mortal(newSVpvn(name,size));
  3621.     XSRETURN(1);
  3622.     }
  3623.     XSRETURN_UNDEF;
  3624. }
  3625.  
  3626.  
  3627. static
  3628. XS(w32_DomainName)
  3629. {
  3630.     dXSARGS;
  3631.     HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
  3632.     DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
  3633.     DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
  3634.                       void *bufptr);
  3635.  
  3636.     if (hNetApi32) {
  3637.     pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
  3638.         GetProcAddress(hNetApi32, "NetApiBufferFree");
  3639.     pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
  3640.         GetProcAddress(hNetApi32, "NetWkstaGetInfo");
  3641.     }
  3642.     EXTEND(SP,1);
  3643.     if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
  3644.     /* this way is more reliable, in case user has a local account. */
  3645.     char dname[256];
  3646.     DWORD dnamelen = sizeof(dname);
  3647.     struct {
  3648.         DWORD   wki100_platform_id;
  3649.         LPWSTR  wki100_computername;
  3650.         LPWSTR  wki100_langroup;
  3651.         DWORD   wki100_ver_major;
  3652.         DWORD   wki100_ver_minor;
  3653.     } *pwi;
  3654.     /* NERR_Success *is* 0*/
  3655.     if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
  3656.         if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
  3657.         WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
  3658.                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
  3659.         }
  3660.         else {
  3661.         WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
  3662.                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
  3663.         }
  3664.         pfnNetApiBufferFree(pwi);
  3665.         FreeLibrary(hNetApi32);
  3666.         XSRETURN_PV(dname);
  3667.     }
  3668.     FreeLibrary(hNetApi32);
  3669.     }
  3670.     else {
  3671.     /* Win95 doesn't have NetWksta*(), so do it the old way */
  3672.     char name[256];
  3673.     DWORD size = sizeof(name);
  3674.     if (hNetApi32)
  3675.         FreeLibrary(hNetApi32);
  3676.     if (GetUserName(name,&size)) {
  3677.         char sid[ONE_K_BUFSIZE];
  3678.         DWORD sidlen = sizeof(sid);
  3679.         char dname[256];
  3680.         DWORD dnamelen = sizeof(dname);
  3681.         SID_NAME_USE snu;
  3682.         if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
  3683.                   dname, &dnamelen, &snu)) {
  3684.         XSRETURN_PV(dname);        /* all that for this */
  3685.         }
  3686.     }
  3687.     }
  3688.     XSRETURN_UNDEF;
  3689. }
  3690.  
  3691. static
  3692. XS(w32_FsType)
  3693. {
  3694.     dXSARGS;
  3695.     char fsname[256];
  3696.     DWORD flags, filecomplen;
  3697.     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
  3698.              &flags, fsname, sizeof(fsname))) {
  3699.     if (GIMME_V == G_ARRAY) {
  3700.         XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
  3701.         XPUSHs(sv_2mortal(newSViv(flags)));
  3702.         XPUSHs(sv_2mortal(newSViv(filecomplen)));
  3703.         PUTBACK;
  3704.         return;
  3705.     }
  3706.     EXTEND(SP,1);
  3707.     XSRETURN_PV(fsname);
  3708.     }
  3709.     XSRETURN_EMPTY;
  3710. }
  3711.  
  3712. static
  3713. XS(w32_GetOSVersion)
  3714. {
  3715.     dXSARGS;
  3716.     OSVERSIONINFOA osver;
  3717.  
  3718.     if (USING_WIDE()) {
  3719.     OSVERSIONINFOW osverw;
  3720.     char szCSDVersion[sizeof(osverw.szCSDVersion)];
  3721.     osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
  3722.     if (!GetVersionExW(&osverw)) {
  3723.         XSRETURN_EMPTY;
  3724.     }
  3725.     W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
  3726.     XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
  3727.     osver.dwMajorVersion = osverw.dwMajorVersion;
  3728.     osver.dwMinorVersion = osverw.dwMinorVersion;
  3729.     osver.dwBuildNumber = osverw.dwBuildNumber;
  3730.     osver.dwPlatformId = osverw.dwPlatformId;
  3731.     }
  3732.     else {
  3733.     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
  3734.     if (!GetVersionExA(&osver)) {
  3735.         XSRETURN_EMPTY;
  3736.     }
  3737.     XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
  3738.     }
  3739.     XPUSHs(newSViv(osver.dwMajorVersion));
  3740.     XPUSHs(newSViv(osver.dwMinorVersion));
  3741.     XPUSHs(newSViv(osver.dwBuildNumber));
  3742.     XPUSHs(newSViv(osver.dwPlatformId));
  3743.     PUTBACK;
  3744. }
  3745.  
  3746. static
  3747. XS(w32_IsWinNT)
  3748. {
  3749.     dXSARGS;
  3750.     EXTEND(SP,1);
  3751.     XSRETURN_IV(IsWinNT());
  3752. }
  3753.  
  3754. static
  3755. XS(w32_IsWin95)
  3756. {
  3757.     dXSARGS;
  3758.     EXTEND(SP,1);
  3759.     XSRETURN_IV(IsWin95());
  3760. }
  3761.  
  3762. static
  3763. XS(w32_FormatMessage)
  3764. {
  3765.     dXSARGS;
  3766.     DWORD source = 0;
  3767.     char msgbuf[ONE_K_BUFSIZE];
  3768.  
  3769.     if (items != 1)
  3770.     Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
  3771.  
  3772.     if (USING_WIDE()) {
  3773.     WCHAR wmsgbuf[ONE_K_BUFSIZE];
  3774.     if (FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM,
  3775.               &source, SvIV(ST(0)), 0,
  3776.               wmsgbuf, ONE_K_BUFSIZE-1, NULL))
  3777.     {
  3778.         W2AHELPER(wmsgbuf, msgbuf, sizeof(msgbuf));
  3779.         XSRETURN_PV(msgbuf);
  3780.     }
  3781.     }
  3782.     else {
  3783.     if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
  3784.               &source, SvIV(ST(0)), 0,
  3785.               msgbuf, sizeof(msgbuf)-1, NULL))
  3786.         XSRETURN_PV(msgbuf);
  3787.     }
  3788.  
  3789.     XSRETURN_UNDEF;
  3790. }
  3791.  
  3792. static
  3793. XS(w32_Spawn)
  3794. {
  3795.     dXSARGS;
  3796.     char *cmd, *args;
  3797.     PROCESS_INFORMATION stProcInfo;
  3798.     STARTUPINFO stStartInfo;
  3799.     BOOL bSuccess = FALSE;
  3800.  
  3801.     if (items != 3)
  3802.     Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
  3803.  
  3804.     cmd = SvPV_nolen(ST(0));
  3805.     args = SvPV_nolen(ST(1));
  3806.  
  3807.     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
  3808.     stStartInfo.cb = sizeof(stStartInfo);        /* Set the structure size */
  3809.     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;        /* Enable wShowWindow control */
  3810.     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
  3811.  
  3812.     if (CreateProcess(
  3813.         cmd,            /* Image path */
  3814.         args,             /* Arguments for command line */
  3815.         NULL,            /* Default process security */
  3816.         NULL,            /* Default thread security */
  3817.         FALSE,            /* Must be TRUE to use std handles */
  3818.         NORMAL_PRIORITY_CLASS,    /* No special scheduling */
  3819.         NULL,            /* Inherit our environment block */
  3820.         NULL,            /* Inherit our currrent directory */
  3821.         &stStartInfo,        /* -> Startup info */
  3822.         &stProcInfo))        /* <- Process info (if OK) */
  3823.     {
  3824.     CloseHandle(stProcInfo.hThread);/* library source code does this. */
  3825.     sv_setiv(ST(2), stProcInfo.dwProcessId);
  3826.     bSuccess = TRUE;
  3827.     }
  3828.     XSRETURN_IV(bSuccess);
  3829. }
  3830.  
  3831. static
  3832. XS(w32_GetTickCount)
  3833. {
  3834.     dXSARGS;
  3835.     DWORD msec = GetTickCount();
  3836.     EXTEND(SP,1);
  3837.     if ((IV)msec > 0)
  3838.     XSRETURN_IV(msec);
  3839.     XSRETURN_NV(msec);
  3840. }
  3841.  
  3842. static
  3843. XS(w32_GetShortPathName)
  3844. {
  3845.     dXSARGS;
  3846.     SV *shortpath;
  3847.     DWORD len;
  3848.  
  3849.     if (items != 1)
  3850.     Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
  3851.  
  3852.     shortpath = sv_mortalcopy(ST(0));
  3853.     SvUPGRADE(shortpath, SVt_PV);
  3854.     /* src == target is allowed */
  3855.     do {
  3856.     len = GetShortPathName(SvPVX(shortpath),
  3857.                    SvPVX(shortpath),
  3858.                    SvLEN(shortpath));
  3859.     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
  3860.     if (len) {
  3861.     SvCUR_set(shortpath,len);
  3862.     ST(0) = shortpath;
  3863.     XSRETURN(1);
  3864.     }
  3865.     XSRETURN_UNDEF;
  3866. }
  3867.  
  3868. static
  3869. XS(w32_GetFullPathName)
  3870. {
  3871.     dXSARGS;
  3872.     SV *filename;
  3873.     SV *fullpath;
  3874.     char *filepart;
  3875.     DWORD len;
  3876.  
  3877.     if (items != 1)
  3878.     Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
  3879.  
  3880.     filename = ST(0);
  3881.     fullpath = sv_mortalcopy(filename);
  3882.     SvUPGRADE(fullpath, SVt_PV);
  3883.     do {
  3884.     len = GetFullPathName(SvPVX(filename),
  3885.                   SvLEN(fullpath),
  3886.                   SvPVX(fullpath),
  3887.                   &filepart);
  3888.     } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
  3889.     if (len) {
  3890.     if (GIMME_V == G_ARRAY) {
  3891.         EXTEND(SP,1);
  3892.         XST_mPV(1,filepart);
  3893.         len = filepart - SvPVX(fullpath);
  3894.         items = 2;
  3895.     }
  3896.     SvCUR_set(fullpath,len);
  3897.     ST(0) = fullpath;
  3898.     XSRETURN(items);
  3899.     }
  3900.     XSRETURN_EMPTY;
  3901. }
  3902.  
  3903. static
  3904. XS(w32_GetLongPathName)
  3905. {
  3906.     dXSARGS;
  3907.     SV *path;
  3908.     char tmpbuf[MAX_PATH+1];
  3909.     char *pathstr;
  3910.     STRLEN len;
  3911.  
  3912.     if (items != 1)
  3913.     Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
  3914.  
  3915.     path = ST(0);
  3916.     pathstr = SvPV(path,len);
  3917.     strcpy(tmpbuf, pathstr);
  3918.     pathstr = win32_longpath(tmpbuf);
  3919.     if (pathstr) {
  3920.     ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
  3921.     XSRETURN(1);
  3922.     }
  3923.     XSRETURN_EMPTY;
  3924. }
  3925.  
  3926. static
  3927. XS(w32_Sleep)
  3928. {
  3929.     dXSARGS;
  3930.     if (items != 1)
  3931.     Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
  3932.     Sleep(SvIV(ST(0)));
  3933.     XSRETURN_YES;
  3934. }
  3935.  
  3936. static
  3937. XS(w32_CopyFile)
  3938. {
  3939.     dXSARGS;
  3940.     BOOL bResult;
  3941.     if (items != 3)
  3942.     Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
  3943.     if (USING_WIDE()) {
  3944.     WCHAR wSourceFile[MAX_PATH+1];
  3945.     WCHAR wDestFile[MAX_PATH+1];
  3946.     A2WHELPER(SvPV_nolen(ST(0)), wSourceFile, sizeof(wSourceFile));
  3947.     wcscpy(wSourceFile, PerlDir_mapW(wSourceFile));
  3948.     A2WHELPER(SvPV_nolen(ST(1)), wDestFile, sizeof(wDestFile));
  3949.     bResult = CopyFileW(wSourceFile, PerlDir_mapW(wDestFile), !SvTRUE(ST(2)));
  3950.     }
  3951.     else {
  3952.     char szSourceFile[MAX_PATH+1];
  3953.     strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
  3954.     bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
  3955.     }
  3956.  
  3957.     if (bResult)
  3958.     XSRETURN_YES;
  3959.     XSRETURN_NO;
  3960. }
  3961.  
  3962. void
  3963. Perl_init_os_extras(void)
  3964. {
  3965.     dTHXo;
  3966.     char *file = __FILE__;
  3967.     dXSUB_SYS;
  3968.  
  3969.     w32_perlshell_tokens = Nullch;
  3970.     w32_perlshell_items = -1;
  3971.     w32_fdpid = newAV();        /* XXX needs to be in Perl_win32_init()? */
  3972.     New(1313, w32_children, 1, child_tab);
  3973.     w32_num_children = 0;
  3974.     w32_init_socktype = 0;
  3975. #ifdef USE_ITHREADS
  3976.     w32_pseudo_id = 0;
  3977.     New(1313, w32_pseudo_children, 1, child_tab);
  3978.     w32_num_pseudo_children = 0;
  3979. #endif
  3980.  
  3981.     /* these names are Activeware compatible */
  3982.     newXS("Win32::GetCwd", w32_GetCwd, file);
  3983.     newXS("Win32::SetCwd", w32_SetCwd, file);
  3984.     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
  3985.     newXS("Win32::GetLastError", w32_GetLastError, file);
  3986.     newXS("Win32::SetLastError", w32_SetLastError, file);
  3987.     newXS("Win32::LoginName", w32_LoginName, file);
  3988.     newXS("Win32::NodeName", w32_NodeName, file);
  3989.     newXS("Win32::DomainName", w32_DomainName, file);
  3990.     newXS("Win32::FsType", w32_FsType, file);
  3991.     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
  3992.     newXS("Win32::IsWinNT", w32_IsWinNT, file);
  3993.     newXS("Win32::IsWin95", w32_IsWin95, file);
  3994.     newXS("Win32::FormatMessage", w32_FormatMessage, file);
  3995.     newXS("Win32::Spawn", w32_Spawn, file);
  3996.     newXS("Win32::GetTickCount", w32_GetTickCount, file);
  3997.     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
  3998.     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
  3999.     newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
  4000.     newXS("Win32::CopyFile", w32_CopyFile, file);
  4001.     newXS("Win32::Sleep", w32_Sleep, file);
  4002.  
  4003.     /* XXX Bloat Alert! The following Activeware preloads really
  4004.      * ought to be part of Win32::Sys::*, so they're not included
  4005.      * here.
  4006.      */
  4007.     /* LookupAccountName
  4008.      * LookupAccountSID
  4009.      * InitiateSystemShutdown
  4010.      * AbortSystemShutdown
  4011.      * ExpandEnvrironmentStrings
  4012.      */
  4013. }
  4014.  
  4015. void
  4016. Perl_win32_init(int *argcp, char ***argvp)
  4017. {
  4018.     /* Disable floating point errors, Perl will trap the ones we
  4019.      * care about.  VC++ RTL defaults to switching these off
  4020.      * already, but the Borland RTL doesn't.  Since we don't
  4021.      * want to be at the vendor's whim on the default, we set
  4022.      * it explicitly here.
  4023.      */
  4024. #if !defined(_ALPHA_) && !defined(__GNUC__)
  4025.     _control87(MCW_EM, MCW_EM);
  4026. #endif
  4027.     MALLOC_INIT;
  4028. }
  4029.  
  4030. void
  4031. win32_get_child_IO(child_IO_table* ptbl)
  4032. {
  4033.     ptbl->childStdIn    = GetStdHandle(STD_INPUT_HANDLE);
  4034.     ptbl->childStdOut    = GetStdHandle(STD_OUTPUT_HANDLE);
  4035.     ptbl->childStdErr    = GetStdHandle(STD_ERROR_HANDLE);
  4036. }
  4037.  
  4038.  
  4039. #ifdef USE_ITHREADS
  4040.  
  4041. #  ifdef PERL_OBJECT
  4042. #    undef Perl_sys_intern_dup
  4043. #    define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
  4044. #    define pPerl this
  4045. #  endif
  4046.  
  4047. void
  4048. Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
  4049. {
  4050.     dst->perlshell_tokens    = Nullch;
  4051.     dst->perlshell_vec        = (char**)NULL;
  4052.     dst->perlshell_items    = 0;
  4053.     dst->fdpid            = newAV();
  4054.     Newz(1313, dst->children, 1, child_tab);
  4055.     Newz(1313, dst->pseudo_children, 1, child_tab);
  4056.     dst->pseudo_id        = 0;
  4057.     dst->children->num        = 0;
  4058.     dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
  4059. }
  4060. #endif
  4061.  
  4062. #ifdef PERL_OBJECT
  4063. #  undef this
  4064. #  define this pPerl
  4065. #endif
  4066.  
  4067. static void
  4068. win32_free_argvw(pTHXo_ void *ptr)
  4069. {
  4070.     char** argv = (char**)ptr;
  4071.     while(*argv) {
  4072.     Safefree(*argv);
  4073.     *argv++ = Nullch;
  4074.     }
  4075. }
  4076.  
  4077. void
  4078. win32_argv2utf8(int argc, char** argv)
  4079. {
  4080.     dTHXo;
  4081.     char* psz;
  4082.     int length, wargc;
  4083.     LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
  4084.     if (lpwStr && argc) {
  4085.     while (argc--) {
  4086.         length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
  4087.         Newz(0, psz, length, char);
  4088.         WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
  4089.         argv[argc] = psz;
  4090.     }
  4091.     call_atexit(win32_free_argvw, argv);
  4092.     }
  4093.     GlobalFree((HGLOBAL)lpwStr);
  4094. }
  4095.  
  4096.