From 8b68e99cddf68e77a64f8179dbd3e8b4e3f1ef2b Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 12 Mar 2021 22:01:53 +0100
Subject: [PATCH 15/17] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
 =?UTF-8?q?=E2=80=98linkat=E2=80=99=20when=20available.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* configure.ac: Detect if ‘linkat’ is available.
* libguile/filesys.c (scm_linkat): Define the Scheme binding.
* libguile/filesys.h (scm_linkat): Make it part of the C API.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi | 11 +++++++++++
 libguile/filesys.c | 38 ++++++++++++++++++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 85a3a0dac..10320ce98 100644
--- a/configure.ac
+++ b/configure.ac
@@ -481,7 +481,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   sendfile - non-POSIX, found in glibc
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
-  fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
+  fesetround ftime ftruncate fchown fchmod fchdir readlinkat linkat	\
   symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat openat	\
   getcwd geteuid getsid	     	          	      	       		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 58dcaec01..dbbf8cc7a 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -992,6 +992,17 @@ link, the link may or may not be followed depending on the
 system.
 @end deffn
 
+@deffn {Scheme Procedure} linkat olddir oldpath newdir newpath [flags]
+@deffnx {C Function} scm_linkat (olddir, oldpath, newdir, newpath, flags)
+Like @code{link}, but resolve @var{oldpath} relative to
+the directory referred to by the file port @var{olddir}
+and @var{newpath} relative to @var{newdir} instead.
+
+The optional argument @var{flags} is a bitmask. If it contains
+@code{AT_SYMLINK_FOLLOW}, then @var{oldpath} will be dereferenced
+if it is a symbolic link.
+@end deffn
+
 @deffn {Scheme Procedure} symlink oldpath newpath
 @deffnx {C Function} scm_symlink (oldpath, newpath)
 Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ecea49822..f010397bd 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -782,6 +782,44 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_LINKAT
+SCM_DEFINE (scm_linkat, "linkat", 4, 1, 0,
+            (SCM olddir, SCM oldpath, SCM newdir, SCM newpath, SCM flags),
+            "Like @code{link}, but resolve @var{oldpath} relative to\n"
+            "the directory referred to by the file port @var{olddir}\n"
+            "and @var{newpath} relative to @var{newdir} instead.\n\n"
+            "The optional argument @var{flags} is a bitmask. If it contains\n"
+            "@code{AT_SYMLINK_FOLLOW}, then @var{oldpath} will be dereferenced\n"
+            "if it is a symbolic link.")
+#define FUNC_NAME s_scm_linkat
+{
+  int val;
+  int c_flags;
+  int olddir_fdes, newdir_fdes;
+
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir);
+  SCM_VALIDATE_OPFPORT (SCM_ARG2, newdir);
+  olddir_fdes = SCM_FPORT_FDES (olddir);
+  newdir_fdes = SCM_FPORT_FDES (newdir);
+
+  STRING2_SYSCALL (oldpath, c_oldpath,
+                   newpath, c_newpath,
+                   val = linkat (olddir_fdes, c_oldpath,
+                                 newdir_fdes, c_newpath,
+                                 c_flags));
+  scm_remember_upto_here_2 (olddir, newdir);
+  if (val != 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 
 /* {Navigating Directories}
  */
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 65a3c5b75..16eab6d4e 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -52,6 +52,7 @@ SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
+SCM_API SCM scm_linkat (SCM olddir, SCM oldpath, SCM newdir, SCM newpath, SCM flags);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
-- 
2.30.2