PR#3047: added Unix.setgroups, Unix.initgroups.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9220 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Xavier Leroy <xavier.leroy@inria.fr> 2009-04-01 16:50:10 +0000
committer: Xavier Leroy <xavier.leroy@inria.fr> 2009-04-01 16:50:10 +0000
commit: 238cf4bde3037f3bac90ab476a25bf794156e844 (patch)
tree: 8fcf447d81f6d00a5ca40b25486e6ed9a5a5e29a /otherlibs
parent: 3c9c7b99493a38590e8848dbac1b0b08d7ea995e (diff)
7 files changed, 116 insertions, 5 deletions
diff --git a/otherlibs/threads/unix.ml b/otherlibs/threads/unix.ml
index 6223e1119..62c18b7e4 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 bdb4b85cb..e489001b8 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 000000000..ff81e8842
--- /dev/null
+++ b/otherlibs/unix/initgroups.c
@@ -0,0 +1,43 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*  Copyright 2009 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.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* Contributed by Stephane Glondu <steph@glondu.net> */
+
+/* $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 000000000..dd4592ad0
--- /dev/null
+++ b/otherlibs/unix/setgroups.c
@@ -0,0 +1,53 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*  Copyright 2009 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.  */
+/*                                                                     */
+/***********************************************************************/
+
+/* Contributed by Stephane Glondu <steph@glondu.net> */
+
+/* $Id$ */
+
+#include <mlvalues.h>
+#include <alloc.h>
+#include <fail.h>
+#include <memory.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 193071c4a..fd1e8e286 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 5ac691320..386864e05 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 2b4411659..f8d663170 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;
author	Xavier Leroy <xavier.leroy@inria.fr>	2009-04-01 16:50:10 +0000
committer	Xavier Leroy <xavier.leroy@inria.fr>	2009-04-01 16:50:10 +0000
commit	238cf4bde3037f3bac90ab476a25bf794156e844 (patch)
tree	8fcf447d81f6d00a5ca40b25486e6ed9a5a5e29a /otherlibs
parent	3c9c7b99493a38590e8848dbac1b0b08d7ea995e (diff)