From 30247dc414fb38329f580b1d41abbe202285adbe Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 16 Nov 2021 11:06:25 +0000 Subject: =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98readlink=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: Detect whether ‘readlinkat’ is defined. * libguile/filesys.c (scm_readlink): Support file ports when ‘readlinkat’ exists. (scm_init_filesys): Provide ‘chdir-ports’ when it exists. * doc/ref/posix.texi (File System): Document it. * test-suite/tests/filesys.test ("readlink"): Test it. Signed-off-by: Ludovic Courtès --- configure.ac | 2 +- doc/ref/posix.texi | 9 +++++-- libguile/filesys.c | 52 +++++++++++++++++++++++++++++------- test-suite/tests/filesys.test | 61 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 112 insertions(+), 12 deletions(-) diff --git a/configure.ac b/configure.ac index 97fafaad0..82c0c8bb1 100644 --- a/configure.ac +++ b/configure.ac @@ -516,7 +516,7 @@ AC_CHECK_HEADERS([crt_externs.h]) # pipe2 - non-POSIX, found in glibc (GNU/Linux and GNU/Hurd) # AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ - fesetround ftime ftruncate fchown fchmod fchdir \ + fesetround ftime ftruncate fchown fchmod fchdir readlinkat \ getcwd geteuid getsid \ gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ nice readlink rmdir setegid seteuid \ diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index ed6c30c9f..d2344d400 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -775,8 +775,13 @@ file it points to. @var{path} must be a string. @deffn {Scheme Procedure} readlink path @deffnx {C Function} scm_readlink (path) -Return the value of the symbolic link named by @var{path} (a -string), i.e., the file that the link points to. +Return the value of the symbolic link named by @var{path} (a string, or +a port if supported by the system), i.e., the file that the link points +to. + +To read a symbolic link represented by a port, the symbolic link must +have been opened with the @code{O_NOFOLLOW} and @code{O_PATH} flags. +@code{(provided? 'readlink-port)} reports whether ports are supported. @end deffn @findex fchown diff --git a/libguile/filesys.c b/libguile/filesys.c index 43e55beb4..1ae2c5de7 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1032,10 +1032,30 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, #undef FUNC_NAME #endif /* HAVE_SYMLINK */ -SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, +/* Static helper function for choosing between readlink + and readlinkat. */ +static int +do_readlink (int fd, const char *c_path, char *buf, size_t size) +{ +#ifdef HAVE_READLINKAT + if (fd != -1) + return readlinkat (fd, c_path, buf, size); +#else + (void) fd; +#endif + return readlink (c_path, buf, size); +} + +SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, (SCM path), - "Return the value of the symbolic link named by @var{path} (a\n" - "string), i.e., the file that the link points to.") + "Return the value of the symbolic link named by @var{path} (a\n" + "string, or a port if supported by the system),\n" + "i.e., the file that the link points to.\n" + "To read a symbolic link represented by a port, the symbolic\n" + "link must have been opened with the @code{O_NOFOLLOW} and\n" + "@code{O_PATH} flags." + "@code{(provided? 'readlink-port)} reports whether ports are\n" + "supported.") #define FUNC_NAME s_scm_readlink { int rv; @@ -1043,20 +1063,31 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, char *buf; SCM result; char *c_path; - - scm_dynwind_begin (0); - - c_path = scm_to_locale_string (path); - scm_dynwind_free (c_path); + int fdes; + scm_dynwind_begin (0); +#ifdef HAVE_READLINKAT + if (SCM_OPFPORTP (path)) + { + c_path = ""; + fdes = SCM_FPORT_FDES (path); + } + else +#endif + { + fdes = -1; + c_path = scm_to_locale_string (path); + scm_dynwind_free (c_path); + } buf = scm_malloc (size); - while ((rv = readlink (c_path, buf, size)) == size) + while ((rv = do_readlink (fdes, c_path, buf, size)) == size) { free (buf); size *= 2; buf = scm_malloc (size); } + scm_remember_upto_here_1 (path); if (rv == -1) { int save_errno = errno; @@ -2073,6 +2104,9 @@ scm_init_filesys () #ifdef HAVE_FCHDIR scm_add_feature("chdir-port"); #endif +#ifdef HAVE_READLINKAT + scm_add_feature("readlink-port"); +#endif #include "filesys.x" } diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 6b09a2ba0..7feb3492f 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -306,3 +306,64 @@ (pass-if-exception "non-file port" exception:wrong-type-arg (chdir (open-input-string "")))) + +(with-test-prefix "readlink" + (false-if-exception (delete-file (test-symlink))) + (false-if-exception (delete-file (test-file))) + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (if (not (false-if-exception + (begin (symlink (test-file) (test-symlink)) #t))) + (display "cannot create symlink, some readlink tests skipped\n") + (let () + (pass-if-equal "file name of symlink" (test-file) + (readlink (test-symlink))) + + (pass-if-equal "port representing a symlink" (test-file) + (let () + (unless (and (provided? 'readlink-port) + (defined? 'O_NOFOLLOW) + (defined? 'O_PATH) + (not (= 0 O_NOFOLLOW)) + (not (= 0 O_PATH))) + (throw 'unsupported)) + (define port (open (test-symlink) (logior O_NOFOLLOW O_PATH))) + (define points-to (false-if-exception (readlink port))) + (close-port port) + points-to)) + + (pass-if-exception "not a port or file name" exception:wrong-type-arg + (readlink '(stuff))))) + + (pass-if-equal "port representing a regular file" EINVAL + (call-with-input-file (test-file) + (lambda (port) + (unless (provided? 'readlink-port) + (throw 'unsupported)) + (catch 'system-error + (lambda () + (readlink port) + (close-port port) ; should be unreachable + #f) + (lambda args + (close-port port) + ;; At least Linux 5.10.46 returns ENOENT instead of EINVAL. + ;; Possibly surprising, but it is documented in some man + ;; pages and it doesn't appear to be an accident: + ;; . + (define error (system-error-errno args)) + (if (= error ENOENT) + EINVAL + error)))))) + + (pass-if-exception "non-file port" exception:wrong-type-arg + (readlink (open-input-string ""))) + + (pass-if-exception "closed port" exception:wrong-type-arg + (let ((port (open-file (test-file) "r"))) + (close-port port) + (readlink port))) + + (false-if-exception (delete-file (test-symlink))) + (false-if-exception (delete-file (test-file)))) -- cgit v1.2.1