Index: configure.in =================================================================== RCS file: /cvsroot/guile/guile/guile-core/configure.in,v retrieving revision 1.222 diff -u -r1.222 configure.in --- configure.in 21 Jun 2003 00:15:09 -0000 1.222 +++ configure.in 30 Jun 2003 22:32:37 -0000 @@ -591,7 +591,7 @@ [Define if the system supports Unix-domain (file-domain) sockets.]) fi -AC_CHECK_FUNCS(socketpair getgroups setpwent pause tzset) +AC_CHECK_FUNCS(socketpair getgroups setgroups setpwent pause tzset) AC_CHECK_FUNCS(sethostent gethostent endhostent dnl setnetent getnetent endnetent dnl Index: libguile/posix.c =================================================================== RCS file: /cvsroot/guile/guile/guile-core/libguile/posix.c,v retrieving revision 1.118 diff -u -r1.118 posix.c --- libguile/posix.c 14 Jun 2003 05:36:02 -0000 1.118 +++ libguile/posix.c 30 Jun 2003 22:32:38 -0000 @@ -228,6 +228,46 @@ #undef FUNC_NAME #endif +#ifdef HAVE_SETGROUPS +SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0, + (SCM group_vec), + "Set the supplementary group IDs to those found in the vector argument.") +#define FUNC_NAME s_scm_setgroups +{ + size_t ngroups; + size_t size; + size_t i; + int result; + int save_errno; + GETGROUPS_T *groups; + + SCM_VALIDATE_VECTOR (SCM_ARG1, group_vec); + + ngroups = SCM_VECTOR_LENGTH (group_vec); + + /* validate before allocating, so we don't have to worry about leaks */ + for (i = 0; i < ngroups; i++) + SCM_VALIDATE_INUM (0, SCM_VECTOR_REF (group_vec, i)); + + size = ngroups * sizeof (GETGROUPS_T); + /* XXX - if (size / sizeof (GETGROUPS_T) != ngroups) out-of-range */ + groups = scm_malloc (size); + if (groups == NULL) + SCM_MEMORY_ERROR; + for(i = 0; i < ngroups; i++) + groups [i] = SCM_INUM (SCM_VECTOR_REF (group_vec, i)); + + result = setgroups (ngroups, groups); + save_errno = errno; /* don't let free() touch errno */ + free (groups); + errno = save_errno; + if (result < 0) + SCM_SYSERROR; + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif + #ifdef HAVE_GETPWENT SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, (SCM user),