X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=32f7716df4fae9b2203f1ba739a27500b9fab4e6;hb=4d0b87793a047baecf2403455ddca1a82f44a41b;hp=ae5875f2a2743875f721cb274f884d983eb63fa9;hpb=800666c9dd66dd953c648b98fdcb340d68510175;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index ae5875f..32f7716 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -111,7 +111,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (define-alien-routine ("getenv" posix-getenv) c-string "Return the \"value\" part of the environment string \"name=value\" which corresponds to NAME, or NIL if there is none." - (name c-string)) + (name (c-string :not-null t))) ;;; from stdio.h @@ -120,7 +120,9 @@ corresponds to NAME, or NIL if there is none." #!-win32 (defun unix-rename (name1 name2) (declare (type unix-pathname name1 name2)) - (void-syscall ("rename" c-string c-string) name1 name2)) + (void-syscall ("rename" (c-string :not-null t) + (c-string :not-null t)) + name1 name2)) ;;; from sys/types.h and gnu/types.h @@ -446,11 +448,18 @@ corresponds to NAME, or NIL if there is none." ;;; Return the namestring of the home directory, being careful to ;;; include a trailing #\/ #!-win32 -(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))) +(progn + (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))) + + (defun user-homedir (uid) + (or (newcharstar-string (alien-funcall (extern-alien "user_homedir" + (function (* char) c-string)) + 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 @@ -871,6 +880,31 @@ corresponds to NAME, or NIL if there is none." (syscall ("fstat_wrapper" int (* (struct wrapped_stat))) (%extract-stat-results (addr buf)) fd (addr buf)))) + +#!-win32 +(defun fd-type (fd) + (declare (type unix-fd fd)) + (let ((fmt (logand + sb!unix:s-ifmt + (or (with-alien ((buf (struct wrapped_stat))) + (syscall ("fstat_wrapper" int (* (struct wrapped_stat))) + (slot buf 'st-mode) + fd (addr buf))) + 0)))) + (cond ((logtest sb!unix:s-ififo fmt) + :fifo) + ((logtest sb!unix:s-ifchr fmt) + :character) + ((logtest sb!unix:s-ifdir fmt) + :directory) + ((logtest sb!unix:s-ifblk fmt) + :block) + ((logtest sb!unix:s-ifreg fmt) + :regular) + ((logtest sb!unix:s-ifsock fmt) + :socket) + (t + :unknown)))) ;;;; time.h