Revert "lib: use getgrouplist to fetch user's groups"

Revert use of getgrouplist C function instead of getgroups. getgrouplist
returns a result different than the one obtained with "id" command on
some OSes (FreeBSD, Cygwin, MSYS).

Stay with getgroups for the moment, as it is still the standard way
(POSIX.1-2008) to retrieve user groups.

.hunspell.en.dic

@@ -1158,5 +1158,3 @@ LMSTICKYRULE
 Chardon
 Jérémy
 Déchard
-getgrouplist
-getgroups

Makefile

@@ -62,6 +62,9 @@ TEST_PREREQ += lib/libtclenvmodules$(SHLIB_SUFFIX)
 ifeq ($(COVERAGE),y)
 TEST_PREREQ += lib/libtestutil-closedir$(SHLIB_SUFFIX) \
 	lib/libtestutil-getpwuid$(SHLIB_SUFFIX) \
+	lib/libtestutil-getgroups$(SHLIB_SUFFIX) \
+	lib/libtestutil-0getgroups$(SHLIB_SUFFIX) \
+	lib/libtestutil-dupgetgroups$(SHLIB_SUFFIX) \
 	lib/libtestutil-getgrgid$(SHLIB_SUFFIX) \
 	lib/libtestutil-time$(SHLIB_SUFFIX) \
 	lib/libtestutil-mktime$(SHLIB_SUFFIX)
@@ -570,6 +573,15 @@ lib/libtestutil-closedir$(SHLIB_SUFFIX):
 lib/libtestutil-getpwuid$(SHLIB_SUFFIX):
 	$(MAKE) --no-print-directory -C lib $(@F)
 
+lib/libtestutil-getgroups$(SHLIB_SUFFIX):
+	$(MAKE) --no-print-directory -C lib $(@F)
+
+lib/libtestutil-0getgroups$(SHLIB_SUFFIX):
+	$(MAKE) --no-print-directory -C lib $(@F)
+
+lib/libtestutil-dupgetgroups$(SHLIB_SUFFIX):
+	$(MAKE) --no-print-directory -C lib $(@F)
+
 lib/libtestutil-getgrgid$(SHLIB_SUFFIX):
 	$(MAKE) --no-print-directory -C lib $(@F)
 
@@ -1066,7 +1078,9 @@ $(V).SILENT: initdir pkgdoc doc version.inc contrib/rpm/environment-modules.spec
 	tcl/util.tcl_i ChangeLog.gz README script/add.modules \
 	script/gitlog2changelog.py script/modulecmd \
 	lib/libtclenvmodules$(SHLIB_SUFFIX) lib/libtestutil-closedir$(SHLIB_SUFFIX) \
-	lib/libtestutil-getpwuid$(SHLIB_SUFFIX) lib/libtestutil-getgrgid$(SHLIB_SUFFIX) \
+	lib/libtestutil-getpwuid$(SHLIB_SUFFIX) lib/libtestutil-getgroups$(SHLIB_SUFFIX) \
+	lib/libtestutil-0getgroups$(SHLIB_SUFFIX) \
+	lib/libtestutil-dupgetgroups$(SHLIB_SUFFIX) lib/libtestutil-getgrgid$(SHLIB_SUFFIX) \
 	lib/libtestutil-time$(SHLIB_SUFFIX) lib/libtestutil-mktime$(SHLIB_SUFFIX) \
 	testsuite/example/.modulespath testsuite/example/modulespath-wild \
 	testsuite/example/modulerc testsuite/example/initrc-1 testsuite/example/initrc \

lib/.gitignore

@@ -11,6 +11,9 @@
 /libtclenvmodules.so
 /libtestutil-closedir.so
 /libtestutil-getpwuid.so
+/libtestutil-getgroups.so
+/libtestutil-0getgroups.so
+/libtestutil-dupgetgroups.so
 /libtestutil-getgrgid.so
 /libtestutil-time.so
 /libtestutil-mktime.so

lib/Makefile.in

@@ -40,6 +40,18 @@ libtestutil-getpwuid@SHLIB_SUFFIX@: testutil-getpwuid.c
 	$(ECHO_CC)
 	$(LDCC) $< -o $@
 
+libtestutil-getgroups@SHLIB_SUFFIX@: testutil-getgroups.c
+	$(ECHO_CC)
+	$(LDCC) $< -o $@
+
+libtestutil-0getgroups@SHLIB_SUFFIX@: testutil-0getgroups.c
+	$(ECHO_CC)
+	$(LDCC) $< -o $@
+
+libtestutil-dupgetgroups@SHLIB_SUFFIX@: testutil-dupgetgroups.c
+	$(ECHO_CC)
+	$(LDCC) $< -o $@
+
 libtestutil-getgrgid@SHLIB_SUFFIX@: testutil-getgrgid.c
 	$(ECHO_CC)
 	$(LDCC) $< -o $@
@@ -57,6 +69,9 @@ clean:
 	rm -f libtclenvmodules@TCL_SHLIB_SUFFIX@
 	rm -f libtestutil-closedir@SHLIB_SUFFIX@
 	rm -f libtestutil-getpwuid@SHLIB_SUFFIX@
+	rm -f libtestutil-getgroups@SHLIB_SUFFIX@
+	rm -f libtestutil-0getgroups@SHLIB_SUFFIX@
+	rm -f libtestutil-dupgetgroups@SHLIB_SUFFIX@
 	rm -f libtestutil-getgrgid@SHLIB_SUFFIX@
 	rm -f libtestutil-time@SHLIB_SUFFIX@
 	rm -f libtestutil-mktime@SHLIB_SUFFIX@
@@ -83,5 +98,6 @@ endif
 # let verbose by default the install/clean/test and other specific non-build targets
 $(V).SILENT: envmodules.o libtclenvmodules@TCL_SHLIB_SUFFIX@ \
 	libtestutil-closedir@SHLIB_SUFFIX@ libtestutil-getpwuid@SHLIB_SUFFIX@ \
-	libtestutil-getgrgid@SHLIB_SUFFIX@ libtestutil-time@SHLIB_SUFFIX@ \
-	libtestutil-mktime@SHLIB_SUFFIX@
+	libtestutil-getgroups@SHLIB_SUFFIX@ libtestutil-0getgroups@SHLIB_SUFFIX@ \
+	libtestutil-dupgetgroups@SHLIB_SUFFIX@ libtestutil-getgrgid@SHLIB_SUFFIX@ \
+	libtestutil-time@SHLIB_SUFFIX@ libtestutil-mktime@SHLIB_SUFFIX@

lib/configure.ac

@@ -22,10 +22,9 @@ AC_CHECK_HEADERS([fcntl.h unistd.h errno.h limits.h sys/types.h pwd.h grp.h stdl
 
 # Checks for typedefs, structures, and compiler characteristics.
 AC_TYPE_SSIZE_T
-AC_TYPE_UID_T
 
 # Checks for library functions.
-AC_CHECK_FUNCS_ONCE([getgrouplist])
+AC_FUNC_GETGROUPS
 
 # TEA-specific setup
 TEA_SETUP_COMPILER

lib/envmodules.c

@@ -20,8 +20,6 @@
 
 #define _ISOC99_SOURCE
 #define _XOPEN_SOURCE
-#define _DEFAULT_SOURCE
-#define _BSD_SOURCE
 
 #include <unistd.h>
 #include <fcntl.h>
@@ -39,6 +37,15 @@
 #include "envmodules.h"
 
 
+/*	Utility function to compare 2 integers for qsort function. */
+int
+__Envmodules_IntCmp(
+   const void* i,
+   const void* j)
+{
+   return (i > j) - (i < j);
+}
+
 /*----------------------------------------------------------------------
  *
  * Envmodules_GetFilesInDirectoryObjCmd --
@@ -341,49 +348,60 @@ Envmodules_InitStateUsergroupsObjCmd(
    int objc,               /* Number of arguments. */
    Tcl_Obj *const objv[])  /* Argument objects. */
 {
-   gid_t *groups;
-   int ngroups;
-   int i;
+   GETGROUPS_T *groups;
+   int ngroups = 0;
+   int egid_in_groups = 0;
+   GETGROUPS_T egid;
+   int i, j;
    struct group *grp;
    char gidstr[16];
    Tcl_Obj *lres;
-#if defined (HAVE_GETGROUPLIST)
-   uid_t uid;
-   struct passwd *pwd;
-   char uidstr[16];
+
+#if defined (HAVE_GETGROUPS)
+   ngroups = getgroups(0, (GETGROUPS_T *) NULL);
 #endif
 
-#if defined (HAVE_GETGROUPLIST)
-   /* Fetch user passwd entry */
-   uid = getuid();
-   if ((pwd = getpwuid(uid)) == NULL) {
+   /* Fetch supplementary group list unless getgroups not supported */
+   groups = (GETGROUPS_T *) ckalloc((ngroups + 1) * sizeof(GETGROUPS_T));
+
+#if defined (HAVE_GETGROUPS)
+   if ((ngroups = getgroups(ngroups, groups)) == -1) {
       Tcl_SetErrno(errno);
-      sprintf(uidstr, "%d", uid);
       Tcl_SetObjResult(interp,
-         Tcl_ObjPrintf("couldn't find name for user id \"%s\": %s", uidstr,
+         Tcl_ObjPrintf("couldn't get supplementary groups: %s",
          Tcl_PosixError(interp)));
+      ckfree((char *) groups);
       return TCL_ERROR;
    }
-
-   /* Initial maximum group number guess to allocate groups array */
-   ngroups = 16;
-   groups = (gid_t *) ckalloc(ngroups * sizeof(gid_t));
-
-   /* If user belongs to more than initial group count, -1 is returned and
-    * ngroups is updated to the total number of groups */
-   if (getgrouplist(pwd->pw_name, pwd->pw_gid, groups, &ngroups) == -1) {
-      groups = (gid_t *) ckrealloc(groups, ngroups * sizeof(gid_t));
-      getgrouplist(pwd->pw_name, pwd->pw_gid, groups, &ngroups);
-   }
-   /* getgrouplist result does not contain duplicate entries and contains
-    * primary group */
-#else
-   /* Only add primary group if getgrouplist function is not available */
-   ngroups = 1;
-   groups = (gid_t *) ckalloc(sizeof(gid_t));
-   groups[0] = getegid();
 #endif
 
+   /* Sort then remove duplicates from getgroups result */
+   if (ngroups > 1) {
+      qsort(groups, ngroups, sizeof(GETGROUPS_T), __Envmodules_IntCmp);
+      j = 0;
+      for (i = 1; i < ngroups; i++) {
+         if (groups[i] != groups[j]) {
+            j++;
+            groups[j] = groups[i];
+         }
+      }
+      ngroups = j + 1;
+   }
+
+   /* Add primary group if not part of getgroups result (or if getgroups
+    * function is not available) */
+   egid = getegid();
+   for (i = 0; i < ngroups; i++) {
+      if (egid == groups[i]) {
+         egid_in_groups = 1;
+         break;
+      }
+   }
+   if (egid_in_groups == 0) {
+      groups[ngroups] = egid;
+      ngroups++;
+   }
+
    /* Add group name of primary gid and each supplementatry gid to result
     * list */
    lres = Tcl_NewObj();

lib/testutil-0getgroups.c

@@ -0,0 +1,28 @@
+/*************************************************************************
+ *
+ * TESTUTIL-GETGROUPS.C, Superseded getgroups function for test purpose
+ * Copyright (C) 2020-2021 Xavier Delaruelle
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ ************************************************************************/
+
+#include <unistd.h>
+
+int getgroups(int size, gid_t list[])
+{
+    return 0;
+}
+
+/* vim:set tabstop=3 shiftwidth=3 expandtab autoindent: */

lib/testutil-dupgetgroups.c

@@ -0,0 +1,39 @@
+/*************************************************************************
+ *
+ * TESTUTIL-DUPGETGROUPS.C, Superseded getgroups function for test purpose
+ * Copyright (C) 2020-2024 Xavier Delaruelle
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ ************************************************************************/
+
+#include <unistd.h>
+#include <sys/types.h>
+#include "config.h"
+
+int getgroups(int size, gid_t list[])
+{
+   GETGROUPS_T egid;
+
+   egid = getegid();
+   if (list != NULL) {
+      list[0] = egid;
+      list[1] = egid;
+      list[2] = egid;
+   }
+
+   return 3;
+}
+
+/* vim:set tabstop=3 shiftwidth=3 expandtab autoindent: */

lib/testutil-getgroups.c

@@ -0,0 +1,28 @@
+/*************************************************************************
+ *
+ * TESTUTIL-GETGROUPS.C, Superseded getgroups function for test purpose
+ * Copyright (C) 2020-2021 Xavier Delaruelle
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ ************************************************************************/
+
+#include <unistd.h>
+
+int getgroups(int size, gid_t list[])
+{
+    return -1;
+}
+
+/* vim:set tabstop=3 shiftwidth=3 expandtab autoindent: */

testsuite/example/siteconfig.tcl-1

@@ -149,11 +149,25 @@ if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETPWUID)]} {
     if {[catch {[initStateUsername]} errMsg]} {
         reportError $errMsg
     }
+}
+
+# test tcl ext lib procedures against a failed getgroups call
+if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETGROUPS)]} {
     if {[catch {[initStateUsergroups]} errMsg]} {
         reportError $errMsg
     }
 }
 
+# test tcl ext lib procedures against a zero result getgroups call
+if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIB0GETGROUPS)]} {
+    report [initStateUsergroups]
+}
+
+# test tcl ext lib procedures against a duplicate entries in result getgroups call
+if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBDUPGETGROUPS)]} {
+    report [initStateUsergroups]
+}
+
 # test tcl ext lib procedures against a failed getgrgid call
 if {[info exists env(TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETGRGID)]} {
     if {[catch {[initStateUsergroups]} errMsg]} {

testsuite/modules.00-init/005-init_ts.exp

@@ -150,6 +150,9 @@ if {$install_libtclenvmodules eq {y}} {
     set tclextlib_file lib/libtclenvmodules$install_shlib_suffix
     set closedirlib_file lib/libtestutil-closedir$install_shlib_suffix
     set getpwuidlib_file lib/libtestutil-getpwuid$install_shlib_suffix
+    set getgroupslib_file lib/libtestutil-getgroups$install_shlib_suffix
+    set 0getgroupslib_file lib/libtestutil-0getgroups$install_shlib_suffix
+    set dupgetgroupslib_file lib/libtestutil-dupgetgroups$install_shlib_suffix
     set getgrgidlib_file lib/libtestutil-getgrgid$install_shlib_suffix
     set timelib_file lib/libtestutil-time$install_shlib_suffix
     set mktimelib_file lib/libtestutil-mktime$install_shlib_suffix

testsuite/modules.00-init/120-siteconfig.exp

@@ -403,7 +403,6 @@ if {[info exists getpwuidlib_file] && [file exists $getpwuidlib_file]} {
     setenv_var LD_PRELOAD $getpwuidlib_file
     set ans [list]
     lappend ans "$error_msgs: couldn't find name for user id \"$userid\": .*"
-    lappend ans "$error_msgs: couldn't find name for user id \"$userid\": .*"
     lappend ans $vers_reportre
     testouterr_cmd_re sh -V OK [join $ans \n]
 
@@ -413,6 +412,51 @@ if {[info exists getpwuidlib_file] && [file exists $getpwuidlib_file]} {
     send_user "\tSkip tcl ext lib erroneous procedure calls as getpwuid test lib is not available\n"
 }
 
+# test tcl ext lib procedures against a failed getgroups call
+if {[info exists getgroupslib_file] && [file exists $getgroupslib_file]} {
+    setenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETGROUPS 1
+    setenv_var LD_PRELOAD $getgroupslib_file
+    set ans [list]
+    lappend ans "$error_msgs: couldn't get supplementary groups: .*"
+    lappend ans $vers_reportre
+    testouterr_cmd_re sh -V OK [join $ans \n]
+
+    unsetenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETGROUPS
+    unsetenv_var LD_PRELOAD
+} elseif {$verbose} {
+    send_user "\tSkip tcl ext lib erroneous procedure calls as getgroups test lib is not available\n"
+}
+
+# test tcl ext lib procedures against a zero result getgroups call
+if {[info exists 0getgroupslib_file] && [file exists $0getgroupslib_file]} {
+    setenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIB0GETGROUPS 1
+    setenv_var LD_PRELOAD $0getgroupslib_file
+    set ans [list]
+    lappend ans [exec id -g -n]
+    lappend ans $vers_reportre
+    testouterr_cmd_re sh -V OK [join $ans \n]
+
+    unsetenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIB0GETGROUPS
+    unsetenv_var LD_PRELOAD
+} elseif {$verbose} {
+    send_user "\tSkip tcl ext lib erroneous procedure calls as 0getgroups test lib is not available\n"
+}
+
+# test tcl ext lib procedures against a duplicate entries in result getgroups call
+if {[info exists dupgetgroupslib_file] && [file exists $dupgetgroupslib_file]} {
+    setenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBDUPGETGROUPS 1
+    setenv_var LD_PRELOAD $dupgetgroupslib_file
+    set ans [list]
+    lappend ans [exec id -g -n]
+    lappend ans $vers_reportre
+    testouterr_cmd_re sh -V OK [join $ans \n]
+
+    unsetenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBDUPGETGROUPS
+    unsetenv_var LD_PRELOAD
+} elseif {$verbose} {
+    send_user "\tSkip tcl ext lib erroneous procedure calls as dupgetgroups test lib is not available\n"
+}
+
 # test tcl ext lib procedures against a failed getgrgid call
 if {[info exists getgrgidlib_file] && [file exists $getgrgidlib_file]} {
     setenv_var TESTSUITE_ENABLE_SITECONFIG_TCLEXTLIBFAILEDGETGRGID 1