From: Juho Snellman Date: Mon, 12 Feb 2007 03:43:11 +0000 (+0000) Subject: 1.0.2.24: Support readlink in SB-POSIX X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7c705bd988cfec5de87572abba9da3c16601388d;p=sbcl.git 1.0.2.24: Support readlink in SB-POSIX * Thanks to Richard M Kreuter --- diff --git a/NEWS b/NEWS index 34146fb..35526eb 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,8 @@ changes in sbcl-1.0.3 relative to sbcl-1.0.2: * bug fix: use "gtar" as the asdf-install *TAR-PROGRAM* on NetBSD (thanks to Jon Buller) * improvement: faster compilation times for complex functions + * improvement: added readlink support to SB-POSIX (thanks to Richard + M Kreuter) changes in sbcl-1.0.2 relative to sbcl-1.0.1: * improvement: experimental support for mach exception handling on diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 779759a..517f71f 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -246,7 +246,30 @@ (define-call "setpgid" int minusp (pid pid-t) (pgid pid-t)) (define-call "setpgrp" int minusp)) -;;(define-call "readlink" int minusp (path filename) (buf (* t)) (len int)) +#-win32 +(progn + (export 'readlink :sb-posix) + (defun readlink (pathspec) + (flet ((%readlink (path buf length) + (alien-funcall + (extern-alien "readlink" (function int c-string (* t) int)) + path buf length))) + (loop for size = 128 then (* 2 size) + for buf = (make-alien c-string size) + do (unwind-protect + (let ((count (%readlink (filename pathspec) buf size))) + (cond ((minusp count) + (syscall-error)) + ((< 0 count size) + (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap buf) + count) + 0) + (return + (sb-alien::c-string-to-string + (sb-alien:alien-sap buf) + (sb-impl::default-external-format) + 'character))))) + (free-alien buf)))))) #-win32 (progn @@ -581,4 +604,3 @@ than C's printf) with format string FORMAT and arguments ARGS." priority "%s" message))) (syslog1 priority (apply #'format nil format args)))) (define-call "closelog" void never-fails)) - diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 78b4754..9de504b 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -521,6 +521,122 @@ (list (= (sb-posix:stat-atime stat) atime) (= (sb-posix:stat-mtime stat) mtime)))) (t t)) - - - + +;; readlink tests. +#-win32 +(progn + (deftest readlink.1 + (let ((link-pathname (make-pathname :name "readlink.1" + :defaults *test-directory*))) + (sb-posix:symlink "/" link-pathname) + (unwind-protect + (sb-posix:readlink link-pathname) + (ignore-errors (sb-posix:unlink link-pathname)))) + "/") + + ;; Same thing, but with a very long link target (which doesn't have + ;; to exist). This tests the array adjustment in the wrapper, + ;; provided that the target's length is long enough. + (deftest readlink.2 + (let ((target-pathname (make-pathname + :name (make-string 255 :initial-element #\a) + :directory '(:absolute))) + (link-pathname (make-pathname :name "readlink.2" + :defaults *test-directory*))) + (sb-posix:symlink target-pathname link-pathname) + (unwind-protect + (sb-posix:readlink link-pathname) + (ignore-errors (sb-posix:unlink link-pathname)))) + #.(concatenate 'string "/" (make-string 255 :initial-element #\a))) + + ;; The error tests are in the order of exposition from SUSv3. + (deftest readlink.error.1 + (let* ((subdir-pathname (merge-pathnames + (make-pathname + :directory '(:relative "readlink.error.1")) + *test-directory*)) + (link-pathname (make-pathname :name "readlink.error.1" + :defaults subdir-pathname))) + (sb-posix:mkdir subdir-pathname #o777) + (sb-posix:symlink "/" link-pathname) + (sb-posix:chmod subdir-pathname 0) + (unwind-protect + (handler-case (sb-posix:readlink link-pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + (ignore-errors + (sb-posix:chmod subdir-pathname #o777) + (sb-posix:unlink link-pathname) + (sb-posix:rmdir subdir-pathname)))) + #.sb-posix:eacces) + (deftest readlink.error.2 + (let* ((non-link-pathname (make-pathname :name "readlink.error.2" + :defaults *test-directory*)) + (fd (sb-posix:open non-link-pathname sb-posix::o-creat))) + (unwind-protect + (handler-case (sb-posix:readlink non-link-pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + (ignore-errors + (sb-posix:close fd) + (sb-posix:unlink non-link-pathname)))) + #.sb-posix:einval) + ;; Skipping EIO, ELOOP + (deftest readlink.error.3 + (let* ((link-pathname (make-pathname :name "readlink.error.3" + :defaults *test-directory*)) + (bogus-pathname (merge-pathnames + (make-pathname + :name "bogus" + :directory '(:relative "readlink.error.3")) + *test-directory*))) + (sb-posix:symlink link-pathname link-pathname) + (unwind-protect + (handler-case (sb-posix:readlink bogus-pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + (ignore-errors (sb-posix:unlink link-pathname)))) + #.sb-posix:eloop) + ;; Note: PATH_MAX and NAME_MAX need not be defined, and may vary, so + ;; failure of this test is not too meaningful. + (deftest readlink.error.4 + (let ((pathname + (make-pathname :name (make-string 257 ;NAME_MAX plus some, maybe + :initial-element #\a)))) + (handler-case (sb-posix:readlink pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c)))) + #.sb-posix:enametoolong) + (deftest readlink.error.5 + (let ((string (format nil "~v{/A~}" 2049 ;PATH_MAX/2 plus some, maybe + '(x)))) + (handler-case (sb-posix:readlink string) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c)))) + #.sb-posix:enametoolong) + (deftest readlink.error.6 + (let ((no-such-pathname (make-pathname :name "readlink.error.6" + :defaults *test-directory*))) + (handler-case (sb-posix:readlink no-such-pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c)))) + #.sb-posix:enoent) + (deftest readlink.error.7 + (let* ((non-link-pathname (make-pathname :name "readlink.error.7" + :defaults *test-directory*)) + (impossible-pathname (merge-pathnames + (make-pathname + :directory + '(:relative "readlink.error.7") + :name "readlink.error.7") + *test-directory*)) + (fd (sb-posix:open non-link-pathname sb-posix::o-creat))) + (unwind-protect + (handler-case (sb-posix:readlink impossible-pathname) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + (ignore-errors + (sb-posix:close fd) + (sb-posix:unlink non-link-pathname)))) + #.sb-posix:enotdir) + ) diff --git a/version.lisp-expr b/version.lisp-expr index e515900..0331e9f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.2.23" +"1.0.2.24"