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
-
1cd91a3d
by Raymond Toy at 2023-12-07T14:12:21-08:00
3 changed files:
Changes:
| ... | ... | @@ -301,26 +301,20 @@ |
| 301 | 301 | (return (values (remove-backslashes namestr start index)
|
| 302 | 302 | (1+ index)))))))))
|
| 303 | 303 | |
| 304 | -(defun user-homedir-namestring (name)
|
|
| 305 | - (cond ((zerop (length name))
|
|
| 306 | - (unix:user-info-dir (unix:unix-getpwuid (unix:unix-getuid))))
|
|
| 307 | - (t
|
|
| 308 | - (system:get-user-homedir-namestring name))))
|
|
| 309 | - |
|
| 310 | -(defun replace-tilde-user (str start end)
|
|
| 304 | +(defun expand-tilde-user-name (str start end)
|
|
| 311 | 305 | ;; Quick exit if STR doesn't start with ~ or we have an empty string.
|
| 312 | 306 | (when (or (= start end)
|
| 313 | 307 | (char/= (schar str start) #\~))
|
| 314 | - (return-from replace-tilde-user
|
|
| 308 | + (return-from expand-tilde-user-name
|
|
| 315 | 309 | (values str start end)))
|
| 316 | 310 |
|
| 317 | 311 | (let ((end-user (position #\/ str :start start :end end)))
|
| 318 | 312 | ;; Quick exit if we can't find a "/" to terminate the user name.
|
| 319 | 313 | (unless end-user
|
| 320 | - (return-from replace-tilde-user
|
|
| 314 | + (return-from expand-tilde-user-name
|
|
| 321 | 315 | (values str start end)))
|
| 322 | 316 | (let* ((user-name (subseq str (1+ start) end-user))
|
| 323 | - (homedir (user-homedir-namestring user-name)))
|
|
| 317 | + (homedir (get-user-homedir-namestring user-name)))
|
|
| 324 | 318 | (unless homedir
|
| 325 | 319 | (error "Unknown user ~S in namestring ~S" user-name (subseq str start end)))
|
| 326 | 320 | ;; Replace the ~user part with the home directory, adjusting END
|
| ... | ... | @@ -340,7 +334,7 @@ |
| 340 | 334 | ;; Look for "~user/" (or "~/"). If found replace it with the user's
|
| 341 | 335 | ;; home directory
|
| 342 | 336 | (multiple-value-bind (namestr start end)
|
| 343 | - (replace-tilde-user namestr start end)
|
|
| 337 | + (expand-tilde-user-name namestr start end)
|
|
| 344 | 338 | (multiple-value-bind
|
| 345 | 339 | (absolute pieces)
|
| 346 | 340 | (split-at-slashes namestr start end)
|
| ... | ... | @@ -61,26 +61,36 @@ |
| 61 | 61 | ;;; GET-USER-HOMEDIR-NAMESTRING -- Public
|
| 62 | 62 | ;;;
|
| 63 | 63 | (defun get-user-homedir-namestring (name)
|
| 64 | - _N"Get the user home directory for user named NAME. Two values are
|
|
| 65 | - returned: the pathname of the home directory and a status code. If
|
|
| 66 | - the home directory does not exist NIL is returned. The status is 0
|
|
| 67 | - if no errors occurred. Otherwise a non-zero value is returned.
|
|
| 68 | - Examining errno may give information about what failed."
|
|
| 69 | - (alien:with-alien ((status c-call:int))
|
|
| 70 | - (let (result)
|
|
| 71 | - (unwind-protect
|
|
| 72 | - (progn
|
|
| 73 | - (setf result
|
|
| 74 | - (alien:alien-funcall
|
|
| 75 | - (alien:extern-alien "os_get_user_homedir"
|
|
| 76 | - (function (alien:* c-call:c-string)
|
|
| 77 | - c-call:c-string
|
|
| 78 | - (* c-call:int)))
|
|
| 79 | - name
|
|
| 80 | - (alien:addr status)))
|
|
| 81 | - (if (and (zerop status)
|
|
| 82 | - (not (alien:null-alien result)))
|
|
| 83 | - (values (alien:cast result c-call:c-string)
|
|
| 84 | - status)
|
|
| 85 | - (values nil status)))
|
|
| 86 | - (alien:free-alien result))))) |
|
| 64 | + _N"Get the user home directory for user named NAME. If NAME is the empty
|
|
| 65 | + string, the home directory of the current user is returned.
|
|
| 66 | + |
|
| 67 | + Two values are returned: the pathname of the home directory and a
|
|
| 68 | + status code. If the home directory does not exist NIL is returned.
|
|
| 69 | + The status is 0 if no errors occurred. Otherwise a non-zero value
|
|
| 70 | + is returned. Examining errno may give information about what failed."
|
|
| 71 | + (cond
|
|
| 72 | + ((zerop (length name))
|
|
| 73 | + (multiple-value-bind (user-info status)
|
|
| 74 | + (unix:unix-getpwuid (unix:unix-getuid))
|
|
| 75 | + (values (when user-info
|
|
| 76 | + (unix:user-info-dir user-info))
|
|
| 77 | + status)))
|
|
| 78 | + (t
|
|
| 79 | + (alien:with-alien ((status c-call:int))
|
|
| 80 | + (let (result)
|
|
| 81 | + (unwind-protect
|
|
| 82 | + (progn
|
|
| 83 | + (setf result
|
|
| 84 | + (alien:alien-funcall
|
|
| 85 | + (alien:extern-alien "os_get_user_homedir"
|
|
| 86 | + (function (alien:* c-call:c-string)
|
|
| 87 | + c-call:c-string
|
|
| 88 | + (* c-call:int)))
|
|
| 89 | + name
|
|
| 90 | + (alien:addr status)))
|
|
| 91 | + (if (and (zerop status)
|
|
| 92 | + (not (alien:null-alien result)))
|
|
| 93 | + (values (alien:cast result c-call:c-string)
|
|
| 94 | + status)
|
|
| 95 | + (values nil status)))
|
|
| 96 | + (alien:free-alien result))))))) |
| ... | ... | @@ -35,10 +35,12 @@ msgstr "" |
| 35 | 35 | |
| 36 | 36 | #: src/code/os.lisp
|
| 37 | 37 | msgid ""
|
| 38 | -"Get the user home directory for user named NAME. Two values are\n"
|
|
| 39 | -" returned: the pathname of the home directory and a status code. If\n"
|
|
| 40 | -" the home directory does not exist NIL is returned. The status is 0\n"
|
|
| 41 | -" if no errors occurred. Otherwise a non-zero value is returned.\n"
|
|
| 42 | -" Examining errno may give information about what failed."
|
|
| 38 | +"Get the user home directory for user named NAME. If NAME is the empty\n"
|
|
| 39 | +" string, the home directory of the current user is returned.\n"
|
|
| 40 | +"\n"
|
|
| 41 | +" Two values are returned: the pathname of the home directory and a\n"
|
|
| 42 | +" status code. If the home directory does not exist NIL is returned.\n"
|
|
| 43 | +" The status is 0 if no errors occurred. Otherwise a non-zero value\n"
|
|
| 44 | +" is returned. Examining errno may give information about what failed."
|
|
| 43 | 45 | msgstr ""
|
| 44 | 46 |