Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl
Commits: 31ebd79e by Raymond Toy at 2023-12-06T13:29:10-08:00 More cleanups.
In `get-user-homedir-pathname` Don't append a "/" to the namestring.
Simplify `replace-tilde-user` by doing a quick exit when we can't find the trailing "/" for the user name.
- - - - - fa8607b1 by Raymond Toy at 2023-12-06T13:38:59-08:00 Rename to get-user-homedir-namestring.
We don't return a pathname anymore, so rename the function to indicate better that we're returning a namestring now.
- - - - -
3 changed files:
- src/code/exports.lisp - src/code/filesys.lisp - src/code/os.lisp
Changes:
===================================== src/code/exports.lisp ===================================== @@ -2074,7 +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" + "GET-USER-HOMEDIR-NAMESTRING" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" "LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
===================================== src/code/filesys.lisp ===================================== @@ -305,10 +305,9 @@ (cond ((zerop (length name)) (let ((user (unix:unix-getpwuid (unix:unix-getuid)))) (concatenate 'simple-base-string - (unix:user-info-dir user) - "/"))) + (unix:user-info-dir user)))) (t - (let ((path (system:get-user-homedir-pathname name))) + (let ((path (system:get-user-homedir-namestring name))) (unless path (error "Unknown user: ~S" name)) path)))) @@ -326,22 +325,24 @@ (let ((end-user (position #/ str :start start :end end))) #+nil (format t "user ~D:~D: ~A~%" (1+ start) end-user (subseq str (1+ start) end-user)) - (cond (end-user - (let* ((user-name (subseq str (1+ start) end-user)) - (homedir (user-homedir-namestring user-name))) - #+nil - (format t "user-name: ~S; homedir: ~S~%" - user-name homedir) - (values (concatenate 'simple-base-string - (subseq str 0 start) - homedir - (subseq str (1+ end-user))) - start - (+ end (- (length homedir) - (length user-name) - 2))))) - (t - (values str start end))))) + ;; Quick exit if we can't find a "/" to terminate the user name. + (unless end-user + (return-from replace-tilde-user + (values str start end))) + (let* ((user-name (subseq str (1+ start) end-user)) + (homedir (user-homedir-namestring user-name))) + #+nil + (format t "user-name: ~S; homedir: ~S~%" + user-name homedir) + ;; Replace the ~user part with the home directory, adjusting END because of the replacement. + (values (concatenate 'simple-base-string + (subseq str 0 start) + homedir + (subseq str end-user)) + start + (+ end (- (length homedir) + (length user-name) + 1))))))
(defun parse-unix-namestring (namestr start end) (declare (type simple-base-string namestr)
===================================== src/code/os.lisp ===================================== @@ -58,9 +58,9 @@ (unix:get-unix-error-msg utime))) (values utime stime major-fault))))
-;;; GET-USER-HOMEDIR-PATHNAME -- Public +;;; GET-USER-HOMEDIR-NAMESTRING -- Public ;;; -(defun get-user-homedir-pathname (name) +(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 @@ -80,9 +80,7 @@ (alien:addr status))) (if (and (zerop status) (not (alien:null-alien result))) - (values (concatenate 'string - (alien:cast result c-call:c-string) - "/") + (values (alien:cast result c-call:c-string) status) (values nil status))) (alien:free-alien result)))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/08222e493e4d0ec039b2196...