0.7.4.17: Mostly Alpha fixes

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index fbae021..b1193bf 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -264,6 +264,16 @@
           (type unix-file-mode mode))
   (void-syscall ("mkdir" c-string int) name mode))
 
+;;; 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 ()
@@ -271,16 +281,24 @@
   ;; 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.
-  #!-(or linux openbsd freebsd) (,stub,)
-  (let* ((raw-char-ptr (alien-funcall (extern-alien "getcwd"
-                                                   (function (* char)
-                                                             (* char) size-t))
-                                     nil 0)))
-    (if (null-alien raw-char-ptr)
-       (simple-perror "getcwd")
-       (prog1
-           (cast raw-char-ptr c-string)
-         (free-alien raw-char-ptr)))))
+  ;;
+  ;; 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.
@@ -320,9 +338,24 @@
 ;;; Return the process id of the current process.
 (define-alien-routine ("getpid" unix-getpid) int)
 
-;;; Return the real user-id associated with the current process.
+;;; Return the real user id associated with the current process.
 (define-alien-routine ("getuid" unix-getuid) int)
 
+;;; Translate a user id into a login name.
+(defun uid-username (uid)
+  (or (newcharstar-string (alien-funcall (extern-alien "uid_username"
+                                                      (function (* char) int))
+                                        uid))
+      (error "found no match for Unix uid=~S" uid)))
+
+;;; Return the namestring of the home directory, being careful to
+;;; include a trailing #\/
+(defun uid-homedir (uid)
+  (or (newcharstar-string (alien-funcall (extern-alien "uid_homedir"
+                                                      (function (* char) int))
+                                        uid))
+      (error "failed to resolve home directory for Unix uid=~S" uid)))
+
 ;;; Invoke readlink(2) on the file name specified by PATH. Return
 ;;; (VALUES LINKSTRING NIL) on success, or (VALUES NIL ERRNO) on
 ;;; failure.
@@ -372,8 +405,9 @@
 
 ;;; FIXME: All we seem to need is the RUSAGE_SELF version of this.
 ;;;
-;;; Like getrusage(2), but return only the system and user time,
-;;; and return the seconds and microseconds as separate values.
+;;; This is like getrusage(2), except it returns only the system and
+;;; user time, and returns the seconds and microseconds as separate
+;;; values.
 #!-sb-fluid (declaim (inline unix-fast-getrusage))
 (defun unix-fast-getrusage (who)
   (declare (values (member t)
@@ -607,9 +641,9 @@
            (tm-gmtoff long) ;  Seconds east of UTC.
            (tm-zone c-string))) ; Timezone abbreviation.
 
-(define-alien-routine get-timezone sb!c-call:void
-  (when sb!c-call:long :in)
-  (minutes-west sb!c-call:int :out)
+(define-alien-routine get-timezone sb!alien:void
+  (when sb!alien:long :in)
+  (minutes-west sb!alien:int :out)
   (daylight-savings-p sb!alien:boolean :out))
 
 (defun unix-get-minutes-west (secs)
@@ -821,6 +855,17 @@
          (t
           (subseq dst 0 dst-len)))))
 \f
+;;;; A magic constant for wait3().
+;;;;
+;;;; FIXME: This used to be defined in run-program.lisp as
+;;;; (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced)
+;;;; According to some of the man pages, the #o177 is part of the API
+;;;; for wait3(); that said, under SunOS there is a WSTOPPED thing in
+;;;; the headers that may or may not be the same thing. To be
+;;;; investigated. -- CSR, 2002-03-25
+(defconstant wstopped #o177)
+
+\f
 ;;;; stuff not yet found in the header files
 ;;;;
 ;;;; Abandon all hope who enters here...