-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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
\f
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
-/* Make GNU/Linux libc declare everything it has. */
-#define _GNU_SOURCE
-
#include <stdio.h>
#include <errno.h>
#include "libguile/srfi-13.h"
#include "libguile/srfi-14.h"
#include "libguile/vectors.h"
+#include "libguile/values.h"
#include "libguile/lang.h"
#include "libguile/validate.h"
# define USE_GNU_LOCALE_API
#endif
+#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
+# include <xlocale.h>
+#endif
+
#if HAVE_CRYPT_H
# include <crypt.h>
#endif
size = ngroups * sizeof (GETGROUPS_T);
groups = scm_malloc (size);
- getgroups (ngroups, groups);
+ ngroups = getgroups (ngroups, groups);
result = scm_c_make_vector (ngroups, SCM_BOOL_F);
while (--ngroups >= 0)
#endif /* HAVE_GETGRENT */
+#ifdef HAVE_GETRLIMIT
+#ifdef RLIMIT_AS
+SCM_SYMBOL (sym_as, "as");
+#endif
+#ifdef RLIMIT_CORE
+SCM_SYMBOL (sym_core, "core");
+#endif
+#ifdef RLIMIT_CPU
+SCM_SYMBOL (sym_cpu, "cpu");
+#endif
+#ifdef RLIMIT_DATA
+SCM_SYMBOL (sym_data, "data");
+#endif
+#ifdef RLIMIT_FSIZE
+SCM_SYMBOL (sym_fsize, "fsize");
+#endif
+#ifdef RLIMIT_MEMLOCK
+SCM_SYMBOL (sym_memlock, "memlock");
+#endif
+#ifdef RLIMIT_MSGQUEUE
+SCM_SYMBOL (sym_msgqueue, "msgqueue");
+#endif
+#ifdef RLIMIT_NICE
+SCM_SYMBOL (sym_nice, "nice");
+#endif
+#ifdef RLIMIT_NOFILE
+SCM_SYMBOL (sym_nofile, "nofile");
+#endif
+#ifdef RLIMIT_NPROC
+SCM_SYMBOL (sym_nproc, "nproc");
+#endif
+#ifdef RLIMIT_RSS
+SCM_SYMBOL (sym_rss, "rss");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rtprio, "rtprio");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rttime, "rttime");
+#endif
+#ifdef RLIMIT_SIGPENDING
+SCM_SYMBOL (sym_sigpending, "sigpending");
+#endif
+#ifdef RLIMIT_STACK
+SCM_SYMBOL (sym_stack, "stack");
+#endif
+
+static int
+scm_to_resource (SCM s, const char *func, int pos)
+{
+ if (scm_is_number (s))
+ return scm_to_int (s);
+
+ SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol");
+
+#ifdef RLIMIT_AS
+ if (s == sym_as)
+ return RLIMIT_AS;
+#endif
+#ifdef RLIMIT_CORE
+ if (s == sym_core)
+ return RLIMIT_CORE;
+#endif
+#ifdef RLIMIT_CPU
+ if (s == sym_cpu)
+ return RLIMIT_CPU;
+#endif
+#ifdef RLIMIT_DATA
+ if (s == sym_data)
+ return RLIMIT_DATA;
+#endif
+#ifdef RLIMIT_FSIZE
+ if (s == sym_fsize)
+ return RLIMIT_FSIZE;
+#endif
+#ifdef RLIMIT_MEMLOCK
+ if (s == sym_memlock)
+ return RLIMIT_MEMLOCK;
+#endif
+#ifdef RLIMIT_MSGQUEUE
+ if (s == sym_msgqueue)
+ return RLIMIT_MSGQUEUE;
+#endif
+#ifdef RLIMIT_NICE
+ if (s == sym_nice)
+ return RLIMIT_NICE;
+#endif
+#ifdef RLIMIT_NOFILE
+ if (s == sym_nofile)
+ return RLIMIT_NOFILE;
+#endif
+#ifdef RLIMIT_NPROC
+ if (s == sym_nproc)
+ return RLIMIT_NPROC;
+#endif
+#ifdef RLIMIT_RSS
+ if (s == sym_rss)
+ return RLIMIT_RSS;
+#endif
+#ifdef RLIMIT_RTPRIO
+ if (s == sym_rtprio)
+ return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_RTPRIO
+ if (s == sym_rttime)
+ return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_SIGPENDING
+ if (s == sym_sigpending)
+ return RLIMIT_SIGPENDING;
+#endif
+#ifdef RLIMIT_STACK
+ if (s == sym_stack)
+ return RLIMIT_STACK;
+#endif
+
+ scm_misc_error (func, "invalid rlimit resource ~A", scm_list_1 (s));
+ return 0;
+}
+
+SCM_DEFINE (scm_getrlimit, "getrlimit", 1, 0, 0,
+ (SCM resource),
+ "Get a resource limit for this process. @var{resource} identifies the resource,\n"
+ "either as an integer or as a symbol. For example, @code{(getrlimit 'stack)}\n"
+ "gets the limits associated with @code{RLIMIT_STACK}.\n\n"
+ "@code{getrlimit} returns two values, the soft and the hard limit. If no\n"
+ "limit is set for the resource in question, the returned limit will be @code{#f}.")
+#define FUNC_NAME s_scm_getrlimit
+{
+ int iresource;
+ struct rlimit lim = { 0, 0 };
+
+ iresource = scm_to_resource (resource, FUNC_NAME, 1);
+
+ if (getrlimit (iresource, &lim) != 0)
+ scm_syserror (FUNC_NAME);
+
+ return scm_values (scm_list_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F
+ : scm_from_long (lim.rlim_cur),
+ (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F
+ : scm_from_long (lim.rlim_max)));
+}
+#undef FUNC_NAME
+
+
+#ifdef HAVE_SETRLIMIT
+SCM_DEFINE (scm_setrlimit, "setrlimit", 3, 0, 0,
+ (SCM resource, SCM soft, SCM hard),
+ "Set a resource limit for this process. @var{resource} identifies the resource,\n"
+ "either as an integer or as a symbol. @var{soft} and @var{hard} should be integers,\n"
+ "or @code{#f} to indicate no limit (i.e., @code{RLIM_INFINITY}).\n\n"
+ "For example, @code{(setrlimit 'stack 150000 300000)} sets the @code{RLIMIT_STACK}\n"
+ "limit to 150 kilobytes, with a hard limit of 300 kB.")
+#define FUNC_NAME s_scm_setrlimit
+{
+ int iresource;
+ struct rlimit lim = { 0, 0 };
+
+ iresource = scm_to_resource (resource, FUNC_NAME, 1);
+
+ lim.rlim_cur = (soft == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (soft);
+ lim.rlim_max = (hard == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (hard);
+
+ if (setrlimit (iresource, &lim) != 0)
+ scm_syserror (FUNC_NAME);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETRLIMIT */
+#endif /* HAVE_GETRLIMIT */
+
+
SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
(SCM pid, SCM sig),
"Sends a signal to the specified process or group of processes.\n\n"
{
char *result;
int fd, err;
- SCM ret;
+ SCM ret = SCM_BOOL_F;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPPORT (1, port);
fd = SCM_FPORT_FDES (port);
scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
+
SCM_SYSCALL (result = ttyname (fd));
err = errno;
- ret = scm_from_locale_string (result);
+ if (result != NULL)
+ result = strdup (result);
+
scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
if (!result)
errno = err;
SCM_SYSERROR;
}
+ else
+ ret = scm_take_locale_string (result);
+
return ret;
}
#undef FUNC_NAME
if (strchr (c_str, '=') == NULL)
{
-#ifdef HAVE_UNSETENV
- /* No '=' in argument means we should remove the variable from
- the environment. Not all putenvs understand this (for instance
- FreeBSD 4.8 doesn't). To be safe, we do it explicitely using
- unsetenv. */
+ /* We want no "=" in the argument to mean remove the variable from the
+ environment, but not all putenv()s understand this, for example
+ FreeBSD 4.8 doesn't. Getting it happening everywhere is a bit
+ painful. What unsetenv() exists, we use that, of course.
+
+ Traditionally putenv("NAME") removes a variable, for example that's
+ what we have to do on Solaris 9 (it doesn't have an unsetenv).
+
+ But on DOS and on that DOS overlay manager thing called W-whatever,
+ putenv("NAME=") must be used (it too doesn't have an unsetenv).
+
+ Supposedly on AIX a putenv("NAME") could cause a segfault, but also
+ supposedly AIX 5.3 and up has unsetenv() available so should be ok
+ with the latter there.
+
+ For the moment we hard code the DOS putenv("NAME=") style under
+ __MINGW32__ and do the traditional everywhere else. Such
+ system-name tests are bad, of course. It'd be possible to use a
+ configure test when doing a a native build. For example GNU R has
+ such a test (see R_PUTENV_AS_UNSETENV in
+ https://svn.r-project.org/R/trunk/m4/R.m4). But when cross
+ compiling there'd want to be a guess, one probably based on the
+ system name (ie. mingw or not), thus landing back in basically the
+ present hard-coded situation. Another possibility for a cross
+ build would be to try "NAME" then "NAME=" at runtime, if that's not
+ too much like overkill. */
+
+#if HAVE_UNSETENV
+ /* when unsetenv() exists then we use it */
unsetenv (c_str);
free (c_str);
-#else
- /* On e.g. Win32 hosts putenv() called with 'name=' removes the
- environment variable 'name'. */
+#elif defined (__MINGW32__)
+ /* otherwise putenv("NAME=") on DOS */
int e;
size_t len = strlen (c_str);
char *ptr = scm_malloc (len + 2);
e = errno; free (ptr); free (c_str); errno = e;
if (rv < 0)
SCM_SYSERROR;
-#endif /* !HAVE_UNSETENV */
+#else
+ /* otherwise traditional putenv("NAME") */
+ rv = putenv (c_str);
+ if (rv < 0)
+ SCM_SYSERROR;
+#endif
}
else
{
}
#undef FUNC_NAME
-#ifndef USE_GNU_LOCALE_API
/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU
- systems (i.e., systems where a reentrant locale API is not available).
- See `i18n.c' for details. */
-scm_i_pthread_mutex_t scm_i_locale_mutex;
-#endif
+ systems (i.e., systems where a reentrant locale API is not available). It
+ is also acquired before calls to `nl_langinfo ()'. See `i18n.c' for
+ details. */
+scm_i_pthread_mutex_t scm_i_locale_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
#ifdef HAVE_SETLOCALE
"the locale will be set using environment variables.")
#define FUNC_NAME s_scm_setlocale
{
+ int c_category;
char *clocale;
char *rv;
scm_dynwind_free (clocale);
}
-#ifndef USE_GNU_LOCALE_API
+ c_category = scm_i_to_lc_category (category, 1);
+
scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
-#endif
- rv = setlocale (scm_i_to_lc_category (category, 1), clocale);
-#ifndef USE_GNU_LOCALE_API
+ rv = setlocale (c_category, clocale);
scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
-#endif
if (rv == NULL)
{
"The return value is unspecified.")
#define FUNC_NAME s_scm_nice
{
+ int nice_value;
+
/* nice() returns "prio-NZERO" on success or -1 on error, but -1 can arise
from "prio-NZERO", so an error must be detected from errno changed */
errno = 0;
- nice (scm_to_int (incr));
+ nice_value = nice (scm_to_int (incr));
if (errno != 0)
SCM_SYSERROR;
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
void
scm_init_posix ()
{
-#ifndef USE_GNU_LOCALE_API
- scm_i_pthread_mutex_init (&scm_i_locale_mutex, NULL);
-#endif
-
scm_add_feature ("posix");
#ifdef HAVE_GETEUID
scm_add_feature ("EIDs");
HCoop / bpt / guile.git / blobdiff