Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl

Commits: 9817f1e9 by Raymond Toy at 2023-12-07T14:11:13-08:00 Address review comments.

Rename `replace-tilde-user` to `expand-tilde-user-name`

Update `system:get-user-homedir-namestring` to handle a user name of "" which means the current user.

- - - - - 1cd91a3d by Raymond Toy at 2023-12-07T14:12:21-08:00 Update pot file for changed comment

- - - - -

3 changed files:

- src/code/filesys.lisp - src/code/os.lisp - src/i18n/locale/cmucl-os.pot

Changes:

===================================== src/code/filesys.lisp ===================================== @@ -301,26 +301,20 @@ (return (values (remove-backslashes namestr start index) (1+ index)))))))))

-(defun user-homedir-namestring (name) - (cond ((zerop (length name)) - (unix:user-info-dir (unix:unix-getpwuid (unix:unix-getuid)))) - (t - (system:get-user-homedir-namestring name)))) - -(defun replace-tilde-user (str start end) +(defun expand-tilde-user-name (str start end) ;; Quick exit if STR doesn't start with ~ or we have an empty string. (when (or (= start end) (char/= (schar str start) #~)) - (return-from replace-tilde-user + (return-from expand-tilde-user-name (values str start end)))

(let ((end-user (position #/ str :start start :end end))) ;; Quick exit if we can't find a "/" to terminate the user name. (unless end-user - (return-from replace-tilde-user + (return-from expand-tilde-user-name (values str start end))) (let* ((user-name (subseq str (1+ start) end-user)) - (homedir (user-homedir-namestring user-name))) + (homedir (get-user-homedir-namestring user-name))) (unless homedir (error "Unknown user ~S in namestring ~S" user-name (subseq str start end))) ;; Replace the ~user part with the home directory, adjusting END @@ -340,7 +334,7 @@ ;; Look for "~user/" (or "~/"). If found replace it with the user's ;; home directory (multiple-value-bind (namestr start end) - (replace-tilde-user namestr start end) + (expand-tilde-user-name namestr start end) (multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)

===================================== src/code/os.lisp ===================================== @@ -61,26 +61,36 @@ ;;; GET-USER-HOMEDIR-NAMESTRING -- Public ;;; (defun get-user-homedir-namestring (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 (alien:cast result c-call:c-string) - status) - (values nil status))) - (alien:free-alien result))))) + _N"Get the user home directory for user named NAME. If NAME is the empty + string, the home directory of the current user is returned. + + 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." + (cond + ((zerop (length name)) + (multiple-value-bind (user-info status) + (unix:unix-getpwuid (unix:unix-getuid)) + (values (when user-info + (unix:user-info-dir user-info)) + status))) + (t + (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 (alien:cast result c-call:c-string) + status) + (values nil status))) + (alien:free-alien result)))))))

===================================== src/i18n/locale/cmucl-os.pot ===================================== @@ -35,10 +35,12 @@ 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." +"Get the user home directory for user named NAME. If NAME is the empty\n" +" string, the home directory of the current user is returned.\n" +"\n" +" Two values are returned: the pathname of the home directory and a\n" +" status code. If the home directory does not exist NIL is returned.\n" +" The status is 0 if no errors occurred. Otherwise a non-zero value\n" +" is returned. Examining errno may give information about what failed." msgstr ""

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/59d589645f9fbdc81dd4623...