Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl Commits: efc75c10 by Raymond Toy at 2023-11-30T06:38:57-08:00 Use new system:get-user-homedir-pathname Update `user-homedir-namestring` to use `system:get-user-homedir-pathname`. This also means removing `unix:unix-getpwnam-tmp` from filesys.lisp. - - - - - 3 changed files: - src/code/filesys.lisp - src/code/unix.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1085,12 +1085,16 @@ optionally keeping some of the most recent old versions." hash)))) (defun user-homedir-namestring (&optional username) + "Returns the namestring for the user's home directory. If Username is + not specified, then use the current user." (flet ((unix-user-homedir (username) - (let ((user-info (unix::unix-getpwnam-tmp username))) - (if user-info (unix:user-info-dir user-info)))) + (let ((user-homedir (system:get-user-homedir-pathname username))) + (when user-homedir + (namestring user-homedir)))) (unix-uid-homedir (uid) (let ((user-info (unix::unix-getpwuid uid))) - (if user-info (unix:user-info-dir user-info))))) + (when user-info + (unix:user-info-dir user-info))))) (if username (unix-user-homedir username) (let ((env-home (unix:unix-getenv "HOME"))) ===================================== src/code/unix.lisp ===================================== @@ -2644,37 +2644,6 @@ :shell (string (cast (slot result 'pw-shell) c-call:c-string))) (values nil returned))))) -#+linux -(defun unix-getpwnam-tmp (login) - "Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found." - (declare (type simple-string login)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd)) - (result (* (struct passwd)))) - (let ((returned - (alien-funcall - (extern-alien "getpwnam_r" - (function c-call:int - c-call:c-string - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int - (* (* (struct passwd))))) - login - (addr user-info) - (cast buf (* c-call:char)) - 1024 - (addr result)))) - (when (zerop returned) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - ;;; Getrusage is not provided in the C library on Solaris 2.4, and is ;;; rather slow on later versions so the "times" system call is ;;; provided. ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -10120,6 +10120,12 @@ msgid "" "optionally keeping some of the most recent old versions." msgstr "" +#: src/code/filesys.lisp +msgid "" +"Returns the namestring for the user's home directory. If Username is\n" +" not specified, then use the current user." +msgstr "" + #: src/code/filesys.lisp msgid "" "Returns the home directory of the logged in user as a pathname.\n" @@ -21329,6 +21335,10 @@ msgstr "" msgid "Implements FILE-POSITION for the stream for setting the position." msgstr "" +#: src/pcl/gray-streams.lisp +msgid "Implements FILE-LENGTH for the stream." +msgstr "" + #: src/pcl/gray-streams.lisp msgid "" "Used by READ-BYTE; returns either an integer, or the symbol :EOF\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f61... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f61... You're receiving this email because of your account on gitlab.common-lisp.net.