Adding support for uid and gid manipulation.

* configure: Added check for geteuid and related functions.

* sysif.c (getuid_wrap, geteuid_wrap, getgid_wrap, getegid_wrap,
getgroups_wrap, setuid_wrap, seteuid_wrap, setgid_wrap, setegid_wrap):
New static functions.
(sysif_init): Register intrinsics getuid, geteuid, getgid,
getegid, getgroups, setuid, seteuid, setgid, setegid.

* txr.1: Documented new functions.

4 files changed, 187 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 03dea4f7..f9c2f55d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,19 @@
 2015-08-05  Kaz Kylheku  <kaz@kylheku.com>
 
+	Adding support for uid and gid manipulation.
+
+	* configure: Added check for geteuid and related functions.
+
+	* sysif.c (getuid_wrap, geteuid_wrap, getgid_wrap, getegid_wrap,
+	getgroups_wrap, setuid_wrap, seteuid_wrap, setgid_wrap, setegid_wrap):
+	New static functions.
+	(sysif_init): Register intrinsics getuid, geteuid, getgid,
+	getegid, getgroups, setuid, seteuid, setgid, setegid.
+
+	* txr.1: Documented new functions.
+
+2015-08-05  Kaz Kylheku  <kaz@kylheku.com>
+
 	* lib.c (system_error_s): New symbol variable.
 	(obj_init): Initialize new variable.
 
diff --git a/configure b/configure
index ccd4b927..56d6b59d 100755
--- a/configure
+++ b/configure
@@ -2019,6 +2019,35 @@ else
   printf "no\n"
 fi
 
+printf "Checking for POSIX geteuid function family ... "
+
+cat > conftest.c <<!
+#include <sys/types.h>
+#include <unistd.h>
+
+int main(int argc, char **argv)
+{
+  uid_t u = getuid();
+  uid_t e = geteuid();
+  gid_t g = getgid();
+  gid_t h = getegid();
+  setuid(u);
+  seteuid(e);
+  setgid(g);
+  setegid(h);
+  getgroups(0, NULL);
+  return 0;
+}
+!
+
+if conftest ; then
+  printf "yes\n"
+  printf "#define HAVE_GETEUID 1\n" >> $config_h
+  have_unistd=y
+else
+  printf "no\n"
+fi
+
 #
 # Dependent variables
 #
diff --git a/sysif.c b/sysif.c
index 36013656..9583a18a 100644
--- a/sysif.c
+++ b/sysif.c
@@ -719,6 +719,91 @@ static val poll_wrap(val poll_list, val timeout_in)
 
 #endif
 
+#if HAVE_GETEUID
+
+static val getuid_wrap(void)
+{
+  return num(getuid());
+}
+
+static val geteuid_wrap(void)
+{
+  return num(geteuid());
+}
+
+static val getgid_wrap(void)
+{
+  return num(getgid());
+}
+
+static val getegid_wrap(void)
+{
+  return num(getegid());
+}
+
+static val getgroups_wrap(void)
+{
+  gid_t dummy[1];
+  int needed = getgroups(0, dummy);
+
+  if (needed == 0) {
+    return nil;
+  } else if (needed >  0) {
+    gid_t *arr = coerce(gid_t *, chk_malloc(needed *sizeof *arr));
+    int obtained = getgroups(needed, arr);
+    int i;
+    list_collect_decl (out, ptail);
+
+    if (obtained <= needed) {
+      for (i = 0; i < obtained; i++)
+        ptail = list_collect (ptail, num(arr[i]));
+
+      free(arr);
+      return out;
+    }
+
+    free(arr);
+  }
+
+  uw_throwf(system_error_s, lit("getgroups failed: ~a/~s"),
+            num(errno), string_utf8(strerror(errno)), nao);
+  abort();
+}
+
+static val setuid_wrap(val nval)
+{
+  if (setuid(c_num(nval)) == -1)
+    uw_throwf(system_error_s, lit("setuid failed: ~a/~s"),
+              num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+static val seteuid_wrap(val nval)
+{
+  if (seteuid(c_num(nval)) == -1)
+    uw_throwf(system_error_s, lit("seteuid failed: ~a/~s"),
+              num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+static val setgid_wrap(val nval)
+{
+  if (setgid(c_num(nval)) == -1)
+    uw_throwf(system_error_s, lit("setgid failed: ~a/~s"),
+              num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+static val setegid_wrap(val nval)
+{
+  if (setegid(c_num(nval)) == -1)
+    uw_throwf(system_error_s, lit("setegid failed: ~a/~s"),
+              num(errno), string_utf8(strerror(errno)), nao);
+  return t;
+}
+
+#endif
+
 void sysif_init(void)
 {
   reg_fun(intern(lit("errno"), user_package), func_n1o(errno_wrap, 0));
@@ -906,6 +991,18 @@ void sysif_init(void)
   reg_fun(intern(lit("setenv"), user_package), func_n3o(setenv_wrap, 2));
   reg_fun(intern(lit("unsetenv"), user_package), func_n1(unsetenv_wrap));
 
+#if HAVE_GETEUID
+  reg_fun(intern(lit("getuid"), user_package), func_n0(getuid_wrap));
+  reg_fun(intern(lit("geteuid"), user_package), func_n0(geteuid_wrap));
+  reg_fun(intern(lit("getgid"), user_package), func_n0(getgid_wrap));
+  reg_fun(intern(lit("getegid"), user_package), func_n0(getegid_wrap));
+  reg_fun(intern(lit("getgroups"), user_package), func_n0(getgroups_wrap));
+  reg_fun(intern(lit("setuid"), user_package), func_n1(setuid_wrap));
+  reg_fun(intern(lit("seteuid"), user_package), func_n1(seteuid_wrap));
+  reg_fun(intern(lit("setgid"), user_package), func_n1(setgid_wrap));
+  reg_fun(intern(lit("setegid"), user_package), func_n1(setegid_wrap));
+#endif
+
 #if HAVE_POLL
   reg_fun(intern(lit("poll"), user_package), func_n2o(poll_wrap, 1));
 #endif
diff --git a/txr.1 b/txr.1
index 4319540d..4dd6a704 100644
--- a/txr.1
+++ b/txr.1
@@ -29638,6 +29638,53 @@ function reads the contents of that symbolic link and returns it
 as a string.  Otherwise, it fails by throwing an exception of type
 .codn file-error .
 
+.SS* Unix Credentials
+
+.coNP Functions @, getuid @, geteuid @ getgid and @ getegid
+.synb
+.mets (getuid)
+.mets (geteuid)
+.mets (getgid)
+.mets (getegid)
+.syne
+.desc
+These functions directly correspond to the POSIX C library functions
+of the same name. They retrieve the real user ID, effective user ID,
+real group ID and effective group ID, respectively, of the calling
+process.
+
+.coNP Function @ getgroups
+.synb
+.mets (getgroups)
+.syne
+.desc
+The
+.code getgroups
+function retrieves the list of supplementary group IDs of the calling
+process by calling the same-named POSIX C library function.
+
+Whether or not the effective group ID retrieved by
+.code getegid
+is included in this list is system-dependent. Programs should not
+depend on its presence or absence.
+
+.coNP Functions @, setuid @, seteuid @ setgid and @ setegid
+.synb
+.mets (setuid << uid )
+.mets (seteuid << uid )
+.mets (setgid << gid )
+.mets (setegid << gid )
+.syne
+.desc
+These functions directly correspond to the POSIX C library functions
+of the same name. They set the real user ID, effective user ID,
+real group ID and effective group ID, respectively, of the calling
+process.
+On success, they return
+.code t .
+On failure, they throw an exception of type
+.codn system-error .
+
 .SS* Unix Signal Handling
 
 On platforms where certain advanced features of POSIX signal handling are