From 6c350b609475ec7c490a8faecedd6a768afd7065 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 16 Nov 2021 11:06:27 +0000 Subject: =?UTF-8?q?Define=20=E2=80=98symlinkat=E2=80=99=20wrapper=20when?= =?UTF-8?q?=20supported.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: Detect whether ‘symlinkat’ exists. * libguile/filesys.c (scm_symlinkat): Define a Scheme binding when it exists. * libguile/filesys.h: Make the binding part of the public C API. * doc/ref/posix.texi (File System): Document the binding. * test-suite/tests/filesys.test ("symlinkat"): Test it. Signed-off-by: Ludovic Courtès --- configure.ac | 2 +- doc/ref/posix.texi | 6 ++++++ libguile/filesys.c | 23 +++++++++++++++++++++++ libguile/filesys.h | 1 + test-suite/tests/filesys.test | 27 +++++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index e4e407afa..49e30d20b 100644 --- a/configure.ac +++ b/configure.ac @@ -517,7 +517,7 @@ AC_CHECK_HEADERS([crt_externs.h]) # AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ fesetround ftime ftruncate fchown fchmod fchdir readlinkat \ - getcwd geteuid getsid \ + symlinkat getcwd geteuid getsid \ gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ nice readlink rmdir setegid seteuid \ setuid setgid setpgid setsid sigaction siginterrupt stat64 \ diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index fbb59c720..ac669c940 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -909,6 +909,12 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to) @var{oldpath}. The return value is unspecified. @end deffn +@deffn {Scheme Procedure} symlinkat dir oldpath newpath +@deffnx {C Function} scm_symlinkat (dir, oldpath, newpath) +Like @code{symlink}, but resolve @var{newpath} relative to +the directory referred to by the file port @var{dir}. +@end deffn + @deffn {Scheme Procedure} mkdir path [mode] @deffnx {C Function} scm_mkdir (path, mode) Create a new directory named by @var{path}. If @var{mode} is omitted diff --git a/libguile/filesys.c b/libguile/filesys.c index 1ae2c5de7..e00ddba5f 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1032,6 +1032,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, #undef FUNC_NAME #endif /* HAVE_SYMLINK */ +#ifdef HAVE_SYMLINKAT +SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0, + (SCM dir, SCM oldpath, SCM newpath), + "Like @code{symlink}, but resolve @var{newpath} relative\n" + "to the directory referred to by the file port @var{dir}.") +#define FUNC_NAME s_scm_symlinkat +{ + int val; + int fdes; + + SCM_VALIDATE_OPFPORT (SCM_ARG1, dir); + fdes = SCM_FPORT_FDES (dir); + STRING2_SYSCALL (oldpath, c_oldpath, + newpath, c_newpath, + val = symlinkat (c_oldpath, fdes, c_newpath)); + scm_remember_upto_here_1 (dir); + if (val != 0) + SCM_SYSERROR; + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif /* HAVE_SYMLINKAT */ + /* Static helper function for choosing between readlink and readlinkat. */ static int diff --git a/libguile/filesys.h b/libguile/filesys.h index a3b257c12..d181aca52 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs) SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value); SCM_API SCM scm_fsync (SCM object); SCM_API SCM scm_symlink (SCM oldpath, SCM newpath); +SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath); SCM_API SCM scm_readlink (SCM path); SCM_API SCM scm_lstat (SCM str); SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 7feb3492f..64bf92333 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -367,3 +367,30 @@ (false-if-exception (delete-file (test-symlink))) (false-if-exception (delete-file (test-file)))) + +(with-test-prefix "symlinkat" + (pass-if-equal "create" (test-file) + (unless (defined? 'symlinkat) + (throw 'unsupported)) + (call-with-port + (open "." O_RDONLY) + (lambda (port) + (symlinkat port (test-file) (test-symlink)) + (readlink (test-symlink))))) + (false-if-exception (delete-file (test-symlink))) + + (pass-if-exception "not a port" exception:wrong-type-arg + (unless (defined? 'symlinkat) + (throw 'unsupported)) + (symlinkat "bogus" (test-file) (test-symlink))) + + (pass-if-exception "not a file port" exception:wrong-type-arg + (unless (defined? 'symlinkat) + (throw 'unsupported)) + (symlinkat (open-input-string "") (test-file) (test-symlink))) + + (pass-if-exception "closed port" exception:wrong-type-arg + (unless (defined? 'symlinkat) + (throw 'unsupported)) + (symlinkat (call-with-port (open "." O_RDONLY) identity) + (test-file) (test-symlink)))) -- cgit v1.2.1