Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl
Commits: a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00 Fix #269: Add function to get user's home directory
- - - - - 8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00 Merge branch 'issue-269-unix-get-user-homedir' into 'master'
Fix #269: Add function to get user's home directory
Closes #269
See merge request cmucl/cmucl!178 - - - - - 8fe17e76 by Raymond Toy at 2023-11-30T05:48:49-08:00 Merge branch 'master' into issue-266-tilde-pathname-support
- - - - -
6 changed files:
- src/code/exports.lisp - src/code/os.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-os.pot - src/lisp/os-common.c - + tests/os.lisp
Changes:
===================================== src/code/exports.lisp ===================================== @@ -2074,6 +2074,7 @@ "FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" + "GET-USER-HOMEDIR-PATHNAME" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
===================================== src/code/os.lisp ===================================== @@ -57,3 +57,33 @@ (error (intl:gettext "Unix system call getrusage failed: ~A.") (unix:get-unix-error-msg utime))) (values utime stime major-fault)))) + +;;; 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) + (unwind-protect + (progn + (setf result + (alien:alien-funcall + (alien:extern-alien "os_get_user_homedir" + (function (alien:* c-call:c-string) + c-call:c-string + (* c-call:int))) + name + (alien:addr status))) + (if (and (zerop status) + (not (alien:null-alien result))) + (values (pathname + (concatenate 'string + (alien:cast result c-call:c-string) + "/")) + status) + (values nil status))) + (alien:free-alien result)))))
===================================== src/general-info/release-21f.md ===================================== @@ -38,6 +38,7 @@ public domain. * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86 * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp + * ~~#269~~ Add function to get user's home directory * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure:
===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -33,3 +33,12 @@ msgstr "" msgid "Unix system call getrusage failed: ~A." msgstr ""
+#: src/code/os.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/lisp/os-common.c ===================================== @@ -863,3 +863,74 @@ 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 = 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 (buflen == -1) { + buflen = 1024; + } + + /* + * sysconf may return a value that is not large enough, so start + * with the given value and keep increasing it until we reach some + * upper limit and give up. + */ + while (buflen <= (1 << 20)) { + buf = realloc(buf, buflen); + + if (buf == NULL) { + *status = -1; + return NULL; + } + + *status = getpwnam_r(name, &pwd, buf, buflen, &result); + + if (*status == 0) { + /* + * Success, or entry was not found. If found, the result + * is not NULL. Return the result or 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) { + 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; +} +
===================================== tests/os.lisp ===================================== @@ -0,0 +1,38 @@ +(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 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) + (system: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) + (system:get-user-homedir-pathname "zotuserunknown") + (assert-eql home-pathname nil) + (assert-eql status 0)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9536863458f79ca9d128107...