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 */
-#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 */
}
/*
