/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
# include <sched.h>
#endif
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/fports.h"
-#include "libguile/scmsigs.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
-#include "libguile/vectors.h"
-#include "libguile/values.h"
-
-#include "libguile/validate.h"
-#include "libguile/posix.h"
-#include "libguile/gettext.h"
-#include "libguile/threads.h"
-\f
-
#ifdef HAVE_STRING_H
#include <string.h>
#endif
# endif
#endif
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#else
-#ifndef ttyname
-extern char *ttyname();
-#endif
-#endif
#ifdef LIBC_H_WITH_UNISTD_H
#include <libc.h>
#ifdef HAVE_IO_H
#include <io.h>
#endif
-#ifdef HAVE_WINSOCK2_H
-#include <winsock2.h>
-#endif
-#ifdef __MINGW32__
-/* Some defines for Windows here. */
-# include <process.h>
-# define pipe(fd) _pipe (fd, 256, O_BINARY)
-#endif /* __MINGW32__ */
+#include "libguile/_scm.h"
+#include "libguile/dynwind.h"
+#include "libguile/fports.h"
+#include "libguile/scmsigs.h"
+#include "libguile/feature.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-14.h"
+#include "libguile/vectors.h"
+#include "libguile/values.h"
+
+#include "libguile/validate.h"
+#include "libguile/posix.h"
+#include "libguile/gettext.h"
+#include "libguile/threads.h"
+\f
#if HAVE_SYS_WAIT_H
# include <sys/wait.h>
int sethostname (char *name, size_t namelen);
#endif
+#if defined HAVE_GETLOGIN && !HAVE_DECL_GETLOGIN
+/* MinGW doesn't supply this decl; see
+ http://lists.gnu.org/archive/html/bug-gnulib/2013-03/msg00030.html for more
+ details. */
+char *getlogin (void);
+#endif
+
/* On NextStep, <utime.h> doesn't define struct utime, unless we
#define _POSIX_SOURCE before #including it. I think this is less
of a kludge than defining struct utimbuf ourselves. */
GETGROUPS_T *groups;
ngroups = getgroups (0, NULL);
- if (ngroups <= 0)
+ if (ngroups < 0)
SCM_SYSERROR;
+ else if (ngroups == 0)
+ return scm_c_make_vector (0, SCM_BOOL_F);
size = ngroups * sizeof (GETGROUPS_T);
groups = scm_malloc (size);
#ifdef HAVE_SETEGID
-SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
+SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
(SCM id),
"Sets the effective group ID to the integer @var{id}, provided the process\n"
"has appropriate privileges. If effective IDs are not supported, the\n"
{
int rv;
-#ifdef HAVE_SETEUID
+#ifdef HAVE_SETEGID
rv = setegid (scm_to_int (id));
#else
rv = setgid (scm_to_int (id));
exec_argv = scm_i_allocate_string_pointers (args);
- execv (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execv (exec_file, exec_argv);
SCM_SYSERROR;
/* not reached. */
exec_argv = scm_i_allocate_string_pointers (args);
- execvp (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execvp (exec_file, exec_argv);
SCM_SYSERROR;
/* not reached. */
exec_argv = scm_i_allocate_string_pointers (args);
exec_env = scm_i_allocate_string_pointers (env);
- execve (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_env);
+ execve (exec_file, exec_argv, exec_env);
SCM_SYSERROR;
/* not reached. */
#define FUNC_NAME s_scm_fork
{
int pid;
+ if (scm_ilength (scm_all_threads ()) != 1)
+ /* Other threads may be holding on to resources that Guile needs --
+ it is not safe to permit one thread to fork while others are
+ running.
+
+ In addition, POSIX clearly specifies that if a multi-threaded
+ program forks, the child must only call functions that are
+ async-signal-safe. We can't guarantee that in general. The best
+ we can do is to allow forking only very early, before any call to
+ sigaction spawns the signal-handling thread. */
+ scm_display
+ (scm_from_latin1_string
+ ("warning: call to primitive-fork while multiple threads are running;\n"
+ " further behavior unspecified. See \"Processes\" in the\n"
+ " manual, for more information.\n"),
+ scm_current_warning_port ());
pid = fork ();
if (pid == -1)
SCM_SYSERROR;
if (pid)
/* Parent. */
{
- SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F, port;
+ SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
/* There is no sense in catching errors on close(). */
- if (reading)
+ if (reading)
{
close (c2p[1]);
- read_port = scm_fdes_to_port (c2p[0], "r", sym_read_pipe);
- scm_setvbuf (read_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+ read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
}
if (writing)
{
close (p2c[0]);
- write_port = scm_fdes_to_port (p2c[1], "w", sym_write_pipe);
- scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED);
- }
-
- if (reading && writing)
- {
- static SCM make_rw_port = SCM_BOOL_F;
-
- if (scm_is_false (make_rw_port))
- make_rw_port = scm_c_private_variable ("ice-9 popen",
- "make-rw-port");
-
- port = scm_call_2 (scm_variable_ref (make_rw_port),
- read_port, write_port);
+ write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
}
- else if (reading)
- port = read_port;
- else if (writing)
- port = write_port;
- else
- port = scm_sys_make_void_port (mode);
- return scm_cons (port, scm_from_int (pid));
+ return scm_values
+ (scm_list_3 (read_port, write_port, scm_from_int (pid)));
}
-
+
/* The child. */
if (reading)
close (c2p[0]);
close (err);
}
- execvp (exec_file,
-#ifdef __MINGW32__
- /* extra "const" in mingw formals, provokes warning from gcc */
- (const char * const *)
-#endif
- exec_argv);
+ execvp (exec_file, exec_argv);
/* The exec failed! There is nothing sensible to do. */
if (err > 0)
struct utimbuf utm;
utm.actime = atim_sec;
utm.modtime = mtim_sec;
+ /* Silence warnings. */
+ (void) atim_nsec;
+ (void) mtim_nsec;
+
+ if (f != 0)
+ scm_out_of_range(FUNC_NAME, flags);
STRING_SYSCALL (pathname, c_pathname,
rv = utime (c_pathname, &utm));
#undef FUNC_NAME
#endif /* HAVE_CHROOT */
-
-#ifdef __MINGW32__
-/* Wrapper function to supplying `getlogin()' under Windows. */
-static char * getlogin (void)
-{
- static char user[256];
- static unsigned long len = 256;
-
- if (!GetUserName (user, &len))
- return NULL;
- return user;
-}
-#endif /* __MINGW32__ */
-
-
-#if defined (HAVE_GETLOGIN) || defined (__MINGW32__)
SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
(void),
"Return a string containing the name of the user logged in on\n"
return scm_from_locale_string (p);
}
#undef FUNC_NAME
-#endif /* HAVE_GETLOGIN */
#if HAVE_GETPRIORITY
SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0,
SCM bv;
size_t cpu;
- bv = scm_c_make_bitvector (sizeof (*cs), SCM_BOOL_F);
+ bv = scm_c_make_bitvector (CPU_SETSIZE, SCM_BOOL_F);
- for (cpu = 0; cpu < sizeof (*cs); cpu++)
+ for (cpu = 0; cpu < CPU_SETSIZE; cpu++)
{
if (CPU_ISSET (cpu, cs))
/* XXX: This is inefficient but avoids code duplication. */
scm_init_posix ()
{
scm_add_feature ("posix");
+#ifdef EXIT_SUCCESS
+ scm_c_define ("EXIT_SUCCESS", scm_from_int (EXIT_SUCCESS));
+#endif
+#ifdef EXIT_FAILURE
+ scm_c_define ("EXIT_FAILURE", scm_from_int (EXIT_FAILURE));
+#endif
#ifdef HAVE_GETEUID
scm_add_feature ("EIDs");
#endif
#include "libguile/posix.x"
#ifdef HAVE_FORK
+ scm_add_feature ("fork");
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_popen",
(scm_t_extension_init_func) scm_init_popen,
HCoop / bpt / guile.git / blobdiff