commit 8506eb7fa6519d05cb3cf289afda3bfe5aba733a
Author: Stephane Glondu <steph@glondu.net>
Date:   Thu Nov 6 12:33:06 2008 +0100

    Add Unix.{set,init}groups

diff --git a/config/auto-aux/initgroups.c b/config/auto-aux/initgroups.c
new file mode 100644
index 0000000..b588317
--- /dev/null
+++ b/config/auto-aux/initgroups.c
@@ -0,0 +1,26 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <errno.h>
+
+#include <sys/types.h>
+#include <limits.h>
+#include <grp.h>
+
+int main(void)
+{
+  if (initgroups("root", 0) == -1 && errno != EPERM) return 1;
+  return 0;
+}
diff --git a/config/auto-aux/setgroups.c b/config/auto-aux/setgroups.c
new file mode 100644
index 0000000..2e7ad64
--- /dev/null
+++ b/config/auto-aux/setgroups.c
@@ -0,0 +1,28 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <errno.h>
+
+#include <sys/types.h>
+#include <limits.h>
+#include <grp.h>
+
+int main(void)
+{
+  gid_t gidset[1];
+  gidset[0] = 0;
+  if (setgroups(1, gidset) == -1 && errno != EPERM) return 1;
+  return 0;
+}
diff --git a/config/s-templ.h b/config/s-templ.h
index edc3860..b934e3b 100644
--- a/config/s-templ.h
+++ b/config/s-templ.h
@@ -139,6 +139,14 @@
 
 /* Define HAS_GETGROUPS if you have getgroups(). */
 
+#define HAS_SETGROUPS
+
+/* Define HAS_SETGROUPS if you have setgroups(). */
+
+#define HAS_INITGROUPS
+
+/* Define HAS_INITGROUPS if you have initgroups(). */
+
 #define HAS_TERMIOS
 
 /* Define HAS_TERMIOS if you have /usr/include/termios.h and it is
diff --git a/configure b/configure
index 748f1ce..bc6cacf 100755
--- a/configure
+++ b/configure
@@ -972,6 +972,16 @@ if sh ./hasgot -i limits.h && sh ./runtest getgroups.c; then
   echo "#define HAS_GETGROUPS" >> s.h
 fi
 
+if sh ./hasgot -i limits.h -i grp.h && sh ./runtest setgroups.c; then
+  echo "setgroups() found."
+  echo "#define HAS_SETGROUPS" >> s.h
+fi
+
+if sh ./hasgot -i limits.h -i grp.h && sh ./runtest initgroups.c; then
+  echo "initgroups() found."
+  echo "#define HAS_INITGROUPS" >> s.h
+fi
+
 if sh ./hasgot -i termios.h &&
    sh ./hasgot tcgetattr tcsetattr tcsendbreak tcflush tcflow; then
   echo "POSIX termios found."
diff --git a/otherlibs/threads/unix.ml b/otherlibs/threads/unix.ml
index 247cb10..a137817 100644
--- a/otherlibs/threads/unix.ml
+++ b/otherlibs/threads/unix.ml
@@ -473,6 +473,8 @@ external getgid : unit -> int = "unix_getgid"
 external getegid : unit -> int = "unix_getegid"
 external setgid : int -> unit = "unix_setgid"
 external getgroups : unit -> int array = "unix_getgroups"
+external setgroups : int array -> unit = "unix_setgroups"
+external initgroups : string -> int -> unit = "unix_initgroups"
 
 type passwd_entry =
   { pw_name : string;
@@ -1110,4 +1112,3 @@ let establish_server server_fun sockaddr =
             exit 0
     | id -> close s; ignore(waitpid [] id) (* Reclaim the son *)
   done
-
diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile
index 8b08519..055079c 100644
--- a/otherlibs/unix/Makefile
+++ b/otherlibs/unix/Makefile
@@ -26,11 +26,11 @@ COBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \
   getaddrinfo.o getcwd.o getegid.o geteuid.o getgid.o \
   getgr.o getgroups.o gethost.o gethostname.o getlogin.o \
   getnameinfo.o getpeername.o getpid.o getppid.o getproto.o getpw.o \
-  gettimeofday.o getserv.o getsockname.o getuid.o \
-  gmtime.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o mkdir.o \
-  mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o \
+  gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o \
+  initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o \
+  mkdir.o mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o \
   readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
-  setgid.o setsid.o setuid.o shutdown.o signals.o \
+  setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \
   sleep.o socket.o socketaddr.o \
   socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \
   time.o times.o truncate.o umask.o unixsupport.o unlink.o \
diff --git a/otherlibs/unix/initgroups.c b/otherlibs/unix/initgroups.c
new file mode 100644
index 0000000..924f70b
--- /dev/null
+++ b/otherlibs/unix/initgroups.c
@@ -0,0 +1,43 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include <alloc.h>
+#include <fail.h>
+
+#ifdef HAS_INITGROUPS
+
+#include <sys/types.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <limits.h>
+#include <grp.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_initgroups(value user, value group)
+{
+  if (initgroups(String_val(user), Int_val(group)) == -1) {
+    uerror("setgroups", Nothing);
+  }
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_initgroups(value user, value group)
+{ invalid_argument("initgroups not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/setgroups.c b/otherlibs/unix/setgroups.c
new file mode 100644
index 0000000..f2ae6d1
--- /dev/null
+++ b/otherlibs/unix/setgroups.c
@@ -0,0 +1,52 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../../LICENSE.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include <alloc.h>
+#include <fail.h>
+
+#ifdef HAS_SETGROUPS
+
+#include <sys/types.h>
+#ifdef HAS_UNISTD
+#include <unistd.h>
+#endif
+#include <limits.h>
+#include <grp.h>
+#include "unixsupport.h"
+
+CAMLprim value unix_setgroups(value groups)
+{
+  gid_t * gidset;
+  mlsize_t size, i;
+  int n;
+
+  size = Wosize_val(groups);
+  gidset = (gid_t *) stat_alloc(size * sizeof(gid_t));
+  for (i = 0; i < size; i++) gidset[i] = Int_val(Field(groups, i));
+
+  n = setgroups(size, gidset);
+
+  stat_free(gidset);
+  if (n == -1) uerror("setgroups", Nothing);
+  return Val_unit;
+}
+
+#else
+
+CAMLprim value unix_setgroups(value groups)
+{ invalid_argument("setgroups not implemented"); }
+
+#endif
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 6f03043..ef2de12 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -365,6 +365,8 @@ external getgid : unit -> int = "unix_getgid"
 external getegid : unit -> int = "unix_getegid"
 external setgid : int -> unit = "unix_setgid"
 external getgroups : unit -> int array = "unix_getgroups"
+external setgroups : int array -> unit = "unix_setgroups"
+external initgroups : string -> int -> unit = "unix_initgroups"
 
 type passwd_entry =
   { pw_name : string;
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index 851c4f8..afe1348 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -820,6 +820,16 @@ val getgroups : unit -> int array
 (** Return the list of groups to which the user executing the process
    belongs. *)
 
+val setgroups : int array -> unit
+  (** [setgroups groups] sets the supplementary group IDs for the
+      calling process. Appropriate privileges are required. *)
+
+val initgroups : string -> int -> unit
+  (** [initgroups user group] initializes the group access list by
+      reading the group database /etc/group and using all groups of
+      which [user] is a member. The additional group [group] is also
+      added to the list. *)
+
 type passwd_entry =
   { pw_name : string;
     pw_passwd : string;
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index 0d4b190..d22f733 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -435,6 +435,8 @@ let getegid = getgid
 let setgid id = invalid_arg "Unix.setgid not implemented"
 
 let getgroups () = [|1|]
+let setgroups _ = invalid_arg "Unix.setgroups not implemented"
+let initgroups _ _ = invalid_arg "Unix.initgroups not implemented"
 
 type passwd_entry =
   { pw_name : string;