Changes from arch/CVS synchronization
[bpt/guile.git] / libguile / posix.c
index f0faabd..8129c64 100644 (file)
@@ -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
  */
 
 
 #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/validate.h"
 #include "libguile/posix.h"
-#include "libguile/i18n.h"
+#include "libguile/gettext.h"
+#include "libguile/threads.h"
 \f
 
 #ifdef HAVE_STRING_H
@@ -113,6 +115,10 @@ extern char ** environ;
 #include <locale.h>
 #endif
 
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# define USE_GNU_LOCALE_API
+#endif
+
 #if HAVE_CRYPT_H
 #  include <crypt.h>
 #endif
@@ -155,6 +161,12 @@ extern char ** environ;
 #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.  */
@@ -820,11 +832,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)
     {
@@ -932,20 +944,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
@@ -963,20 +980,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
@@ -998,24 +1020,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
@@ -1131,25 +1163,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 @samp{XXXXXX} and will be changed in\n"
-           "place to return the name of the temporary file.\n"
+           "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"
-           "The file is created with mode @code{0600}, which means read and\n"
-           "write for the owner only.  @code{chmod} can be used to change\n"
-           "this.")
+           "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)
@@ -1159,7 +1200,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
@@ -1343,7 +1384,15 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
 }
 #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
+
 #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"
@@ -1360,7 +1409,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))
     {
@@ -1369,14 +1418,31 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
   else
     {
       clocale = scm_to_locale_string (locale);
-      scm_frame_free (clocale);
+      scm_dynwind_free (clocale);
     }
 
+#ifndef USE_GNU_LOCALE_API
+  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
+  scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+#endif
+
   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;
+    }
+
+  /* Recompute the standard SRFI-14 character sets in a locale-dependent
+     (actually charset-dependent) way.  */
+  scm_srfi_14_compute_char_sets ();
 
-  scm_frame_end ();
+  scm_dynwind_end ();
   return scm_from_locale_string (rv);
 }
 #undef FUNC_NAME
@@ -1412,8 +1478,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)
@@ -1498,20 +1567,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
@@ -1752,21 +1818,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;
@@ -1820,8 +1893,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
 
@@ -1847,8 +1920,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)
@@ -1866,8 +1939,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;
@@ -1878,8 +1951,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;
@@ -1889,9 +1962,13 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
 #endif /* HAVE_GETHOSTNAME */
 
 
-void 
+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");