[PATCH] Implement open-process and related functions on MinGW

[Eli Zaretskii <eliz@gnu.org>]

This patch allows the MinGW build of Guile to have the process related
functions (open-process, kill, waitpid, status:exit-val, etc.).

Implement open-process and related functions on MinGW

* libguile/filesys.c (fsync, link) [__MINGW32__]: Redirect Posix
  functions to their Windows equivalents.
  (scm_chown, scm_open_fdes, scm_open, scm_close, scm_close_fdes)
  (scm_link, scm_chdir, set_element, fill_select_type)
  (get_element, retrieve_select_type, scm_select, scm_fcntl)
  (scm_fsync, scm_symlink, scm_readlink, scm_copy_file, scm_sendfile)
  (scm_dir_print, scm_dir_free): These functions are no longer
  wholesale ifdef'ed away if HAVE_POSIX is not defined.
  (scm_init_filesys): Don't ifdef away parts of the function when
  HAVE_POSIX is not defined.

diff --git a/libguile/posix.c b/libguile/posix.c
index 0443f95..69652a3 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -85,6 +85,27 @@
 #if HAVE_SYS_WAIT_H
 # include <sys/wait.h>
 #endif
+#ifdef __MINGW32__
+# define WEXITSTATUS(stat_val) ((stat_val) & 255)
+/* Windows reports exit status from fatal exceptions as 0xC0000nnn
+   codes, see winbase.h.  We usurp codes above 0xC0000200 for SIGxxx
+   signals.  */
+# define WIFEXITED(stat_val)   (((stat_val) & 0xC0000000) == 0)
+# define WIFSIGNALED(stat_val) (((stat_val) & 0xC0000000) != 0)
+# define WTERMSIG(stat_val)    ((stat_val > 0xC0000200) ? stat_val - 0xC0000200 : stat_val)
+# define WIFSTOPPED(stat_val)  (0)
+# define WSTOPSIG(stat_var)    (0)
+# include <process.h>
+# define waitpid(p,s,o)        _cwait(s, p, WAIT_CHILD)
+# define HAVE_WAITPID 1
+# define getuid()              (500) /* Local Administrator */
+# define getgid()              (513) /* None */
+# define setuid(u)             (0)
+# define setgid(g)             (0)
+# define pipe(f)               _pipe(f, 0, O_NOINHERIT)
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
 #ifndef WEXITSTATUS
 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
 #endif
@@ -674,6 +695,25 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
           goto err;
         }
     }
+#ifdef __MINGW32__
+  else
+    {
+      HANDLE ph = OpenProcess (PROCESS_TERMINATE, 0, scm_to_int (pid));
+      int s = scm_to_int (sig);
+
+      if (!ph)
+	{
+	  errno = EPERM;
+	  goto err;
+	}
+      if (!TerminateProcess (ph, 0xC0000200 + s))
+	{
+	  errno = EINVAL;
+	  goto err;
+	}
+      CloseHandle (ph);
+    }
+#endif	/* __MINGW32__ */
 #endif
   return SCM_UNSPECIFIED;
 }
@@ -720,6 +760,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
 {
   int i;
   int status;
+#ifndef __MINGW32__
   int ioptions;
   if (SCM_UNBNDP (options))
     ioptions = 0;
@@ -728,6 +769,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
       /* Flags are interned in scm_init_posix.  */
       ioptions = scm_to_int (options);
     }
+#endif
   SCM_SYSCALL (i = waitpid (scm_to_int (pid), &status, ioptions));
   if (i == -1)
     SCM_SYSERROR;
@@ -736,7 +778,6 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
 #undef FUNC_NAME
 #endif /* HAVE_WAITPID */
 
-#ifndef __MINGW32__
 SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, 
             (SCM status),
 	    "Return the exit status value, as would be set if a process\n"
@@ -787,7 +828,6 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
     return SCM_BOOL_F;
 }
 #undef FUNC_NAME
-#endif /* __MINGW32__ */
 
 #ifdef HAVE_GETPPID
 SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
@@ -802,7 +842,6 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
 #endif /* HAVE_GETPPID */
 
 
-#ifndef __MINGW32__
 SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
             (),
 	    "Return an integer representing the current real user ID.")
@@ -932,7 +971,6 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
     
 }
 #undef FUNC_NAME
-#endif
 
 
 #ifdef HAVE_GETPGRP
@@ -1248,6 +1286,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
   return scm_from_int (pid);
 }
 #undef FUNC_NAME
+#endif /* HAVE_FORK */
 
 /* Since Guile uses threads, we have to be very careful to avoid calling
    functions that are not async-signal-safe in the child.  That's why
@@ -1321,7 +1360,130 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   }
 #endif
 
+#ifdef HAVE_FORK
   pid = fork ();
+#elif defined(__MINGW32__)
+  {
+    int save_stdin = -1, save_stdout = -1;
+    int errno_save;
+
+    if (reading)
+      {
+	save_stdout = dup (1);
+	errno_save = errno;
+	if (save_stdout == -1)
+	  {
+	    close (c2p[0]);
+	    close (c2p[1]);
+	    free (exec_file);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+      }
+
+    if (writing)
+      {
+	save_stdin = dup (0);
+	errno_save = errno;
+	if (save_stdin == -1)
+	  {
+	    if (reading)
+	      close (save_stdout);
+	    close (p2c[0]);
+	    close (p2c[1]);
+	    free (exec_file);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+      }
+
+    if (reading)
+      {
+	close (1);
+	if (dup (c2p[1]) != 1)
+	  {
+	    errno_save = errno;
+	    close (save_stdout);
+	    close (c2p[0]);
+	    close (c2p[1]);
+	    if (writing)
+	      {
+		close (save_stdin);
+		close (p2c[0]);
+		close (p2c[1]);
+	      }
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (c2p[1]);
+      }
+    if (writing)
+      {
+	close (0);
+	if (dup (p2c[0]) != 0)
+	  {
+	    errno_save = errno;
+	    close (save_stdin);
+	    close (p2c[0]);
+	    close (p2c[1]);
+	    if (reading)
+	      {
+		close (save_stdout);
+		close (c2p[0]);
+		close (c2p[1]);
+	      }
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (p2c[0]);
+      }
+
+    pid = spawnvp (P_NOWAIT, exec_file, exec_argv);
+    errno_save = errno;
+
+    if (reading)
+      {
+	close (1);
+	if (dup (save_stdout) != 1)
+	  {
+	    if (writing)
+	      close (save_stdin);
+	    close (save_stdout);
+	    close (p2c[1]);
+	    close (c2p[0]);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (save_stdout);
+      }
+    if (writing)
+      {
+	close (0);
+	if (dup (save_stdin) != 0)
+	  {
+	    if (reading)
+	      close (save_stdout);
+	    close (save_stdin);
+	    close (p2c[1]);
+	    close (c2p[0]);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (save_stdin);
+      }
+
+    if (pid < 0)
+      errno = errno_save;
+  }
+#else
+  close (c2p[0]);
+  close (c2p[1]);
+  close (p2c[0]);
+  close (p2c[1]);
+  free (exec_file);
+  errno = ENOSYS;
+  SCM_SYSERROR;
+#endif	/* HAVE_FORK */
 
   if (pid == -1)
     {
@@ -1330,14 +1492,28 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       if (reading)
         {
           close (c2p[0]);
+#ifdef HAVE_FORK
           close (c2p[1]);
+#endif
         }
       if (writing)
         {
+#ifdef HAVE_FORK
           close (p2c[0]);
+#endif
           close (p2c[1]);
         }
       errno = errno_save;
+
+#ifndef HAVE_FORK
+      /* The exec failed!  There is nothing sensible to do.  */
+      if (err > 0)
+	{
+	  char *msg = strerror (errno);
+	  fprintf (fdopen (err, "a"), "In spawnvp of %s: %s\n",
+		   exec_file, msg);
+	}
+#endif
       SCM_SYSERROR;
     }
 
@@ -1363,7 +1539,8 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       return scm_values
         (scm_list_3 (read_port, write_port, scm_from_int (pid)));
     }
-  
+
+#ifdef HAVE_FORK
   /* The child.  */
   if (reading)
     close (c2p[0]);
@@ -1412,16 +1589,16 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   if (err > 0)
     {
       char *msg = strerror (errno);
-      fprintf (fdopen (err, "a"), "In execlp of %s: %s\n",
+      fprintf (fdopen (err, "a"), "In execvp of %s: %s\n",
                exec_file, msg);
     }
 
   _exit (EXIT_FAILURE);
   /* Not reached.  */
   return SCM_BOOL_F;
+#endif	/* HAVE_FORK */
 }
 #undef FUNC_NAME
-#endif /* HAVE_FORK */
 
 #ifdef __MINGW32__
 # include "win32-uname.h"
@@ -2239,13 +2416,11 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
 #endif /* HAVE_GETHOSTNAME */
 
 \f
-#ifdef HAVE_FORK
 static void
 scm_init_popen (void)
 {
   scm_c_define_gsubr ("open-process", 2, 0, 1, scm_open_process);
 }
-#endif
 
 void
 scm_init_posix ()
@@ -2338,11 +2513,11 @@ scm_init_posix ()
 
 #ifdef HAVE_FORK
   scm_add_feature ("fork");
+#endif	/* HAVE_FORK */
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_popen",
 			    (scm_t_extension_init_func) scm_init_popen,
 			    NULL);
-#endif	/* HAVE_FORK */
 }
 
 /*