Added some new posix functions:

(scm_crypt, scm_chroot, scm_getlogin, scm_cuserid),
	(scm_getpriority, scm_setpriority, scm_getpass, scm_flock),
	(scm_sethostname, scm_gethostname): New procedures.

ChangeLog

@@ -1,3 +1,10 @@
+2001-03-09  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>
+
+	* configure.in: Added header checks for crypt.h, sys/resource.h
+	and sys/file.h, function checks for chroot, flock, getlogin,
+	cuserid, getpriority, setpriority, getpass, sethostname,
+	gethostname, and for crypt() in libcrypt.
+
 2001-03-09  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* configure.in (htmldoc): Merge handling of `--enable-htmldoc'

NEWS

@@ -365,6 +365,38 @@ close: Ports and File Descriptors.), the file descriptor will be
 closed even if a port is using it.  The return value is
 unspecified.
 
+** New function: crypt password salt
+
+Encrypts `password' using the standard unix password encryption
+algorithm.
+
+** New function: chroot path
+
+Change the root directory of the running process to `path'.
+
+** New functions: getlogin, cuserid
+
+Return the login name or the user name of the current effective user
+id, respectively.
+
+** New functions: getpriority which who, setpriority which who prio
+
+Get or set the priority of the running process.
+
+** New function: getpass prompt
+
+Read a password from the terminal, first displaying `prompt' and
+disabling echoing.
+
+** New function: flock file operation
+
+Set/remove an advisory shared or exclusive lock on `file'.
+
+** New functions: sethostname name, gethostname
+
+Set or get the hostname of the machine the current process is running
+on.
+
 ** Deprecated: close-all-ports-except.  This was intended for closing
 ports in a child process after a fork, but it has the undesirable side
 effect of flushing buffers.  port-for-each is more flexible.

configure.in

@@ -197,6 +197,10 @@ AC_SUBST(DLPREOPEN)
 
 AC_CHECK_FUNCS(ctermid ftime fchown getcwd geteuid gettimeofday lstat mkdir mknod nice readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt strftime strptime symlink sync tcgetpgrp tcsetpgrp times uname waitpid bzero strdup system usleep atexit on_exit)
 
+AC_CHECK_HEADERS(crypt.h sys/resource.h sys/file.h)
+AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname)
+AC_CHECK_LIB(crypt, crypt)
+
 ### Some systems don't declare some functions.  On such systems, we
 ### need to at least provide our own K&R-style declarations.
 

libguile/ChangeLog

@@ -1,3 +1,17 @@
+2001-03-09  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>
+
+	* posix.h (scm_crypt, scm_chroot, scm_getlogin, scm_cuserid),
+	(scm_getpriority, scm_setpriority, scm_getpass, scm_flock),
+	(scm_sethostname, scm_gethostname): New prototypes.
+
+	* posix.c: Added inclusion of <crypt.h>, <sys/resource.h> and
+	<sys/file.h>, if present.
+	(scm_init_posix): [PRIO_PROCESS, PRIO_PGRP, PRIO_USER, LOCK_SH,
+	LOCK_EX, LOCK_UN, LOCK_NB]: New variables.
+	(scm_crypt, scm_chroot, scm_getlogin, scm_cuserid),
+	(scm_getpriority, scm_setpriority, scm_getpass, scm_flock),
+	(scm_sethostname, scm_gethostname): New procedures.
+
 2001-03-08  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* ports.c (scm_port_column): Docstring fixes: (i) port-line arg is

libguile/posix.c

@@ -71,6 +71,8 @@
 #endif
 
 #ifdef HAVE_UNISTD_H
+/* GNU/Linux libc requires __USE_XOPEN or cuserid() is not defined.  */
+#define __USE_XOPEN
 #include <unistd.h>
 #else
 #ifndef ttyname
@@ -126,6 +128,18 @@ extern char ** environ;
 #include <locale.h>
 #endif
 
+#if HAVE_LIBCRYPT && HAVE_CRYPT_H
+#  include <crypt.h>
+#endif
+
+#if HAVE_SYS_RESOURCE_H
+#  include <sys/resource.h>
+#endif
+
+#if HAVE_SYS_FILE_H
+# include <sys/file.h>
+#endif
+
 /* Some Unix systems don't define these.  CPP hair is dangerous, but
    this seems safe enough... */
 #ifndef R_OK
@@ -1261,6 +1275,260 @@ SCM_DEFINE (scm_sync, "sync", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYNC */
 
+#if HAVE_LIBCRYPT && HAVE_CRYPT_H
+SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, 
+            (SCM key, SCM salt),
+	    "Encrypt @var{key} using @var{salt} as the salt value to the\n"
+	    "crypt(3) library call\n")
+#define FUNC_NAME s_scm_crypt
+{
+  char * p;
+
+  SCM_VALIDATE_STRING (1, key);
+  SCM_VALIDATE_STRING (2, salt);
+  SCM_STRING_COERCE_0TERMINATION_X (key);
+  SCM_STRING_COERCE_0TERMINATION_X (salt);
+
+  p = crypt (SCM_STRING_CHARS (key), SCM_STRING_CHARS (salt));
+  return scm_makfrom0str (p);
+}
+#undef FUNC_NAME
+#endif /* HAVE_LIBCRYPT && HAVE_CRYPT_H */
+
+#if HAVE_CHROOT
+SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0, 
+            (SCM path),
+	    "Change the root directory to that specified in @var{path}.\n"
+	    "This directory will be used for path names beginning with\n"
+	    "@file{/}.  The root directory is inherited by all children\n"
+	    "of the current process.  Only the superuser may change the\n"
+	    "root directory.")
+#define FUNC_NAME s_scm_chroot
+{
+  SCM_VALIDATE_STRING (1, path);
+  SCM_STRING_COERCE_0TERMINATION_X (path);
+
+  if (chroot (SCM_STRING_CHARS (path)) == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_CHROOT */
+
+#if HAVE_GETLOGIN
+SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0, 
+            (void),
+	    "Return a string containing the name of the user logged in on\n"
+	    "the controlling terminal of the process, or @code{#f} if this\n"
+	    "information cannot be obtained.")
+#define FUNC_NAME s_scm_getlogin
+{
+  char * p;
+
+  p = getlogin ();
+  if (!p || !*p)
+    return SCM_BOOL_F;
+  return scm_makfrom0str (p);
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETLOGIN */
+
+#if HAVE_CUSERID
+SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0, 
+            (void),
+	    "Return a string containing a user name associated with the\n"
+	    "effective user id of the process.  Return @code{#f} if this\n"
+	    "information cannot be obtained.")
+#define FUNC_NAME s_scm_cuserid
+{
+  char * p;
+
+  p = cuserid (NULL);
+  if (!p || !*p)
+    return SCM_BOOL_F;
+  return scm_makfrom0str (p);
+}
+#undef FUNC_NAME
+#endif /* HAVE_CUSERID */
+
+#if HAVE_GETPRIORITY
+SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0, 
+            (SCM which, SCM who),
+	    "Return the scheduling priority of the process, process group\n"
+	    "or user, as indicated by @var{which} and @var{who}. @var{which}\n"
+	    "is one of the variables @code{PRIO_PROCESS}, @code{PRIO_PGRP}\n"
+	    "or @code{PRIO_USER}, and @var{who} is interpreted relative to\n"
+	    "@var{which} (a process identifier for @code{PRIO_PROCESS},\n"
+	    "process group identifier for @code{PRIO_PGRP}, and a user\n"
+	    "identifier for @code{PRIO_USER}.  A zero value of @var{who}\n"
+	    "denotes the current process, process group, or user.  Return\n"
+	    "the highest priority (lowest numerical value) of any of the\n"
+	    "specified processes.")
+#define FUNC_NAME s_scm_getpriority
+{
+  int cwhich, cwho, ret;
+
+  SCM_VALIDATE_INUM_COPY (1, which, cwhich);
+  SCM_VALIDATE_INUM_COPY (2, who, cwho);
+
+  /* We have to clear errno and examine it later, because -1 is a
+     legal return value for getpriority().  */
+  errno = 0;
+  ret = getpriority (cwhich, cwho);
+  if (errno != 0)
+    SCM_SYSERROR;
+  return SCM_MAKINUM (ret);
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETPRIORITY */
+
+#if HAVE_SETPRIORITY
+SCM_DEFINE (scm_setpriority, "setpriority", 3, 0, 0, 
+            (SCM which, SCM who, SCM prio),
+	    "Set the scheduling priority of the process, process group\n"
+	    "or user, as indicated by @var{which} and @var{who}. @var{which}\n"
+	    "is one of the variables @code{PRIO_PROCESS}, @code{PRIO_PGRP}\n"
+	    "or @code{PRIO_USER}, and @var{who} is interpreted relative to\n"
+	    "@var{which} (a process identifier for @code{PRIO_PROCESS},\n"
+	    "process group identifier for @code{PRIO_PGRP}, and a user\n"
+	    "identifier for @code{PRIO_USER}.  A zero value of @var{who}\n"
+	    "denotes the current process, process group, or user.\n"
+	    "@var{prio} is a value in the range -20 and 20, the default\n"
+	    "priority is 0; lower priorities cause more favorable\n"
+	    "scheduling.  Sets the priority of all of the specified\n"
+	    "processes.  Only the super-user may lower priorities.\n"
+	    "The return value is not specified.")
+#define FUNC_NAME s_scm_setpriority
+{
+  int cwhich, cwho, cprio;
+
+  SCM_VALIDATE_INUM_COPY (1, which, cwhich);
+  SCM_VALIDATE_INUM_COPY (2, who, cwho);
+  SCM_VALIDATE_INUM_COPY (3, prio, cprio);
+
+  if (setpriority (cwhich, cwho, cprio) == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETPRIORITY */
+
+#if HAVE_GETPASS
+SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0, 
+            (SCM prompt),
+	    "Display @var{prompt} to the standard error output and read\n"
+	    "a password from @file{/dev/tty}.  If this file is not\n"
+	    "accessible, it reads from standard input.  The password may be\n"
+	    "up to 127 characters in length.  Additional characters and the\n"
+	    "terminating newline character are discarded.  While reading\n"
+	    "the password, echoing and the generation of signals by special\n"
+	    "characters is disabled.")
+#define FUNC_NAME s_scm_getpass
+{
+  char * p;
+  SCM passwd;
+
+  SCM_VALIDATE_STRING (1, prompt);
+  SCM_STRING_COERCE_0TERMINATION_X (prompt);
+
+  p = getpass(SCM_STRING_CHARS (prompt));
+  passwd = scm_makfrom0str (p);
+
+  /* Clear out the password in the static buffer.  */
+  memset (p, 0, strlen (p));
+
+  return passwd;
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETPASS */
+
+#if HAVE_FLOCK
+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"
+	    "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"
+	    "Exclusive lock.  Only one process may hold an exclusive lock\n"
+	    "for a given file at a given time.\n"
+	    "@item 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"
+	    "The return value is not specified. @var{file} may be an open\n"
+	    "file descriptor or an open file descriptior port.")
+#define FUNC_NAME s_scm_flock
+{
+  int coperation, fdes;
+
+  if (SCM_INUMP (file))
+    fdes = SCM_INUM (file);
+  else
+    {
+      SCM_VALIDATE_OPFPORT (2, file);
+
+      fdes = SCM_FPORT_FDES (file);
+    }
+  SCM_VALIDATE_INUM_COPY (2, operation, coperation);
+  if (flock (fdes, coperation) == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_FLOCK */
+
+#if HAVE_SETHOSTNAME
+SCM_DEFINE (scm_sethostname, "sethostname", 1, 0, 0, 
+            (SCM name),
+	    "Set the host name of the current processor to @var{name}. May\n"
+	    "only be used by the superuser.  The return value is not\n"
+	    "specified.")
+#define FUNC_NAME s_scm_sethostname
+{
+  SCM_VALIDATE_STRING (1, name);
+  SCM_STRING_COERCE_0TERMINATION_X (name);
+
+  if (sethostname (SCM_STRING_CHARS (name), SCM_STRING_LENGTH (name)) == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETHOSTNAME */
+
+#if HAVE_GETHOSTNAME
+SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, 
+            (void),
+	    "Return the host name of the current processor.")
+#define FUNC_NAME s_scm_gethostname
+{
+  int len = 2, res;
+  char *p = scm_must_malloc (len, "gethostname");
+  SCM name;
+
+  res = gethostname (p, len);
+  while (res == -1 && errno == ENAMETOOLONG)
+    {
+      p = scm_must_realloc (p, len, len * 2, "gethostname");
+      len *= 2;
+      res = gethostname (p, len);
+    }
+  if (res == -1)
+    {
+      scm_must_free (p);
+      SCM_SYSERROR;
+    }
+  name = scm_makfrom0str (p);
+  scm_must_free (p);
+  return name;
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETHOSTNAME */
+
 void 
 scm_init_posix ()
 {
@@ -1312,6 +1580,29 @@ scm_init_posix ()
 scm_sysintern ("PIPE_BUF", scm_long2num (PIPE_BUF));
 #endif
 
+#ifdef PRIO_PROCESS
+  scm_sysintern ("PRIO_PROCESS", SCM_MAKINUM (PRIO_PROCESS));
+#endif
+#ifdef PRIO_PGRP
+  scm_sysintern ("PRIO_PGRP", SCM_MAKINUM (PRIO_PGRP));
+#endif
+#ifdef PRIO_USER
+  scm_sysintern ("PRIO_USER", SCM_MAKINUM (PRIO_USER));
+#endif
+
+#ifdef LOCK_SH
+  scm_sysintern ("LOCK_SH", SCM_MAKINUM (LOCK_SH));
+#endif
+#ifdef LOCK_EX
+  scm_sysintern ("LOCK_EX", SCM_MAKINUM (LOCK_EX));
+#endif
+#ifdef LOCK_UN
+  scm_sysintern ("LOCK_UN", SCM_MAKINUM (LOCK_UN));
+#endif
+#ifdef LOCK_NB
+  scm_sysintern ("LOCK_NB", SCM_MAKINUM (LOCK_NB));
+#endif
+
 #include "libguile/cpp_sig_symbols.c"
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/posix.x"

libguile/posix.h

@@ -95,6 +95,16 @@ extern SCM scm_setlocale (SCM category, SCM locale);
 extern SCM scm_mknod (SCM path, SCM type, SCM perms, SCM dev);
 extern SCM scm_nice (SCM incr);
 extern SCM scm_sync (void);
+extern SCM scm_crypt (SCM key, SCM salt);
+extern SCM scm_chroot (SCM path);
+extern SCM scm_getlogin (void);
+extern SCM scm_cuserid (void);
+extern SCM scm_getpriority (SCM which, SCM who);
+extern SCM scm_setpriority (SCM which, SCM who, SCM prio);
+extern SCM scm_getpass (SCM prompt);
+extern SCM scm_flock (SCM file, SCM operation);
+extern SCM scm_sethostname (SCM name);
+extern SCM scm_gethostname (void);
 extern void scm_init_posix (void);
 
 #endif  /* POSIXH */