X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/892065da6cd4ea56a6c946e6f0c064cd7e4fbd86..8ab3d8a0681777eb329ac533be51d557267ccf32:/libguile/posix.c diff --git a/libguile/posix.c b/libguile/posix.c index df743f355..8a83a1e7e 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 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 @@ -12,7 +12,7 @@ * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ @@ -33,12 +33,15 @@ #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/lang.h" -#include "libguile/strop.h" #include "libguile/validate.h" #include "libguile/posix.h" +#include "libguile/i18n.h" +#include "libguile/threads.h" #ifdef HAVE_STRING_H @@ -154,6 +157,12 @@ extern char ** environ; #define F_OK 0 #endif +/* No prototype for this on Solaris 10. The man page says it's in + ... but it lies. */ +#if ! HAVE_DECL_SETHOSTNAME +int sethostname (char *name, size_t namelen); +#endif + /* On NextStep, 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. */ @@ -267,7 +276,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, result = scm_c_make_vector (ngroups, SCM_BOOL_F); while (--ngroups >= 0) - SCM_VECTOR_SET (result, ngroups, scm_from_ulong (groups[ngroups])); + SCM_SIMPLE_VECTOR_SET (result, ngroups, scm_from_ulong (groups[ngroups])); free (groups); return result; @@ -294,17 +303,18 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0, SCM_VALIDATE_VECTOR (SCM_ARG1, group_vec); - ngroups = SCM_VECTOR_LENGTH (group_vec); + ngroups = SCM_SIMPLE_VECTOR_LENGTH (group_vec); /* validate before allocating, so we don't have to worry about leaks */ for (i = 0; i < ngroups; i++) { unsigned long ulong_gid; GETGROUPS_T gid; - SCM_VALIDATE_ULONG_COPY (1, SCM_VECTOR_REF (group_vec, i), ulong_gid); + SCM_VALIDATE_ULONG_COPY (1, SCM_SIMPLE_VECTOR_REF (group_vec, i), + ulong_gid); gid = ulong_gid; if (gid != ulong_gid) - SCM_OUT_OF_RANGE (1, SCM_VECTOR_REF (group_vec, i)); + SCM_OUT_OF_RANGE (1, SCM_SIMPLE_VECTOR_REF (group_vec, i)); } size = ngroups * sizeof (GETGROUPS_T); @@ -312,7 +322,7 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0, SCM_OUT_OF_RANGE (SCM_ARG1, scm_from_int (ngroups)); groups = scm_malloc (size); for(i = 0; i < ngroups; i++) - groups [i] = SCM_NUM2ULONG (1, SCM_VECTOR_REF (group_vec, i)); + groups [i] = SCM_NUM2ULONG (1, SCM_SIMPLE_VECTOR_REF (group_vec, i)); result = setgroups (ngroups, groups); save_errno = errno; /* don't let free() touch errno */ @@ -356,19 +366,19 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, if (!entry) SCM_MISC_ERROR ("entry not found", SCM_EOL); - SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name)); - SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd)); - SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid)); - SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid)); - SCM_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos)); + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid)); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid)); + SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos)); if (!entry->pw_dir) - SCM_VECTOR_SET(result, 5, scm_from_locale_string ("")); + SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string ("")); else - SCM_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir)); + SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir)); if (!entry->pw_shell) - SCM_VECTOR_SET(result, 6, scm_from_locale_string ("")); + SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string ("")); else - SCM_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell)); + SCM_SIMPLE_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell)); return result; } #undef FUNC_NAME @@ -421,10 +431,10 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, if (!entry) SCM_SYSERROR; - SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name)); - SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd)); - SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid)); - SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem)); + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid)); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem)); return result; } #undef FUNC_NAME @@ -818,11 +828,11 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, return SCM_BOOL_F; fd = SCM_FPORT_FDES (port); - scm_mutex_lock (&scm_i_misc_mutex); + scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); SCM_SYSCALL (result = ttyname (fd)); err = errno; ret = scm_from_locale_string (result); - scm_mutex_unlock (&scm_i_misc_mutex); + scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); if (!result) { @@ -930,20 +940,25 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1, char *exec_file; char **exec_argv; - scm_frame_begin (0); + scm_dynwind_begin (0); exec_file = scm_to_locale_string (filename); - scm_frame_free (exec_file); + scm_dynwind_free (exec_file); exec_argv = scm_i_allocate_string_pointers (args); - scm_frame_unwind_handler (free_string_pointers, exec_argv, + 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_frame_end (); + scm_dynwind_end (); return SCM_BOOL_F; } #undef FUNC_NAME @@ -961,20 +976,25 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1, char *exec_file; char **exec_argv; - scm_frame_begin (0); + scm_dynwind_begin (0); exec_file = scm_to_locale_string (filename); - scm_frame_free (exec_file); + scm_dynwind_free (exec_file); exec_argv = scm_i_allocate_string_pointers (args); - scm_frame_unwind_handler (free_string_pointers, exec_argv, + 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_frame_end (); + scm_dynwind_end (); return SCM_BOOL_F; } #undef FUNC_NAME @@ -996,24 +1016,34 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1, char **exec_env; char *exec_file; - scm_frame_begin (0); + scm_dynwind_begin (0); exec_file = scm_to_locale_string (filename); - scm_frame_free (exec_file); + scm_dynwind_free (exec_file); exec_argv = scm_i_allocate_string_pointers (args); - scm_frame_unwind_handler (free_string_pointers, exec_argv, + scm_dynwind_unwind_handler (free_string_pointers, exec_argv, SCM_F_WIND_EXPLICITLY); exec_env = scm_i_allocate_string_pointers (env); - scm_frame_unwind_handler (free_string_pointers, exec_env, + 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. */ - scm_frame_end (); + scm_dynwind_end (); return SCM_BOOL_F; } #undef FUNC_NAME @@ -1052,14 +1082,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0, SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); if (uname (&buf) < 0) SCM_SYSERROR; - SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname)); - SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename)); - SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release)); - SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version)); - SCM_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine)); + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_locale_string (buf.release)); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (buf.version)); + SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine)); /* a linux special? - SCM_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname)); + SCM_SIMPLE_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname)); */ return result; } @@ -1129,20 +1159,34 @@ extern int mkstemp (char *); SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0, (SCM tmpl), - "Create a new unique file in the file system and returns a new\n" + "Create a new unique file in the file system and return a new\n" "buffered port open for reading and writing to the file.\n" + "\n" "@var{tmpl} is a string specifying where the file should be\n" - "created: it must end with @code{XXXXXX} and will be changed in\n" - "place to return the name of the temporary file.") + "created: it must end with @samp{XXXXXX} and those @samp{X}s\n" + "will be changed in the string to return the name of the file.\n" + "(@code{port-filename} on the port also gives the name.)\n" + "\n" + "POSIX doesn't specify the permissions mode of the file, on GNU\n" + "and most systems it's @code{#o600}. An application can use\n" + "@code{chmod} to relax that if desired. For example\n" + "@code{#o666} less @code{umask}, which is usual for ordinary\n" + "file creation,\n" + "\n" + "@example\n" + "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n" + " (chmod port (logand #o666 (lognot (umask))))\n" + " ...)\n" + "@end example") #define FUNC_NAME s_scm_mkstemp { char *c_tmpl; int rv; - scm_frame_begin (0); + scm_dynwind_begin (0); c_tmpl = scm_to_locale_string (tmpl); - scm_frame_free (c_tmpl); + scm_dynwind_free (c_tmpl); SCM_SYSCALL (rv = mkstemp (c_tmpl)); if (rv == -1) @@ -1152,7 +1196,7 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0, SCM_INUM0, scm_string_length (tmpl), tmpl, SCM_INUM0); - scm_frame_end (); + scm_dynwind_end (); return scm_fdes_to_port (rv, "w+", tmpl); } #undef FUNC_NAME @@ -1194,29 +1238,46 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0, SCM_DEFINE (scm_access, "access?", 2, 0, 0, (SCM path, SCM how), - "Return @code{#t} if @var{path} corresponds to an existing file\n" - "and the current process has the type of access specified by\n" - "@var{how}, otherwise @code{#f}. @var{how} should be specified\n" - "using the values of the variables listed below. Multiple\n" - "values can be combined using a bitwise or, in which case\n" - "@code{#t} will only be returned if all accesses are granted.\n" + "Test accessibility of a file under the real UID and GID of the\n" + "calling process. The return is @code{#t} if @var{path} exists\n" + "and the permissions requested by @var{how} are all allowed, or\n" + "@code{#f} if not.\n" "\n" - "Permissions are checked using the real id of the current\n" - "process, not the effective id, although it's the effective id\n" - "which determines whether the access would actually be granted.\n" + "@var{how} is an integer which is one of the following values,\n" + "or a bitwise-OR (@code{logior}) of multiple values.\n" "\n" "@defvar R_OK\n" - "test for read permission.\n" + "Test for read permission.\n" "@end defvar\n" "@defvar W_OK\n" - "test for write permission.\n" + "Test for write permission.\n" "@end defvar\n" "@defvar X_OK\n" - "test for execute permission.\n" + "Test for execute permission.\n" "@end defvar\n" "@defvar F_OK\n" - "test for existence of the file.\n" - "@end defvar") + "Test for existence of the file. This is implied by each of the\n" + "other tests, so there's no need to combine it with them.\n" + "@end defvar\n" + "\n" + "It's important to note that @code{access?} does not simply\n" + "indicate what will happen on attempting to read or write a\n" + "file. In normal circumstances it does, but in a set-UID or\n" + "set-GID program it doesn't because @code{access?} tests the\n" + "real ID, whereas an open or execute attempt uses the effective\n" + "ID.\n" + "\n" + "A program which will never run set-UID/GID can ignore the\n" + "difference between real and effective IDs, but for maximum\n" + "generality, especially in library functions, it's best not to\n" + "use @code{access?} to predict the result of an open or execute,\n" + "instead simply attempt that and catch any exception.\n" + "\n" + "The main use for @code{access?} is to let a set-UID/GID program\n" + "determine what the invoking user would have been allowed to do,\n" + "without the greater (or perhaps lesser) privileges afforded by\n" + "the effective ID. For more on this, see ``Testing File\n" + "Access'' in The GNU C Library Reference Manual.") #define FUNC_NAME s_scm_access { int rv; @@ -1268,7 +1329,7 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0, /* On e.g. Win32 hosts putenv() called with 'name=' removes the environment variable 'name'. */ int e; - ptr = scm_malloc (len + 2); + char *ptr = scm_malloc (len + 2); strcpy (ptr, c_str); strcpy (ptr+len, "="); rv = putenv (ptr); @@ -1336,7 +1397,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, char *clocale; char *rv; - scm_frame_begin (0); + scm_dynwind_begin (0); if (SCM_UNBNDP (locale)) { @@ -1345,14 +1406,24 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, else { clocale = scm_to_locale_string (locale); - scm_frame_free (clocale); + scm_dynwind_free (clocale); } - rv = setlocale (scm_to_int (category), clocale); + rv = setlocale (scm_i_to_lc_category (category, 1), clocale); if (rv == NULL) - SCM_SYSERROR; + { + /* POSIX and C99 don't say anything about setlocale setting errno, so + force a sensible value here. glibc leaves ENOENT, which would be + fine, but it's not a documented feature. */ + errno = EINVAL; + SCM_SYSERROR; + } - scm_frame_end (); + /* Recompute the standard SRFI-14 character sets in a locale-dependent + (actually charset-dependent) way. */ + scm_srfi_14_compute_char_sets (); + + scm_dynwind_end (); return scm_from_locale_string (rv); } #undef FUNC_NAME @@ -1388,8 +1459,11 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, ctype = S_IFREG; else if (strcmp (p, "directory") == 0) ctype = S_IFDIR; +#ifdef S_IFLNK + /* systems without symlinks probably don't have S_IFLNK defined */ else if (strcmp (p, "symlink") == 0) ctype = S_IFLNK; +#endif else if (strcmp (p, "block-special") == 0) ctype = S_IFBLK; else if (strcmp (p, "char-special") == 0) @@ -1422,7 +1496,11 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_nice { - if (nice (scm_to_int (incr)) != 0) + /* 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)); + if (errno != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; } @@ -1470,20 +1548,17 @@ SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, SCM ret; char *c_key, *c_salt; - scm_frame_begin (0); - scm_frame_unwind_handler ((void(*)(void*)) scm_mutex_unlock, - &scm_i_misc_mutex, - SCM_F_WIND_EXPLICITLY); - scm_mutex_lock (&scm_i_misc_mutex); + scm_dynwind_begin (0); + scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex); c_key = scm_to_locale_string (key); - scm_frame_free (c_key); + scm_dynwind_free (c_key); c_salt = scm_to_locale_string (salt); - scm_frame_free (c_key); + scm_dynwind_free (c_salt); ret = scm_from_locale_string (crypt (c_key, c_salt)); - scm_frame_end (); + scm_dynwind_end (); return ret; } #undef FUNC_NAME @@ -1724,21 +1799,28 @@ SCM_DEFINE (scm_flock, "flock", 2, 0, 0, (SCM file, SCM operation), "Apply or remove an advisory lock on an open file.\n" "@var{operation} specifies the action to be done:\n" - "@table @code\n" - "@item LOCK_SH\n" + "\n" + "@defvar LOCK_SH\n" "Shared lock. More than one process may hold a shared lock\n" "for a given file at a given time.\n" - "@item LOCK_EX\n" + "@end defvar\n" + "@defvar LOCK_EX\n" "Exclusive lock. Only one process may hold an exclusive lock\n" "for a given file at a given time.\n" - "@item LOCK_UN\n" + "@end defvar\n" + "@defvar LOCK_UN\n" "Unlock the file.\n" - "@item LOCK_NB\n" - "Don't block when locking. May be specified by bitwise OR'ing\n" - "it to one of the other operations.\n" - "@end table\n" + "@end defvar\n" + "@defvar LOCK_NB\n" + "Don't block when locking. This is combined with one of the\n" + "other operations using @code{logior}. If @code{flock} would\n" + "block an @code{EWOULDBLOCK} error is thrown.\n" + "@end defvar\n" + "\n" "The return value is not specified. @var{file} may be an open\n" - "file descriptor or an open file descriptor port.") + "file descriptor or an open file descriptor port.\n" + "\n" + "Note that @code{flock} does not lock files across NFS.") #define FUNC_NAME s_scm_flock { int fdes; @@ -1792,8 +1874,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, char *const p = scm_malloc (len); const int res = gethostname (p, len); - scm_frame_begin (0); - scm_frame_unwind_handler (free, p, 0); + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (free, p, 0); #else @@ -1819,8 +1901,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, p = scm_malloc (len); - scm_frame_begin (0); - scm_frame_unwind_handler (free, p, 0); + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (free, p, 0); res = gethostname (p, len); while (res == -1 && errno == ENAMETOOLONG) @@ -1838,8 +1920,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, { const int save_errno = errno; - // No guile exceptions can occur before we have freed p's memory. - scm_frame_end (); + /* No guile exceptions can occur before we have freed p's memory. */ + scm_dynwind_end (); free (p); errno = save_errno; @@ -1850,8 +1932,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, /* scm_from_locale_string may throw an exception. */ const SCM name = scm_from_locale_string (p); - // No guile exceptions can occur before we have freed p's memory. - scm_frame_end (); + /* No guile exceptions can occur before we have freed p's memory. */ + scm_dynwind_end (); free (p); return name; @@ -1908,6 +1990,24 @@ scm_init_posix () #ifdef LC_ALL scm_c_define ("LC_ALL", scm_from_int (LC_ALL)); #endif +#ifdef LC_PAPER + scm_c_define ("LC_PAPER", scm_from_int (LC_PAPER)); +#endif +#ifdef LC_NAME + scm_c_define ("LC_NAME", scm_from_int (LC_NAME)); +#endif +#ifdef LC_ADDRESS + scm_c_define ("LC_ADDRESS", scm_from_int (LC_ADDRESS)); +#endif +#ifdef LC_TELEPHONE + scm_c_define ("LC_TELEPHONE", scm_from_int (LC_TELEPHONE)); +#endif +#ifdef LC_MEASUREMENT + scm_c_define ("LC_MEASUREMENT", scm_from_int (LC_MEASUREMENT)); +#endif +#ifdef LC_IDENTIFICATION + scm_c_define ("LC_IDENTIFICATION", scm_from_int (LC_IDENTIFICATION)); +#endif #ifdef PIPE_BUF scm_c_define ("PIPE_BUF", scm_from_long (PIPE_BUF)); #endif