-;;; Return the current directory as a SIMPLE-STRING.
-(defun unix-current-directory ()
- ;; FIXME: Gcc justifiably complains that getwd is dangerous and should
- ;; not be used; especially with a hardwired 1024 buffer size, yecch.
- ;; This should be rewritten to use getcwd(3), perhaps by writing
- ;; a C service routine to do the actual call to getcwd(3) and check
- ;; of return values.
- (with-alien ((buf (array char 1024)))
- (values (not (zerop (alien-funcall (extern-alien "getwd"
- (function int (* char)))
- (cast buf (* char)))))
- (cast buf c-string))))
+;;; Given a C char* pointer allocated by malloc(), free it and return a
+;;; corresponding Lisp string (or return NIL if the pointer is a C NULL).
+(defun newcharstar-string (newcharstar)
+ (declare (type (alien (* char)) newcharstar))
+ (if (null-alien newcharstar)
+ nil
+ (prog1
+ (cast newcharstar c-string)
+ (free-alien newcharstar))))
+
+;;; Return the Unix current directory as a SIMPLE-STRING, in the
+;;; style returned by getcwd() (no trailing slash character).
+(defun posix-getcwd ()
+ ;; This implementation relies on a BSD/Linux extension to getcwd()
+ ;; behavior, automatically allocating memory when a null buffer
+ ;; pointer is used. On a system which doesn't support that
+ ;; extension, it'll have to be rewritten somehow.
+ ;;
+ ;; SunOS and OSF/1 provide almost as useful an extension: if given a null
+ ;; buffer pointer, it will automatically allocate size space. The
+ ;; KLUDGE in this solution arises because we have just read off
+ ;; PATH_MAX+1 from the Solaris header files and stuck it in here as
+ ;; a constant. Going the grovel_headers route doesn't seem to be
+ ;; helpful, either, as Solaris doesn't export PATH_MAX from
+ ;; unistd.h.
+ #!-(or linux openbsd freebsd sunos osf1) (,stub,)
+ #!+(or linux openbsd freebsd sunos osf1)
+ (or (newcharstar-string (alien-funcall (extern-alien "getcwd"
+ (function (* char)
+ (* char)
+ size-t))
+ nil
+ #!+(or linux openbsd freebsd) 0
+ #!+(or sunos osf1) 1025))
+ (simple-perror "getcwd")))
+
+;;; Return the Unix current directory as a SIMPLE-STRING terminated
+;;; by a slash character.
+(defun posix-getcwd/ ()
+ (concatenate 'string (posix-getcwd) "/"))
+
+;;; Convert at the UNIX level from a possibly relative filename to
+;;; an absolute filename.
+;;;
+;;; FIXME: Do we still need this even as we switch to
+;;; *DEFAULT-PATHNAME-DEFAULTS*? I think maybe we do, since it seems
+;;; to be valid for the user to set *DEFAULT-PATHNAME-DEFAULTS* to
+;;; have a NIL directory component, and then this'd be the only way to
+;;; interpret a relative directory specification. But I don't find the
+;;; ANSI pathname documentation to be a model of clarity. Maybe
+;;; someone who understands it better can take a look at this.. -- WHN
+(defun unix-maybe-prepend-current-directory (name)
+ (declare (simple-string name))
+ (if (and (> (length name) 0) (char= (schar name 0) #\/))
+ name
+ (concatenate 'simple-string (posix-getcwd/) name)))