Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl
Commits: 2f767eed by Raymond Toy at 2023-11-27T11:04:00-08:00 Remove debugging script lines from CI
- - - - - 3d955819 by Raymond Toy at 2023-11-27T11:04:59-08:00 Slightly rewrite os_get_user_homedir and fix some bugs
* Don't set errno * We didn't free buf when returning in some cases
- - - - - c6a9f865 by Raymond Toy at 2023-11-27T11:06:34-08:00 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.
- - - - - 637a5d78 by Raymond Toy at 2023-11-27T11:08:51-08:00 Remove unneeded file
The tests for get-user-homedir-pathname have been moved to tests/filesys.lisp.
- - - - - d7a3d533 by Raymond Toy at 2023-11-27T11:09:46-08:00 Update pot files because the function has moved.
- - - - -
9 changed files:
- .gitlab-ci.yml - src/code/exports.lisp - src/code/filesys.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/os-common.c - tests/filesys.lisp - − tests/os.lisp
Changes:
===================================== .gitlab-ci.yml ===================================== @@ -62,7 +62,6 @@ linux:test: - job: linux:build artifacts: true script: - - printenv - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log
linux:ansi-test: @@ -147,7 +146,6 @@ osx: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:
===================================== src/code/exports.lisp ===================================== @@ -227,7 +227,6 @@ "UNIX-MKDIR" "UNIX-RMDIR" "UNIX-UNLINK" - "UNIX-GET-USER-HOMEDIR" "TIMEZONE" "TIMEVAL" "SIZE-T" @@ -1713,7 +1712,9 @@ "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")
===================================== src/code/filesys.lisp ===================================== @@ -27,7 +27,8 @@
(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")
@@ -1483,3 +1484,28 @@ optionally keeping some of the most recent old versions." (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)))))
===================================== src/code/unix.lisp ===================================== @@ -2900,27 +2900,3 @@ (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))))) -
===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1432,12 +1432,3 @@ msgstr "" 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 "" -
===================================== src/i18n/locale/cmucl.pot ===================================== @@ -10207,6 +10207,15 @@ 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 ""
===================================== src/lisp/os-common.c ===================================== @@ -864,17 +864,24 @@ os_software_version(void) 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; @@ -886,8 +893,7 @@ os_get_user_homedir(const char* name, int *status) * upper limit and give up. */ while (buflen <= (1 << 20)) { - errno = 0; - buf = malloc(buflen); + buf = realloc(buf, buflen);
if (buf == NULL) { *status = -1; @@ -898,23 +904,24 @@ os_get_user_homedir(const char* name, int *status)
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; } } @@ -922,6 +929,7 @@ os_get_user_homedir(const char* name, int *status) /* * Ran out of space. Just return NULL and set status to -1. */ + free(buf); *status = -1; return NULL; }
===================================== tests/filesys.lisp ===================================== @@ -55,6 +55,36 @@ (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)))
===================================== tests/os.lisp deleted ===================================== @@ -1,37 +0,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)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b26975f6a41a59d036cf7c9...