Re: [ID 20010215.006] Bad arg length for Socket::unpack_sockaddr_un, length is 14 ...

[p5sagit/p5-mst-13.2.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index e4e553c..d2d70e5 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -581,7 +581,6 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     }
     else {
        if (status < 0) {
-           dTHR;
            if (ckWARN(WARN_EXEC))
                Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno));
            status = 255 * 256;
@@ -674,7 +673,6 @@ do_spawn2(char *cmd, int exectype)
     }
     else {
        if (status < 0) {
-           dTHR;
            if (ckWARN(WARN_EXEC))
                Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
                     (exectype == EXECF_EXEC ? "exec" : "spawn"),
@@ -977,31 +975,31 @@ chown(const char *path, uid_t owner, gid_t group)
     return 0;
 }
 
-/*\r
- * XXX this needs strengthening  (for PerlIO)\r
- *   -- BKS, 11-11-200\r
-*/\r
-int mkstemp(const char *path)\r
-{\r
-    dTHX;\r
-    char buf[MAX_PATH+1];\r
-    int i = 0, fd = -1;\r
-\r
-retry:\r
-    if (i++ > 10) { /* give up */\r
-       errno = ENOENT;\r
-       return -1;\r
-    }\r
-    if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {\r
-       errno = ENOENT;\r
-       return -1;\r
-    }\r
-    fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);\r
-    if (fd == -1)\r
-       goto retry;\r
-    return fd;\r
-}\r
-\r
+/*
+ * XXX this needs strengthening  (for PerlIO)
+ *   -- BKS, 11-11-200
+*/
+int mkstemp(const char *path)
+{
+    dTHX;
+    char buf[MAX_PATH+1];
+    int i = 0, fd = -1;
+
+retry:
+    if (i++ > 10) { /* give up */
+       errno = ENOENT;
+       return -1;
+    }
+    if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) {
+       errno = ENOENT;
+       return -1;
+    }
+    fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600);
+    if (fd == -1)
+       goto retry;
+    return fd;
+}
+
 static long
 find_pid(int pid)
 {
@@ -1324,8 +1322,6 @@ win32_longpath(char *path)
     return path;
 }
 
-#ifndef USE_WIN32_RTL_ENV
-
 DllExport char *
 win32_getenv(const char *name)
 {
@@ -1427,8 +1423,6 @@ win32_putenv(const char *name)
     return relval;
 }
 
-#endif
-
 static long
 filetime_to_clock(PFILETIME ft)
 {
@@ -1875,7 +1869,6 @@ win32_crypt(const char *txt, const char *salt)
 {
     dTHXo;
 #ifdef HAVE_DES_FCRYPT
-    dTHR;
     return des_fcrypt(txt, salt, w32_crypt_buffer);
 #else
     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
@@ -2353,7 +2346,7 @@ win32_fstat(int fd,struct stat *sbufptr)
     }
     return rc;
 #else
-    return fstat(fd,sbufptr);
+    return my_fstat(fd,sbufptr);
 #endif
 }
 
@@ -2363,13 +2356,21 @@ win32_pipe(int *pfd, unsigned int size, int mode)
     return _pipe(pfd, size, mode);
 }
 
+DllExport PerlIO*
+win32_popenlist(const char *mode, IV narg, SV **args)
+{
+ dTHX;
+ Perl_croak(aTHX_ "List form of pipe open not implemented");
+ return NULL;
+}
+
 /*
  * a popen() clone that respects PERL5SHELL
- *\r
- * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000\r
+ *
+ * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
  */
 
-DllExport PerlIO*\r
+DllExport PerlIO*
 win32_popen(const char *command, const char *mode)
 {
 #ifdef USE_RTL_POPEN
@@ -2443,11 +2444,7 @@ win32_popen(const char *command, const char *mode)
     }
 
     /* we have an fd, return a file stream */
-#ifdef USE_PERLIO\r
-    return (PerlIO_fdopen(p[parent], (char *)mode));\r
-#else\r
-    return (fdopen(p[parent], (char *)mode));\r
-#endif\r
+    return (PerlIO_fdopen(p[parent], (char *)mode));
 
 cleanup:
     /* we don't need to check for errors here */
@@ -2467,7 +2464,7 @@ cleanup:
  */
 
 DllExport int
-win32_pclose(PerlIO *pf)\r
+win32_pclose(PerlIO *pf)
 {
 #ifdef USE_RTL_POPEN
     return _pclose(pf);
@@ -2477,7 +2474,7 @@ win32_pclose(PerlIO *pf)
     SV *sv;
 
     LOCK_FDPID_MUTEX;
-    sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);\r
+    sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
 
     if (SvIOK(sv))
        childpid = SvIVX(sv);
@@ -2489,11 +2486,11 @@ win32_pclose(PerlIO *pf)
         return -1;
     }
 
-#ifdef USE_PERLIO\r
-    PerlIO_close(pf);\r
-#else\r
-    fclose(pf);\r
-#endif\r
+#ifdef USE_PERLIO
+    PerlIO_close(pf);
+#else
+    fclose(pf);
+#endif
     SvIVX(sv) = 0;
     UNLOCK_FDPID_MUTEX;
 
@@ -2755,13 +2752,13 @@ win32_open(const char *path, int flag, ...)
     return open(PerlDir_mapA(path), flag, pmode);
 }
 
-/* close() that understands socket */\r
-extern int my_close(int);      /* in win32sck.c */\r
-\r
+/* close() that understands socket */
+extern int my_close(int);      /* in win32sck.c */
+
 DllExport int
 win32_close(int fd)
 {
-    return my_close(fd);\r
+    return my_close(fd);
 }
 
 DllExport int
@@ -3875,6 +3872,8 @@ XS(w32_Spawn)
 {
     dXSARGS;
     char *cmd, *args;
+    void *env;
+    char *dir;
     PROCESS_INFORMATION stProcInfo;
     STARTUPINFO stStartInfo;
     BOOL bSuccess = FALSE;
@@ -3885,6 +3884,9 @@ XS(w32_Spawn)
     cmd = SvPV_nolen(ST(0));
     args = SvPV_nolen(ST(1));
 
+    env = PerlEnv_get_childenv();
+    dir = PerlEnv_get_childdir();
+
     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
     stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
@@ -3897,8 +3899,8 @@ XS(w32_Spawn)
                NULL,                   /* Default thread security */
                FALSE,                  /* Must be TRUE to use std handles */
                NORMAL_PRIORITY_CLASS,  /* No special scheduling */
-               NULL,                   /* Inherit our environment block */
-               NULL,                   /* Inherit our currrent directory */
+               env,                    /* Inherit our environment block */
+               dir,                    /* Inherit our currrent directory */
                &stStartInfo,           /* -> Startup info */
                &stProcInfo))           /* <- Process info (if OK) */
     {
@@ -3909,6 +3911,8 @@ XS(w32_Spawn)
        CloseHandle(stProcInfo.hThread);/* library source code does this. */
        bSuccess = TRUE;
     }
+    PerlEnv_free_childenv(env);
+    PerlEnv_free_childdir(dir);
     XSRETURN_IV(bSuccess);
 }