Give more meaningful error message when trying to run programs

On non-Windows, the child thread now comunicates any errors back to the
parent thread via pipes.

System/Process/Internals.hs

@@ -54,6 +54,7 @@ import System.IO
 import System.IO.Unsafe
 import Control.Concurrent
 import Control.Exception
+import Control.Monad
 import Foreign.C
 import Foreign
 
@@ -220,6 +221,7 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
    alloca $ \ pfdStdInput  ->
    alloca $ \ pfdStdOutput ->
    alloca $ \ pfdStdError  ->
+   alloca $ \ pFailedDoing ->
    maybeWith withCEnvironment mb_env $ \pEnv ->
    maybeWith withFilePath mb_cwd $ \pWorkDir ->
    withMany withFilePath (cmd:args) $ \cstrs ->
@@ -243,13 +245,18 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
      -- operation, we better ensure mutual exclusion of calls to
      -- runInteractiveProcess().
      proc_handle <- withMVar runInteractiveProcess_lock $ \_ ->
-                    throwErrnoIfMinus1 fun $
-                         c_runInteractiveProcess pargs pWorkDir pEnv 
+                         c_runInteractiveProcess pargs pWorkDir pEnv
                                 fdin fdout fderr
                                 pfdStdInput pfdStdOutput pfdStdError
                                 set_int inthand set_quit quithand
                                 ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
                                 .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))
+                                pFailedDoing
+
+     when (proc_handle == -1) $ do
+         cFailedDoing <- peek pFailedDoing
+         failedDoing <- peekCString cFailedDoing
+         throwErrno (fun ++ ": " ++ failedDoing)
 
      hndStdInput  <- mbPipe mb_stdin  pfdStdInput  WriteMode
      hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode
@@ -278,6 +285,7 @@ foreign import ccall unsafe "runInteractiveProcess"
         -> CInt                         -- non-zero: set child's SIGQUIT handler
         -> CLong                        -- SIGQUIT handler
         -> CInt                         -- flags
+        -> Ptr CString
         -> IO PHANDLE
 
 #endif /* __GLASGOW_HASKELL__ */

cbits/runProcess.c

@@ -35,6 +35,24 @@ static long max_fd = 0;
 extern void blockUserSignals(void);
 extern void unblockUserSignals(void);
 
+// See #1593.  The convention for the exit code when
+// exec() fails seems to be 127 (gleened from C's
+// system()), but there's no equivalent convention for
+// chdir(), so I'm picking 126 --SimonM.
+#define forkChdirFailed 126
+#define forkExecFailed  127
+
+__attribute__((__noreturn__))
+static void childFailed(int pipe, int failCode) {
+    int err;
+
+    err = errno;
+    write(pipe, &failCode, sizeof(failCode));
+    write(pipe, &err,      sizeof(err));
+    // As a fallback, exit with the failCode
+    _exit(failCode);
+}
+
 ProcHandle
 runInteractiveProcess (char *const args[],
                        char *workingDirectory, char **environment,
@@ -42,37 +60,45 @@ runInteractiveProcess (char *const args[],
                        int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,
                        int set_inthandler, long inthandler,
                        int set_quithandler, long quithandler,
-                       int flags)
+                       int flags,
+                       char **failed_doing)
 {
     int close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0);
     int pid;
     int fdStdInput[2], fdStdOutput[2], fdStdError[2];
+    int forkCommunicationFds[2];
     int r;
-    struct sigaction dfl;
+    int failCode, err;
 
     // Ordering matters here, see below [Note #431].
     if (fdStdIn == -1) {
         r = pipe(fdStdInput);
         if (r == -1) {
-            sysErrorBelch("runInteractiveProcess: pipe");
+            *failed_doing = "runInteractiveProcess: pipe";
             return -1;
         }
     }
     if (fdStdOut == -1) {
         r = pipe(fdStdOutput);
         if (r == -1) {
-            sysErrorBelch("runInteractiveProcess: pipe");
+            *failed_doing = "runInteractiveProcess: pipe";
             return -1;
         }
     }
     if (fdStdErr == -1) {
         r = pipe(fdStdError);
         if (r == -1) {
-            sysErrorBelch("runInteractiveProcess: pipe");
+            *failed_doing = "runInteractiveProcess: pipe";
             return -1;
         }
     }
 
+    r = pipe(forkCommunicationFds);
+    if (r == -1) {
+        *failed_doing = "runInteractiveProcess: pipe";
+        return -1;
+    }
+
     // Block signals with Haskell handlers.  The danger here is that
     // with the threaded RTS, a signal arrives in the child process,
     // the RTS writes the signal information into the pipe (which is
@@ -101,12 +127,18 @@ runInteractiveProcess (char *const args[],
             close(fdStdError[0]);
             close(fdStdError[1]);
         }
+        close(forkCommunicationFds[0]);
+        close(forkCommunicationFds[1]);
+        *failed_doing = "fork";
         return -1;
 
     case 0:
-    {
-        // WARNING!  we are now in the child of vfork(), so any memory
-        // we modify below will also be seen in the parent process.
+        // WARNING! We may now be in the child of vfork(), and any
+        // memory we modify below may also be seen in the parent
+        // process.
+
+        close(forkCommunicationFds[0]);
+        fcntl(forkCommunicationFds[1], F_SETFD, FD_CLOEXEC);
 
         if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {
             setpgid(0, 0);
@@ -116,11 +148,7 @@ runInteractiveProcess (char *const args[],
 
         if (workingDirectory) {
             if (chdir (workingDirectory) < 0) {
-                // See #1593.  The convention for the exit code when
-                // exec() fails seems to be 127 (gleened from C's
-                // system()), but there's no equivalent convention for
-                // chdir(), so I'm picking 126 --SimonM.
-                _exit(126);
+                childFailed(forkCommunicationFds[1], forkChdirFailed);
             }
         }
 
@@ -172,6 +200,7 @@ runInteractiveProcess (char *const args[],
                 max_fd = 256;
 #endif
             }
+            // XXX Not the pipe
             for (i = 3; i < max_fd; i++) {
                 close(i);
             }
@@ -179,25 +208,30 @@ runInteractiveProcess (char *const args[],
 
         /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested
          */
-        (void)sigemptyset(&dfl.sa_mask);
-        dfl.sa_flags = 0;
-        if (set_inthandler) {
-            dfl.sa_handler = (void *)inthandler;
-            (void)sigaction(SIGINT, &dfl, NULL);
-        }
-        if (set_quithandler) {
-            dfl.sa_handler = (void *)quithandler;
-            (void)sigaction(SIGQUIT,  &dfl, NULL);
+        {
+            struct sigaction dfl;
+            (void)sigemptyset(&dfl.sa_mask);
+            dfl.sa_flags = 0;
+            if (set_inthandler) {
+                dfl.sa_handler = (void *)inthandler;
+                (void)sigaction(SIGINT, &dfl, NULL);
+            }
+            if (set_quithandler) {
+                dfl.sa_handler = (void *)quithandler;
+                (void)sigaction(SIGQUIT,  &dfl, NULL);
+            }
         }
 
         /* the child */
         if (environment) {
+            // XXX Check result
             execvpe(args[0], args, environment);
         } else {
+            // XXX Check result
             execvp(args[0], args);
         }
-    }
-    _exit(127);
+
+        childFailed(forkCommunicationFds[1], forkExecFailed);
 
     default:
         if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {
@@ -218,11 +252,69 @@ runInteractiveProcess (char *const args[],
             fcntl(fdStdError[0], F_SETFD, FD_CLOEXEC);
             *pfdStdError  = fdStdError[0];
         }
+        close(forkCommunicationFds[1]);
+        fcntl(forkCommunicationFds[0], F_SETFD, FD_CLOEXEC);
+
         break;
     }
+
+    // If the child process had a problem, then it will tell us via the
+    // forkCommunicationFds pipe. First we try to read what the problem
+    // was. Note that if none of these conditionals match then we fall
+    // through and just return pid.
+    r = read(forkCommunicationFds[0], &failCode, sizeof(failCode));
+    if (r == -1) {
+        *failed_doing = "runInteractiveProcess: read pipe";
+        pid = -1;
+    }
+    else if (r == sizeof(failCode)) {
+        // This is the case where we successfully managed to read
+        // the problem
+        switch (failCode) {
+        case forkChdirFailed:
+            *failed_doing = "runInteractiveProcess: chdir";
+            break;
+        case forkExecFailed:
+            *failed_doing = "runInteractiveProcess: exec";
+            break;
+        default:
+            *failed_doing = "runInteractiveProcess: unknown";
+            break;
+        }
+        // Now we try to get the errno from the child
+        r = read(forkCommunicationFds[0], &err, sizeof(err));
+        if (r == -1) {
+            *failed_doing = "runInteractiveProcess: read pipe";
+        }
+        else if (r != sizeof(failCode)) {
+            *failed_doing = "runInteractiveProcess: read pipe bad length";
+        }
+        else {
+            // If we succeed then we set errno. It'll be saved and
+            // restored again below. Note that in any other case we'll
+            // get the errno of whatever else went wrong instead.
+            errno = err;
+        }
+        pid = -1;
+    }
+    else if (r != 0) {
+        *failed_doing = "runInteractiveProcess: read pipe bad length";
+        pid = -1;
+    }
+
+    if (pid == -1) {
+        err = errno;
+    }
+
+    close(forkCommunicationFds[0]);
+
     unblockUserSignals();
     startTimer();
 
+    if (pid == -1) {
+        errno = err;
+    }
+
     return pid;
 }
 

include/runProcess.h

@@ -64,7 +64,8 @@ extern ProcHandle runInteractiveProcess( char *const args[],
                                          int *pfdStdError,
                                          int set_inthandler, long inthandler, 
                                          int set_quithandler, long quithandler,
-                                         int flags);
+                                         int flags,
+                                         char **failed_doing);
 
 #else