:utf8 works only with perlio.
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 30d63c6..b23ce65 100644 (file)
@@ -586,6 +586,30 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     return (status);
 }
 
+/* returns pointer to the next unquoted space or the end of the string */
+static char*
+find_next_space(const char *s)
+{
+    bool in_quotes = FALSE;
+    while (*s) {
+       /* ignore doubled backslashes, or backslash+quote */
+       if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
+           s += 2;
+       }
+       /* keep track of when we're within quotes */
+       else if (*s == '"') {
+           s++;
+           in_quotes = !in_quotes;
+       }
+       /* break it up only at spaces that aren't in quotes */
+       else if (!in_quotes && isSPACE(*s))
+           return (char*)s;
+       else
+           s++;
+    }
+    return (char*)s;
+}
+
 int
 do_spawn2(char *cmd, int exectype)
 {
@@ -609,8 +633,7 @@ do_spawn2(char *cmd, int exectype)
                s++;
            if (*s)
                *(a++) = s;
-           while (*s && !isSPACE(*s))
-               s++;
+           s = find_next_space(s);
            if (*s)
                *s++ = '\0';
        }
@@ -1809,6 +1832,8 @@ FAILED:
     return -1;
 }
 
+#ifndef PERL_IMPLICIT_CONTEXT
+
 static UINT timerid = 0;
 
 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
@@ -1819,9 +1844,12 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
     CALL_FPTR(PL_sighandlerp)(14);
 }
 
+#endif /* !PERL_IMPLICIT_CONTEXT */
+
 DllExport unsigned int
 win32_alarm(unsigned int sec)
 {
+#ifndef PERL_IMPLICIT_CONTEXT
     /* 
      * the 'obvious' implentation is SetTimer() with a callback
      * which does whatever receiving SIGALRM would do 
@@ -1846,6 +1874,7 @@ win32_alarm(unsigned int sec)
         timerid=0;  
        }
      }
+#endif /* !PERL_IMPLICIT_CONTEXT */
     return 0;
 }
 
@@ -2305,7 +2334,31 @@ win32_rewind(FILE *pf)
 DllExport FILE*
 win32_tmpfile(void)
 {
-    return tmpfile();
+    dTHX;
+    char prefix[MAX_PATH+1];
+    char filename[MAX_PATH+1];
+    DWORD len = GetTempPath(MAX_PATH, prefix);
+    if (len && len < MAX_PATH) {
+       if (GetTempFileName(prefix, "plx", 0, filename)) {
+           HANDLE fh = CreateFile(filename,
+                                  DELETE | GENERIC_READ | GENERIC_WRITE,
+                                  0,
+                                  NULL,
+                                  CREATE_ALWAYS,
+                                  FILE_ATTRIBUTE_NORMAL
+                                  | FILE_FLAG_DELETE_ON_CLOSE,
+                                  NULL);
+           if (fh != INVALID_HANDLE_VALUE) {
+               int fd = win32_open_osfhandle((long)fh, 0);
+               if (fd >= 0) {
+                   DEBUG_p(PerlIO_printf(Perl_debug_log,
+                                         "Created tmpfile=%s\n",filename));
+                   return fdopen(fd, "w+b");
+               }
+           }
+       }
+    }
+    return NULL;
 }
 
 DllExport void
@@ -3008,7 +3061,7 @@ win32_rmdir(const char *dir)
 DllExport int
 win32_chdir(const char *dir)
 {
-    dTHXo;
+    dTHX;
     if (!dir) {
        errno = ENOENT;
        return -1;
@@ -3047,26 +3100,145 @@ win32_chmod(const char *path, int mode)
 
 
 static char *
-create_command_line(const char* command, const char * const *args)
+create_command_line(char *cname, STRLEN clen, const char * const *args)
 {
     dTHX;
-    int index;
-    char *cmd, *ptr, *arg;
-    STRLEN len = strlen(command) + 1;
+    int index, argc;
+    char *cmd, *ptr;
+    const char *arg;
+    STRLEN len = 0;
+    bool bat_file = FALSE;
+    bool cmd_shell = FALSE;
+    bool extra_quotes = FALSE;
+    bool quote_next = FALSE;
+
+    if (!cname)
+       cname = (char*)args[0];
+
+    /* The NT cmd.exe shell has the following peculiarity that needs to be
+     * worked around.  It strips a leading and trailing dquote when any
+     * of the following is true:
+     *    1. the /S switch was used
+     *    2. there are more than two dquotes
+     *    3. there is a special character from this set: &<>()@^|
+     *    4. no whitespace characters within the two dquotes
+     *    5. string between two dquotes isn't an executable file
+     * To work around this, we always add a leading and trailing dquote
+     * to the string, if the first argument is either "cmd.exe" or "cmd",
+     * and there were at least two or more arguments passed to cmd.exe
+     * (not including switches).
+     * XXX the above rules (from "cmd /?") don't seem to be applied
+     * always, making for the convolutions below :-(
+     */
+    if (cname) {
+       if (!clen)
+           clen = strlen(cname);
+
+       if (clen > 4
+           && (stricmp(&cname[clen-4], ".bat") == 0
+               || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
+       {
+           bat_file = TRUE;
+           len += 3;
+       }
+       else {
+           char *exe = strrchr(cname, '/');
+           char *exe2 = strrchr(cname, '\\');
+           if (exe2 > exe)
+               exe = exe2;
+           if (exe)
+               ++exe;
+           else
+               exe = cname;
+           if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
+               cmd_shell = TRUE;
+               len += 3;
+           }
+       }
+    }
 
-    for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
-       len += strlen(ptr) + 1;
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+       STRLEN curlen = strlen(arg);
+       if (!(arg[0] == '"' && arg[curlen-1] == '"'))
+           len += 2;   /* assume quoting needed (worst case) */
+       len += curlen + 1;
+       DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
+    }
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
 
+    argc = index;
     New(1310, cmd, len, char);
     ptr = cmd;
-    strcpy(ptr, command);
+
+    if (bat_file) {
+       *ptr++ = '"';
+       extra_quotes = TRUE;
+    }
 
     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
-       ptr += strlen(ptr);
-       *ptr++ = ' ';
+       bool do_quote = 0;
+       STRLEN curlen = strlen(arg);
+
+       /* we want to protect empty arguments and ones with spaces with
+        * dquotes, but only if they aren't already there */
+       if (!curlen) {
+           do_quote = 1;
+       }
+       else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
+           STRLEN i = 0;
+           while (i < curlen) {
+               if (isSPACE(arg[i])) {
+                   do_quote = 1;
+                   break;
+               }
+               i++;
+           }
+       }
+       else if (quote_next) {
+           /* ok, we know the argument already has quotes; see if it
+            * really is multiple arguments pretending to be one and
+            * force a set of quotes around it */
+           if (*find_next_space(arg))
+               do_quote = 1;
+       }
+
+       if (do_quote)
+           *ptr++ = '"';
+
        strcpy(ptr, arg);
+       ptr += curlen;
+
+       if (do_quote)
+           *ptr++ = '"';
+
+       if (args[index+1])
+           *ptr++ = ' ';
+
+       if (!extra_quotes
+           && cmd_shell
+           && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0))
+       {
+           /* is there a next argument? */
+           if (args[index+1]) {
+               /* are there two or more next arguments? */
+               if (args[index+2]) {
+                   *ptr++ = '"';
+                   extra_quotes = TRUE;
+               }
+               else {
+                   /* single argument, force quoting if unquoted */
+                   quote_next = TRUE;
+               }
+           }
+       }
     }
 
+    if (extra_quotes)
+       *ptr++ = '"';
+
+    *ptr = '\0';
+
     return cmd;
 }
 
@@ -3164,19 +3336,39 @@ GIVE_UP:
  * environment and the current directory to CreateProcess
  */
 
-void*
-get_childenv(void)
+DllExport void*
+win32_get_childenv(void)
 {
     return NULL;
 }
 
-void
-free_childenv(void* d)
+DllExport void
+win32_free_childenv(void* d)
 {
 }
 
-char*
-get_childdir(void)
+DllExport void
+win32_clearenv(void)
+{
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+       char *end = strchr(cur,'=');
+       if (end && end != cur) {
+           *end = '\0';
+           SetEnvironmentVariable(cur, NULL);
+           *end = '=';
+           cur = end + strlen(end+1)+2;
+       }
+       else if ((len = strlen(cur)))
+           cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
+}
+
+DllExport char*
+win32_get_childdir(void)
 {
     dTHX;
     char* ptr;
@@ -3195,8 +3387,8 @@ get_childdir(void)
     return ptr;
 }
 
-void
-free_childdir(char* d)
+DllExport void
+win32_free_childdir(char* d)
 {
     dTHX;
     Safefree(d);
@@ -3228,10 +3420,30 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     STARTUPINFO StartupInfo;
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
-
-    char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
-                                            ? &argv[1] : argv);
+    char *cmd;
     char *fullcmd = Nullch;
+    char *cname = (char *)cmdname;
+    STRLEN clen = 0;
+
+    if (cname) {
+       clen = strlen(cname);
+       /* if command name contains dquotes, must remove them */
+       if (strchr(cname, '"')) {
+           cmd = cname;
+           New(0,cname,clen+1,char);
+           clen = 0;
+           while (*cmd) {
+               if (*cmd != '"') {
+                   cname[clen] = *cmd;
+                   ++clen;
+               }
+               ++cmd;
+           }
+           cname[clen] = '\0';
+       }
+    }
+
+    cmd = create_command_line(cname, clen, argv);
 
     env = PerlEnv_get_childenv();
     dir = PerlEnv_get_childdir();
@@ -3277,8 +3489,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
        create |= CREATE_NEW_CONSOLE;
     }
 
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
+                         cname,cmd));
 RETRY:
-    if (!CreateProcess(cmdname,                /* search PATH to find executable */
+    if (!CreateProcess(cname,          /* search PATH to find executable */
                       cmd,             /* executable, and its arguments */
                       NULL,            /* process attributes */
                       NULL,            /* thread attributes */
@@ -3296,9 +3510,14 @@ RETRY:
         * jump through our own hoops by picking out the path
         * we really want it to use. */
        if (!fullcmd) {
-           fullcmd = qualified_path(cmdname);
+           fullcmd = qualified_path(cname);
            if (fullcmd) {
-               cmdname = fullcmd;
+               if (cname != cmdname)
+                   Safefree(cname);
+               cname = fullcmd;
+               DEBUG_p(PerlIO_printf(Perl_debug_log,
+                                     "Retrying [%s] with same args\n",
+                                     cname));
                goto RETRY;
            }
        }
@@ -3331,7 +3550,8 @@ RETVAL:
     PerlEnv_free_childenv(env);
     PerlEnv_free_childdir(dir);
     Safefree(cmd);
-    Safefree(fullcmd);
+    if (cname != cmdname)
+       Safefree(cname);
     return ret;
 #endif
 }
@@ -3445,12 +3665,12 @@ win32_putchar(int c)
 
 #ifndef USE_PERL_SBRK
 
-static char *committed = NULL;
-static char *base      = NULL;
-static char *reserved  = NULL;
-static char *brk       = NULL;
-static DWORD pagesize  = 0;
-static DWORD allocsize = 0;
+static char *committed = NULL;         /* XXX threadead */
+static char *base      = NULL;         /* XXX threadead */
+static char *reserved  = NULL;         /* XXX threadead */
+static char *brk       = NULL;         /* XXX threadead */
+static DWORD pagesize  = 0;            /* XXX threadead */
+static DWORD allocsize = 0;            /* XXX threadead */
 
 void *
 sbrk(int need)