-/* 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
# include <config.h>
#endif
-/* Make GNU/Linux libc declare everything it has. */
-#define _GNU_SOURCE
-
#include <stdio.h>
#include <errno.h>
#include "libguile/validate.h"
#include "libguile/posix.h"
-#include "libguile/i18n.h"
+#include "libguile/gettext.h"
#include "libguile/threads.h"
\f
#include <locale.h>
#endif
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# 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
#define F_OK 0
#endif
+/* No prototype for this on Solaris 10. The man page says it's in
+ <unistd.h> ... but it lies. */
+#if ! HAVE_DECL_SETHOSTNAME
+int sethostname (char *name, size_t namelen);
+#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. */
/* Signal values are interned in scm_init_posix(). */
#ifdef HAVE_KILL
if (kill (scm_to_int (pid), scm_to_int (sig)) != 0)
+ SCM_SYSERROR;
#else
+ /* Mingw has raise(), but not kill(). (Other raw DOS environments might
+ be similar.) Use raise() when the requested pid is our own process,
+ otherwise bomb. */
if (scm_to_int (pid) == getpid ())
- if (raise (scm_to_int (sig)) != 0)
+ {
+ if (raise (scm_to_int (sig)) != 0)
+ {
+ err:
+ SCM_SYSERROR;
+ }
+ else
+ {
+ errno = ENOSYS;
+ goto err;
+ }
+ }
#endif
- SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
{
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
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
- execv (exec_file, exec_argv);
+ execv (exec_file,
+#ifdef __MINGW32__
+ /* extra "const" in mingw formals, provokes warning from gcc */
+ (const char * const *)
+#endif
+ exec_argv);
SCM_SYSERROR;
/* not reached. */
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
- execvp (exec_file, exec_argv);
+ execvp (exec_file,
+#ifdef __MINGW32__
+ /* extra "const" in mingw formals, provokes warning from gcc */
+ (const char * const *)
+#endif
+ exec_argv);
SCM_SYSERROR;
/* not reached. */
scm_dynwind_unwind_handler (free_string_pointers, exec_env,
SCM_F_WIND_EXPLICITLY);
- execve (exec_file, exec_argv, exec_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);
SCM_SYSERROR;
/* not reached. */
{
int rv;
char *c_str = scm_to_locale_string (str);
-#ifdef __MINGW32__
- size_t len = strlen (c_str);
-#endif
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);
strcpy (ptr, c_str);
strcpy (ptr+len, "=");
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
{
by getenv. It's not enough just to modify the string we set,
because MINGW putenv copies it. */
- if (c_str[len-1] == '=')
- {
- char *ptr = scm_malloc (len+2);
- strcpy (ptr, c_str);
- strcpy (ptr+len, " ");
- rv = putenv (ptr);
- if (rv < 0)
- {
- int eno = errno;
- free (c_str);
- errno = eno;
- SCM_SYSERROR;
- }
- /* truncate to just the name */
- c_str[len-1] = '\0';
- ptr = getenv (c_str);
- if (ptr)
- ptr[0] = '\0';
- return SCM_UNSPECIFIED;
- }
+ {
+ size_t len = strlen (c_str);
+ if (c_str[len-1] == '=')
+ {
+ char *ptr = scm_malloc (len+2);
+ strcpy (ptr, c_str);
+ strcpy (ptr+len, " ");
+ rv = putenv (ptr);
+ if (rv < 0)
+ {
+ int eno = errno;
+ free (c_str);
+ errno = eno;
+ SCM_SYSERROR;
+ }
+ /* truncate to just the name */
+ c_str[len-1] = '\0';
+ ptr = getenv (c_str);
+ if (ptr)
+ ptr[0] = '\0';
+ return SCM_UNSPECIFIED;
+ }
+ }
#endif /* __MINGW32__ */
/* Leave c_str in the environment. */
}
#undef FUNC_NAME
+/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU
+ 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
+
SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
(SCM category, SCM locale),
"If @var{locale} is omitted, return the current value of the\n"
"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);
}
- rv = setlocale (scm_i_to_lc_category (category, 1), clocale);
+ c_category = scm_i_to_lc_category (category, 1);
+
+ scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+ rv = setlocale (c_category, clocale);
+ scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+
if (rv == NULL)
{
/* POSIX and C99 don't say anything about setlocale setting errno, so
#define FUNC_NAME s_scm_crypt
{
SCM ret;
- char *c_key, *c_salt;
+ char *c_key, *c_salt, *c_ret;
scm_dynwind_begin (0);
scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
c_salt = scm_to_locale_string (salt);
scm_dynwind_free (c_salt);
- ret = scm_from_locale_string (crypt (c_key, c_salt));
+ /* The Linux crypt(3) man page says crypt will return NULL and set errno
+ on error. (Eg. ENOSYS if legal restrictions mean it cannot be
+ implemented). */
+ c_ret = crypt (c_key, c_salt);
+ if (c_ret == NULL)
+ SCM_SYSERROR;
+ ret = scm_from_locale_string (c_ret);
scm_dynwind_end ();
return ret;
}
#endif /* HAVE_GETHOSTNAME */
-void
+void
scm_init_posix ()
{
scm_add_feature ("posix");
HCoop / bpt / guile.git / blobdiff