From 1d152d7fcc4fbf3c6b4492bed8aaf9502ffae778 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 12 Mar 2021 21:32:12 +0100
Subject: [PATCH 14/17] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
 =?UTF-8?q?=E2=80=98readlinkat=E2=80=99=20when=20it=20exists.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* libguile/filesys.c
  (scm_readlink): Extract common code with scm_readlinkat ...
  (do_readlink_loop): ... to here.
  (scm_readlinkat): Define the binding, using ‘do_readlink_loop’.
* libguile/filesys.h (scm_readlinkat): Make the binding part of
  the C API.
---
 doc/ref/posix.texi |  7 +++++
 libguile/filesys.c | 73 ++++++++++++++++++++++++++++++++++------------
 libguile/filesys.h |  1 +
 3 files changed, 62 insertions(+), 19 deletions(-)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 29d9b8d28..58dcaec01 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -824,6 +824,13 @@ string, or a port if the @code{readlinkat} system call is supported),
 i.e., the file that the link points to.
 @end deffn
 
+@deffn {Scheme Procedure} readlinkat dir path
+@deffnx {C Function} scm_readlinkat (dir, path)
+Like @code{readlink}, but resolve the symbolic link named by
+@var{path} relative to the directory referred to by the file
+port @var{dir} instead.
+@end deffn
+
 @findex fchown
 @findex lchown
 @deffn {Scheme Procedure} chown object owner group
diff --git a/libguile/filesys.c b/libguile/filesys.c
index d0566336a..ecea49822 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1250,6 +1250,35 @@ do_readlink (int fd, const char *c_path, char *buf, size_t size)
   return readlink (c_path, buf, size);
 }
 
+/* Except for the possibility of specifying a directory
+   to resolve relative to, scm_readlink and scm_readlinkat
+   function pretty much the same. */
+static SCM
+do_readlink_loop (const char *FUNC_NAME, int fdes, char *c_path)
+{
+  int rv;
+  int size = 100;
+  char *buf;
+  SCM result;
+
+  buf = scm_malloc (size);
+  while ((rv = do_readlink (fdes, c_path, buf, size)) == size)
+    {
+      free (buf);
+      size *= 2;
+      buf = scm_malloc (size);
+    }
+  if (rv == -1)
+    {
+      int save_errno = errno;
+      free (buf);
+      errno = save_errno;
+      SCM_SYSERROR;
+    }
+  result = scm_take_locale_stringn (buf, rv);
+  return result;
+}
+
 SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
             (SCM path),
             "Return the value of the symbolic link named by @var{path} (a\n"
@@ -1257,9 +1286,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
             "i.e., the file that the link points to.")
 #define FUNC_NAME s_scm_readlink
 {
-  int rv;
-  int size = 100;
-  char *buf;
   SCM result;
   char *c_path;
   int fdes;
@@ -1279,28 +1305,37 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
       c_path = scm_to_locale_string (path);
       scm_dynwind_free (c_path);
     }
-  buf = scm_malloc (size);
-
-  while ((rv = do_readlink (fdes, c_path, buf, size)) == size)
-    {
-      free (buf);
-      size *= 2;
-      buf = scm_malloc (size);
-    }
+  result = do_readlink_loop (FUNC_NAME, fdes, c_path);
   scm_remember_upto_here_1 (path);
-  if (rv == -1)
-    {
-      int save_errno = errno;
-      free (buf);
-      errno = save_errno;
-      SCM_SYSERROR;
-    }
-  result = scm_take_locale_stringn (buf, rv);
+  scm_dynwind_end ();
+  return result;
+}
+#undef FUNC_NAME
+
+#ifdef HAVE_READLINKAT
+SCM_DEFINE (scm_readlinkat, "readlinkat", 2, 0, 0,
+            (SCM dir, SCM path),
+            "Like @code{readlink}, but resolve the symbolic link named by\n"
+            "@var{path} relative to the directory referred to by the file\n"
+            "port @var{dir} instead.")
+#define FUNC_NAME s_scm_readlinkat
+{
+  SCM result;
+  char *c_path;
+  int fdes;
 
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  fdes = SCM_FPORT_FDES (dir);
+  scm_dynwind_begin (0);
+  c_path = scm_to_locale_string (path);
+  scm_dynwind_free (c_path);
+  result = do_readlink_loop (FUNC_NAME, fdes, c_path);
+  scm_remember_upto_here_1 (dir);
   scm_dynwind_end ();
   return result;
 }
 #undef FUNC_NAME
+#endif /* HAVE_READLINKAT */
 
 SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
             (SCM oldfile, SCM newfile),
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..65a3c5b75 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -72,6 +72,7 @@ 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_readlinkat (SCM dir, SCM path);
 SCM_API SCM scm_lstat (SCM str);
 SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
 SCM_API SCM scm_mkstemp (SCM tmpl);
-- 
2.30.2