Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl
Commits: bed9958f by Raymond Toy at 2023-11-29T07:54:12-08:00 Move get-user-homedir-pathname to SYSTEM package in os.lisp
Update exports.lisp, filesys.lisp, and os.lisp appropriately.
Move the unit tests from tests/filesys.lisp to tests/os.lisp.
- - - - - 2b3512cd by Raymond Toy at 2023-11-29T07:56:17-08:00 Remove some trailing blanks
- - - - - 03965083 by Raymond Toy at 2023-11-29T07:56:38-08:00 Update pot files due to the refactoring.
- - - - -
7 changed files:
- src/code/exports.lisp - src/code/filesys.lisp - src/code/os.lisp - src/i18n/locale/cmucl-os.pot - src/i18n/locale/cmucl.pot - tests/filesys.lisp - + tests/os.lisp
Changes:
===================================== src/code/exports.lisp ===================================== @@ -1712,9 +1712,7 @@ "DESCRIBE-EXTERNAL-FORMAT" "LIST-ALL-EXTERNAL-FORMATS" "STRING-ENCODE" "STRING-DECODE" - "SET-SYSTEM-EXTERNAL-FORMAT") - ;; File sys items - (:export "GET-USER-HOMEDIR-PATHNAME")) + "SET-SYSTEM-EXTERNAL-FORMAT"))
(defpackage "STREAM" (:import-from "SYSTEM" "LISP-STREAM") @@ -2073,6 +2071,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/filesys.lisp ===================================== @@ -1484,28 +1484,3 @@ 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/os.lisp ===================================== @@ -57,3 +57,28 @@ (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 + (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/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/i18n/locale/cmucl.pot ===================================== @@ -10207,15 +10207,6 @@ 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 ""
===================================== tests/filesys.lisp ===================================== @@ -54,37 +54,3 @@ (assert-equal "/tmp/foo/bar/symlink" (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 ===================================== @@ -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/3ce881eb5e8a45e617953fe...