GitLab

at 2023-11-27T11:04:00-08:00

Remove debugging script lines from CI

Slightly rewrite os_get_user_homedir and fix some bugs

* Don't set errno
* We didn't free buf when returning in some cases

Move function to filesys and rename it

As hinted by @cshapiro, move the function for the UNIX package.  Let's
put it in filesys.lisp where `user-homedir-pathname` is defined, and
name it `get-user-homedir-pathname`.  This is exported from the EXT
package.

Update tests appropriately for the new name and package.

Remove unneeded file

The tests for get-user-homedir-pathname have been moved to
tests/filesys.lisp.

Update pot files because the function has moved.

     - job: linux:build

       artifacts: true

   script:

-    - printenv

     - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log

 linux:ansi-test:

       artifacts: true

   script:

     - echo LANG = $LANG

-    - printenv

     - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log

 osx:ansi-test:

 	   "UNIX-MKDIR"

 	   "UNIX-RMDIR"

 	   "UNIX-UNLINK"

-           "UNIX-GET-USER-HOMEDIR"

 	   "TIMEZONE"

 	   "TIMEVAL"

 	   "SIZE-T"

 	   "DESCRIBE-EXTERNAL-FORMAT"

 	   "LIST-ALL-EXTERNAL-FORMATS"

 	   "STRING-ENCODE" "STRING-DECODE"

-	   "SET-SYSTEM-EXTERNAL-FORMAT"))

+	   "SET-SYSTEM-EXTERNAL-FORMAT")

+  ;; File sys items

+  (:export "GET-USER-HOMEDIR-PATHNAME"))

 (defpackage "STREAM"

   (:import-from "SYSTEM" "LISP-STREAM")

 (in-package "EXTENSIONS")

 (export '(print-directory complete-file ambiguous-files default-directory

-	  purge-backup-files file-writable unix-namestring))

+	  purge-backup-files file-writable unix-namestring

+          get-user-homedir-pathname))

 (in-package "LISP")

 				(go retry))))))

 	 ;; Only the first path in a search-list is considered.

 	 (return (values pathspec created-p))))))

+

+;;; GET-USER-HOMEDIR-PATHNAME  -- Public

+;;;

+(defun get-user-homedir-pathname (name)

+  _N"Get the user home directory for user named NAME.  Two values are

+  returned: the pathname of the home directory and a status code.  If

+  the home directory does not exist NIL is returned.  The status is 0

+  if no errors occurred.  Otherwise a non-zero value is returned.

+  Examining errno may give information about what failed."

+  (alien:with-alien ((status c-call:int))

+    (let ((result

+            (alien:alien-funcall

+             (alien:extern-alien "os_get_user_homedir"

+                                 (function c-call:c-string

+                                           c-call:c-string

+                                           (* c-call:int)))

+             name

+             (alien:addr status))))

+      (if (and (zerop status) result)

+          (values (pathname

+                   (concatenate 'string

+                                result

+                                "/"))

+                  status)

+          (values result status)))))
 	    (extern-alien "os_get_locale_codeset"

 			  (function (* char))))

 	c-string))
-

-(defun unix-get-user-homedir (name)

-  _N"Get the user home directory for user named NAME.  Two values are

-  returned: the pathname of the home directory and a status code.  If

-  the home directory does not exist NIL is returned.  The status is 0

-  if no errors occurred.  Otherwise a non-zero value is returned.

-  Examining errno may give information about what failed."

-  (with-alien ((status c-call:int))

-    (let ((result

-            (alien-funcall

-             (extern-alien "os_get_user_homedir"

-                           (function c-call:c-string

-                                     c-call:c-string

-                                     (* c-call:int)))

-             name

-             (addr status))))

-      (if (and (zerop status) result)

-          (values (pathname

-                   (concatenate 'string

-                                result

-                                "/"))

-                  status)

-          (values result status)))))

-  
 msgid "Get the codeset from the locale"

 msgstr ""

-#: src/code/unix.lisp

-msgid ""

-"Get the user home directory for user named NAME.  Two values are\n"

-"  returned: the pathname of the home directory and a status code.  If\n"

-"  the home directory does not exist NIL is returned.  The status is 0\n"

-"  if no errors occurred.  Otherwise a non-zero value is returned.\n"

-"  Examining errno may give information about what failed."

-msgstr ""

-
 msgid "Can't create directory ~A."

 msgstr ""

+#: src/code/filesys.lisp

+msgid ""

+"Get the user home directory for user named NAME.  Two values are\n"

+"  returned: the pathname of the home directory and a status code.  If\n"

+"  the home directory does not exist NIL is returned.  The status is 0\n"

+"  if no errors occurred.  Otherwise a non-zero value is returned.\n"

+"  Examining errno may give information about what failed."

+msgstr ""

+

 #: src/code/load.lisp

 msgid "The default for the :IF-SOURCE-NEWER argument to load."

 msgstr ""

     return result;

 }

+/*

+ * Return the home directory of the user named NAME.  If the user does

+ * not exist, returns NULL.  Also returns NULL if the home directory

+ * cannot be determined for any reason.  The parameter STATUS is 0 if

+ * getpwnam_r was successful.  Otherwise it is the return value from

+ * getpwnam_r or -1 if we ran out of memory for the buffer.

+ */

 char *

 os_get_user_homedir(const char* name, int *status)

 {

     int buflen;

-    char * buf;

+    char *buf = NULL;

     struct passwd pwd;

     struct passwd *result;

     buflen = sysconf(_SC_GETPW_R_SIZE_MAX);

     /*

-     * If sysconf failed, just try some possibly large enough value

+     * If sysconf failed, just try some possibly large enough value.

      */

     if (buflen == -1) {

         buflen = 1024;

      * upper limit and give up.

      */

     while (buflen <= (1 << 20)) {

-        errno = 0;

-        buf = malloc(buflen);

+        buf = realloc(buf, buflen);

         if (buf == NULL) {

             *status = -1;

         if (*status == 0) {

             /*

-             * Success, or entry was not found.  If found the result

+             * Success, or entry was not found.  If found, the result

              * is not NULL.  Return the result or NULL

              */

-            fprintf(stderr, "dir = %s\n", pwd.pw_dir);

-            return result ? strdup(pwd.pw_dir) : NULL;

+            char* path = result ? strdup(pwd.pw_dir) : NULL;

+            free(buf);

+            return path;

         }

         /*

          * Check errno for ERANGE.  If so, the buffer was too small, so grow it.

          */

         if (errno == ERANGE) {

-            free(buf);

             buflen *= 2;

         } else {

             /*

              * Some other error.  Just return NULL

              */

+            free(buf);

             return NULL;

         }

     }

     /*

      * Ran out of space.  Just return NULL and set status to -1.

      */

+    free(buf);

     *status = -1;

     return NULL;

 }

 		       (ext:unix-namestring "/tmp/foo/bar/symlink" nil)))

     (unix:unix-unlink "/tmp/foo/bar/symlink")))

-	 

-    

+(define-test user-homedir.1

+  "Test user-homedir"

+  (:tag :issues)

+  ;; Simple test to see if get-user-homedir-pathname returns the

+  ;; expected value.  Use getuid and getpwuid to figure out what the

+  ;; name and home directory should be.

+  (let* ((uid (unix:unix-getuid))

+         (user-info (unix:unix-getpwuid uid)))

+    (assert-true uid)

+    (assert-true user-info)

+    (let* ((info-dir (unix:user-info-dir user-info))

+           (info-name (unix:user-info-name user-info))

+           (expected-home-pathname (pathname

+                                    (concatenate 'string info-dir "/"))))

+      (multiple-value-bind (home-pathname status)

+          (ext:get-user-homedir-pathname info-name)

+        (assert-true info-dir)

+        (assert-true info-name)

+

+        (assert-equal home-pathname expected-home-pathname)

+        (assert-eql status 0)))))

+

+(define-test user-homedir.2

+  "Test user-homedir"

+  (:tag :issues)

+  ;; Simple test to see if get-user-homedir-pathname returns the expected

+  ;; value for a user that does not exist.  Well, we assume such a

+  ;; user doesn't exist.

+      (multiple-value-bind (home-pathname status)

+          (ext:get-user-homedir-pathname "zotuserunknown")

+        (assert-eql home-pathname nil)

+        (assert-eql status 0)))    

-(defpackage :os-tests

-  (:use :cl :lisp-unit))

-

-(in-package "OS-TESTS")

-

-(define-test user-homedir.1

-  "Test user-homedir"

-  (:tag :issues)

-  ;; Simple test to see if unix-get-user-homedir returns the expected

-  ;; value.  Use getuid and getpwuid to figure out what the name and

-  ;; home directory should be.

-  (let* ((uid (unix:unix-getuid))

-         (user-info (unix:unix-getpwuid uid)))

-    (assert-true uid)

-    (assert-true user-info)

-    (let* ((info-dir (unix:user-info-dir user-info))

-           (info-name (unix:user-info-name user-info))

-           (expected-home-pathname (pathname

-                                    (concatenate 'string info-dir "/"))))

-      (multiple-value-bind (home-pathname status)

-          (unix:unix-get-user-homedir info-name)

-        (assert-true info-dir)

-        (assert-true info-name)

-

-        (assert-equal home-pathname expected-home-pathname)

-        (assert-eql status 0)))))

-

-(define-test user-homedir.2

-  "Test user-homedir"

-  (:tag :issues)

-  ;; Simple test to see if unix-get-user-homedir returns the expected

-  ;; value for a user that does not exist.  Well, we assume such a

-  ;; user doesn't exist.

-      (multiple-value-bind (home-pathname status)

-          (unix:unix-get-user-homedir "zotuserunknown")

-        (assert-eql home-pathname nil)

-        (assert-eql status 0)))

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl

Commits:

9 changed files:

Changes: