unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Bindings to *at  functions & allowing more functions to operate on ports
@ 2021-03-12 21:59 Maxime Devos
  2021-03-27 21:19 ` Maxime Devos
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
  0 siblings, 2 replies; 26+ messages in thread
From: Maxime Devos @ 2021-03-12 21:59 UTC (permalink / raw)
  Cc: guile-devel


[-- Attachment #1.1: Type: text/plain, Size: 438 bytes --]

Hi guilers!

This patch series defines:
* More AT_* and O_* flags.
* Bindings to *at functions (e.g. mkdirat, fchmodat).
* Bindings to f* functions (e.g. fchdir).
  (No new functions, the old functions just accept more types.)

It also sprinkles some scm_remember_upto_here's in
some procedures operating on ports where I think it's needed.

I haven't assigned copyright to the FSF, how would this work?

Greetings,
Maxime

[-- Attachment #1.2: 0001-Add-scm_remember_upto_here-to-functions-using-a-port.patch --]
[-- Type: text/x-patch, Size: 14965 bytes --]

From e4deaca45606a9ade686e7cf447c9cec93e8c9e2 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 6 Mar 2021 21:39:52 +0100
Subject: [PATCH 01/17] Add scm_remember_upto_here to functions using a port's
 fd.

This prevents a garbage collection cycle at an inopportune
time from closing a port while its file descriptor is still
required.

* libguile/filesys.c
  (scm_chown, scm_stat, scm_fcntl, scm_fsync, scm_sendfile)
  (scm_chmod): Add a scm_remember_upto_here after the system call
  is done with fhe file descriptor.
* libguile/fports.c
  (fport_input_waiting, fport_read, fport_write, fport_seek)
  (fport_truncate, fport_close, port_random_access_p)
  (fport_get_natural_buffer_sizes): Likewise.
* libguile/ioext.c
  (scm_dup_to_fdes, scm_dup2, scm_isatty_p)
  (scm_primitive_move_to_fdes): Likewise.
* libguile/posix.c
  (scm_ttyname, scm_tcgetpgrp, scm_tcsetpgrp, scm_flock): Likewise.
  (scm_piped_process): Likewise, and introduce the 'error_port',
  'output_port' and 'input_port' variables in order to be able
  to remember these later.
* libguile/rw.c
  (scm_read_string_x_partial, scm_write_string_partial): Likewise,
  and introduce a 'port' variable in order to be able to remember
  it later.
* THANKS: Add patch author.
---
 THANKS             |  1 +
 libguile/filesys.c |  6 ++++++
 libguile/fports.c  | 11 +++++++++++
 libguile/ioext.c   |  7 ++++++-
 libguile/posix.c   | 28 +++++++++++++++++-----------
 libguile/rw.c      | 26 ++++++++++++++++++++------
 libguile/socket.c  | 17 ++++++++++++++---
 7 files changed, 75 insertions(+), 21 deletions(-)

diff --git a/THANKS b/THANKS
index aa4877e95..cdfa9e10d 100644
--- a/THANKS
+++ b/THANKS
@@ -78,6 +78,7 @@ For fixes or providing information which led to a fix:
           Brian Crowder
     Christopher Cramer
            Josh Datko
+         Maxime Devos
           David Diffenbaugh
           Hyper Division
            Erik Dominikus
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 666bcb8c3..b97614498 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -177,6 +177,7 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 		  SCM_FPORT_FDES (object) : scm_to_int (object));
 
       SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
+      scm_remember_upto_here_1 (object);
     }
   else
 #endif
@@ -581,6 +582,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
       SCM_VALIDATE_OPFPORT (1, object);
       fdes = SCM_FPORT_FDES (object);
       SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
+      scm_remember_upto_here_1 (object);
     }
 
   if (rv == -1)
@@ -1012,6 +1014,7 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
   SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
   if (rv == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1039,6 +1042,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
 
   if (fsync (fdes) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1260,6 +1264,7 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 
   }
 
+  scm_remember_upto_here_2 (in, out);
   return scm_from_size_t (total);
 
 #undef VALIDATE_FD_OR_PORT
@@ -1453,6 +1458,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
       else
 	fdes = SCM_FPORT_FDES (object);
       SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
+      scm_remember_upto_here_1 (object);
     }
   else
 #endif
diff --git a/libguile/fports.c b/libguile/fports.c
index 4a3c30b88..5c59f0958 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -480,6 +480,7 @@ fport_input_waiting (SCM port)
   if (poll (&pollfd, 1, 0) < 0)
     scm_syserror ("fport_input_waiting");
 
+  scm_remember_upto_here_1 (port);
   return pollfd.revents & POLLIN ? 1 : 0;
 }
 
@@ -606,6 +607,7 @@ fport_read (SCM port, SCM dst, size_t start, size_t count)
         return -1;
       scm_syserror ("fport_read");
     }
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -630,6 +632,7 @@ fport_write (SCM port, SCM src, size_t start, size_t count)
       scm_syserror ("fport_write");
     }
 
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -640,6 +643,7 @@ fport_seek (SCM port, scm_t_off offset, int whence)
   scm_t_off result;
 
   result = lseek (fp->fdes, offset, whence);
+  scm_remember_upto_here_1 (port);
 
   if (result == -1)
     scm_syserror ("fport_seek");
@@ -654,6 +658,8 @@ fport_truncate (SCM port, scm_t_off length)
 
   if (ftruncate (fp->fdes, length) == -1)
     scm_syserror ("ftruncate");
+
+  scm_remember_upto_here_1 (port);
 }
 
 static void
@@ -673,6 +679,8 @@ fport_close (SCM port)
        Instead just throw an error if close fails, trusting that the fd
        was cleaned up.  */
     scm_syserror ("fport_close");
+
+  scm_remember_upto_here_1 (port);
 }
 
 static int
@@ -686,6 +694,7 @@ fport_random_access_p (SCM port)
   if (lseek (fp->fdes, 0, SEEK_CUR) == -1)
     return 0;
 
+  scm_remember_upto_here_1 (port);
   return 1;
 }
 
@@ -705,6 +714,8 @@ fport_get_natural_buffer_sizes (SCM port, size_t *read_size, size_t *write_size)
 
   if (fstat (fp->fdes, &st) == 0)
     *read_size = *write_size = st.st_blksize;
+
+  scm_remember_upto_here_1 (port);
 #endif
 }
 
diff --git a/libguile/ioext.c b/libguile/ioext.c
index d08b68df3..9dc1980dd 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -140,6 +140,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
   if (SCM_UNBNDP (fd))
     {
       newfd = dup (oldfd);
+      scm_remember_upto_here_1 (fd_or_port);
       if (newfd == -1)
 	SCM_SYSERROR;
       fd = scm_from_int (newfd);
@@ -151,6 +152,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
 	{
 	  scm_evict_ports (newfd);	/* see scsh manual.  */
 	  rv = dup2 (oldfd, newfd);
+	  scm_remember_upto_here_1 (fd_or_port);
 	  if (rv == -1)
 	    SCM_SYSERROR;
 	}
@@ -179,6 +181,7 @@ SCM_DEFINE (scm_dup2, "dup2", 2, 0, 0,
   c_oldfd = scm_to_int (oldfd);
   c_newfd = scm_to_int (newfd);
   rv = dup2 (c_oldfd, c_newfd);
+  scm_remember_upto_here_2 (oldfd, newfd);
   if (rv == -1)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
@@ -219,7 +222,8 @@ SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0,
     return SCM_BOOL_F;
   
   rv = isatty (SCM_FPORT_FDES (port));
-  return  scm_from_bool(rv);
+  scm_remember_upto_here_1 (port);
+  return scm_from_bool(rv);
 }
 #undef FUNC_NAME
 
@@ -278,6 +282,7 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
   stream->fdes = new_fd;
   scm_run_fdes_finalizers (old_fd);
   SCM_SYSCALL (close (old_fd));  
+  scm_remember_upto_here_1 (port);
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
diff --git a/libguile/posix.c b/libguile/posix.c
index 47769003a..f76722a43 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1029,6 +1029,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
 
   SCM_SYSCALL (result = ttyname (fd));
   err = errno;
+  scm_remember_upto_here_1 (port);
   if (result != NULL)
     result = strdup (result);
 
@@ -1093,6 +1094,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
   fd = SCM_FPORT_FDES (port);
   if ((pgid = tcgetpgrp (fd)) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (port);
   return scm_from_int (pgid);
 }
 #undef FUNC_NAME    
@@ -1116,6 +1118,7 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
   fd = SCM_FPORT_FDES (port);
   if (tcsetpgrp (fd, scm_to_int (pgid)) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (port);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1404,19 +1407,21 @@ scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
     }
 
   {
-    SCM port;
-
-    if (SCM_OPOUTFPORTP ((port = scm_current_error_port ())))
-      err = SCM_FPORT_FDES (port);
-    if (out == -1 && SCM_OPOUTFPORTP ((port = scm_current_output_port ())))
-      out = SCM_FPORT_FDES (port);
-    if (in == -1 && SCM_OPINFPORTP ((port = scm_current_input_port ())))
-      in = SCM_FPORT_FDES (port);
+    SCM error_port, output_port = SCM_UNDEFINED, input_port = SCM_UNDEFINED;
+
+    if (SCM_OPOUTFPORTP ((error_port = scm_current_error_port ())))
+      err = SCM_FPORT_FDES (error_port);
+    if (out == -1 && SCM_OPOUTFPORTP ((output_port = scm_current_output_port ())))
+      out = SCM_FPORT_FDES (output_port);
+    if (in == -1 && SCM_OPINFPORTP ((input_port = scm_current_input_port ())))
+      in = SCM_FPORT_FDES (input_port);
+
+    pid = start_child (exec_file, exec_argv, reading, c2p, writing, p2c,
+                       in, out, err);
+    scm_remember_upto_here_2 (input_port, output_port);
+    scm_remember_upto_here (error_port);
   }
 
-  pid = start_child (exec_file, exec_argv, reading, c2p, writing, p2c,
-                     in, out, err);
-
   if (pid == -1)
     {
       int errno_save = errno;
@@ -2241,6 +2246,7 @@ SCM_DEFINE (scm_flock, "flock", 2, 0, 0,
     }
   if (flock (fdes, scm_to_int (operation)) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (file);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
diff --git a/libguile/rw.c b/libguile/rw.c
index 7afae1c63..ff1b2f7d1 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -109,6 +109,7 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
   size_t offset;
   long read_len;
   long chars_read = 0;
+  SCM port = SCM_UNDEFINED;
   int fdes;
 
   {
@@ -124,8 +125,8 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
     fdes = scm_to_int (port_or_fdes);
   else
     {
-      SCM port = (SCM_UNBNDP (port_or_fdes)?
-		  scm_current_input_port () : port_or_fdes);
+      port = (SCM_UNBNDP (port_or_fdes)?
+              scm_current_input_port () : port_or_fdes);
 
       SCM_VALIDATE_OPFPORT (2, port);
       SCM_VALIDATE_INPUT_PORT (2, port);
@@ -162,7 +163,13 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
 	}
     }
 
-  scm_remember_upto_here_1 (str);
+  /* We need to remember 'port' here; 'port_or_fdes' won't suffice
+     as '(current-input-port)' can be assigned to 'port'
+     and the '(current-input-port)' can be changed by an asynchronuous
+     interrupt, potentially allowing the old input port to be garbage
+     collected and closed, even though the system call still requires
+     its file descriptor. */
+  scm_remember_upto_here_2 (port, str);
   return scm_from_long (chars_read);
 }
 #undef FUNC_NAME
@@ -214,6 +221,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
   const char *src;
   scm_t_off write_len;
   int fdes;
+  SCM port = SCM_UNDEFINED;
 
   {
     size_t offset;
@@ -234,8 +242,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
     fdes = scm_to_int (port_or_fdes);
   else
     {
-      SCM port = (SCM_UNBNDP (port_or_fdes)?
-		  scm_current_output_port () : port_or_fdes);
+      port = (SCM_UNBNDP (port_or_fdes)?
+              scm_current_output_port () : port_or_fdes);
       SCM write_buf;
       size_t end;
 
@@ -266,7 +274,13 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 	  SCM_SYSERROR;
       }
 
-    scm_remember_upto_here_1 (str);
+    /* We need to rememember 'port'; remembering 'port_or_fdes' won't
+       suffice as '(current-output-port)' can be assigned to 'port'
+       and the '(current-output-port)' can be changed by an asynchronuous
+       interrupt, potentially allowing the old output port to be garbage
+       collected and closed even though the 'write' system call still
+       requires the file descriptor. */
+    scm_remember_upto_here_2 (str, port);
     return scm_from_long (rv);
   }
 }
diff --git a/libguile/socket.c b/libguile/socket.c
index 8af6f57bf..8b9e64a8b 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -503,6 +503,7 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
   if (getsockopt (fd, ilevel, ioptname, (void *) &optval, &optlen) == -1)
     SCM_SYSERROR;
 
+  scm_remember_upto_here_1 (sock);
   if (ilevel == SOL_SOCKET)
     {
 #ifdef SO_LINGER
@@ -673,6 +674,8 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
 
   if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
     SCM_SYSERROR;
+
+  scm_remember_upto_here_1 (sock);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -707,6 +710,7 @@ SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
   fd = SCM_FPORT_FDES (sock);
   if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (sock);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -876,6 +880,7 @@ SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
       SCM_SYSERROR;
     }
   free (soka);
+  scm_remember_upto_here_1 (sock);
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
@@ -946,6 +951,7 @@ SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
     SCM_SYSERROR;
   }
   free (soka);
+  scm_remember_upto_here_1 (sock);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -967,6 +973,7 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
   fd = SCM_FPORT_FDES (sock);
   if (listen (fd, scm_to_int (backlog)) == -1)
     SCM_SYSERROR;
+  scm_remember_upto_here_1 (sock);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1284,6 +1291,7 @@ SCM_DEFINE (scm_accept4, "accept", 1, 1, 0,
         return SCM_BOOL_F;
       SCM_SYSERROR;
     }
+  scm_remember_upto_here_1 (sock);
   newsock = scm_socket_fd_to_port (newfd);
   address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
 
@@ -1314,6 +1322,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
   if (getsockname (fd, (struct sockaddr *) &addr, &addr_size) == -1)
     SCM_SYSERROR;
 
+  scm_remember_upto_here_1 (sock);
   return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
 }
 #undef FUNC_NAME
@@ -1336,6 +1345,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
   if (getpeername (fd, (struct sockaddr *) &addr, &addr_size) == -1)
     SCM_SYSERROR;
 
+  scm_remember_upto_here_1 (sock);
   return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
 }
 #undef FUNC_NAME
@@ -1381,7 +1391,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
   if (SCM_UNLIKELY (rv == -1))
     SCM_SYSERROR;
 
-  scm_remember_upto_here (buf);
+  scm_remember_upto_here_2 (sock, buf);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1426,7 +1436,7 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
   if (rv == -1)
     SCM_SYSERROR;
 
-  scm_remember_upto_here_1 (message);
+  scm_remember_upto_here_2 (sock, message);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1504,6 +1514,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
   if (rv == -1)
     SCM_SYSERROR;
 
+  scm_remember_upto_here_1 (sock);
   /* `recvfrom' does not necessarily return an address.  Usually nothing
      is returned for stream sockets.  */
   if (((struct sockaddr *) &addr)->sa_family != AF_UNSPEC)
@@ -1586,7 +1597,7 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
     }
   free (soka);
 
-  scm_remember_upto_here_1 (message);
+  scm_remember_upto_here_2 (sock, message);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
-- 
2.30.2


[-- Attachment #1.3: 0002-Allow-file-ports-in-chdir-when-supported.patch --]
[-- Type: text/x-patch, Size: 2786 bytes --]

From af8c3fdfad9343dec8b44dedfb05da9c99cc8269 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Tue, 9 Mar 2021 15:59:36 +0100
Subject: [PATCH 02/17] =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98chdi?=
 =?UTF-8?q?r=E2=80=99=20when=20supported..?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* configure.ac: Check for ‘fchdir’.
* libguile/filesys.c (scm_chdir): Suppport file ports.
* doc/ref/posix.texi (Processes): Update accordingly.
---
 configure.ac       |  3 ++-
 doc/ref/posix.texi |  2 ++
 libguile/filesys.c | 16 +++++++++++++++-
 3 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index 271ac3c2d..a23249d95 100644
--- a/configure.ac
+++ b/configure.ac
@@ -481,7 +481,8 @@ 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 getcwd geteuid getsid        \
+  fesetround ftime ftruncate fchown fchmod fchdir			\
+  getcwd geteuid getsid							\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 2b2d6eb4f..54c564cb0 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1641,6 +1641,8 @@ The return value is unspecified.
 @deffnx {C Function} scm_chdir (str)
 @cindex current directory
 Change the current working directory to @var{str}.
+@var{str} can be a string containing a file name,
+or a port if the @code{fchdir} system call is supported.
 The return value is unspecified.
 @end deffn
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index b97614498..a8879f0e1 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -658,12 +658,26 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
 SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, 
             (SCM str),
 	    "Change the current working directory to @var{str}.\n"
+            "@var{str} can be a string containing a file name,\n"
+            "or a port if the @code{fchdir} system call is supported.\n"
 	    "The return value is unspecified.")
 #define FUNC_NAME s_scm_chdir
 {
   int ans;
 
-  STRING_SYSCALL (str, c_str, ans = chdir (c_str));
+#ifdef HAVE_FCHDIR
+  if (SCM_OPFPORTP (str))
+    {
+      int fdes;
+      fdes = SCM_FPORT_FDES (str);
+      SCM_SYSCALL (ans = fchdir (fdes));
+      scm_remember_upto_here_1 (str);
+    }
+  else
+#endif
+    {
+      STRING_SYSCALL (str, c_str, ans = chdir (c_str));
+    }
   if (ans != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
-- 
2.30.2


[-- Attachment #1.4: 0003-Allow-file-ports-in-readlink.patch --]
[-- Type: text/x-patch, Size: 3861 bytes --]

From 2fb0446d5b4f410608adcfe3297338bdeef23abe Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Wed, 10 Mar 2021 12:07:01 +0100
Subject: [PATCH 03/17] =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98read?=
 =?UTF-8?q?link=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.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi |  3 ++-
 libguile/filesys.c | 45 ++++++++++++++++++++++++++++++++++++---------
 3 files changed, 39 insertions(+), 11 deletions(-)

diff --git a/configure.ac b/configure.ac
index a23249d95..0f032272a 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			\
+  fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
   getcwd geteuid getsid							\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 54c564cb0..68de5a2ed 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -795,7 +795,8 @@ 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.
+string, or a port if the @code{readlinkat} system call is supported),
+i.e., the file that the link points to.
 @end deffn
 
 @findex fchown
diff --git a/libguile/filesys.c b/libguile/filesys.c
index a8879f0e1..06a550fc8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1081,10 +1081,25 @@ 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 the @code{readlinkat} system call is supported),\n"
+            "i.e., the file that the link points to.")
 #define FUNC_NAME s_scm_readlink
 {
   int rv;
@@ -1092,20 +1107,32 @@ 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_FPORTP (path))
+    {
+      SCM_VALIDATE_OPINPORT (SCM_ARG1, 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;
-- 
2.30.2


[-- Attachment #1.5: 0004-Accept-open-file-ports-in-utime-when-supported.patch --]
[-- Type: text/x-patch, Size: 6676 bytes --]

From 021567541a2685b6b7467d08188c51cd22368374 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Wed, 10 Mar 2021 15:02:03 +0100
Subject: [PATCH 04/17] =?UTF-8?q?Accept=20open=20file=20ports=20in=20?=
 =?UTF-8?q?=E2=80=98utime=E2=80=99=20when=20supported.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* configure.ac: Detect if the ‘futimens’ system call
  is defined.
* libguile/posix.c (scm_utime): Allow file ports if the
  ‘futimens’ and ‘utimensat’ system calls are defined.
* doc/ref/posix.texi (File System): Document it.
* test-suite/tests/posix.test: Test it.
---
 configure.ac                |  4 ++--
 doc/ref/posix.texi          | 10 ++++++----
 libguile/posix.c            | 22 +++++++++++++++++++---
 test-suite/tests/posix.test | 33 +++++++++++++++++++++++++++++++--
 4 files changed, 58 insertions(+), 11 deletions(-)

diff --git a/configure.ac b/configure.ac
index 0f032272a..551856fc4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -474,7 +474,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   truncate - not in mingw
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
-#   strcoll_l, newlocale, uselocale, utimensat - POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -491,7 +491,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp  \
   index bcopy memcpy rindex truncate isblank _NSGetEnviron              \
   strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat     \
-  sched_getaffinity sched_setaffinity sendfile])
+  sched_getaffinity sched_setaffinity sendfile futimens])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
 AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include <langinfo.h>]])
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 68de5a2ed..80ee02b93 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -832,7 +832,8 @@ The return value is unspecified.
 @deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]]
 @deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags)
 @code{utime} sets the access and modification times for the
-file named by @var{pathname}.  If @var{actime} or @var{modtime} is
+file named by @var{pathname} (a string, or a file port if supported
+by the host system).  If @var{actime} or @var{modtime} is
 not supplied, then the current time is used.  @var{actime} and
 @var{modtime} must be integer time values as returned by the
 @code{current-time} procedure.
@@ -848,9 +849,10 @@ will set the access time to one hour in the past and the
 modification time to the current time.
 
 @vindex AT_SYMLINK_NOFOLLOW
-Last, @var{flags} may be either @code{0} or the
-@code{AT_SYMLINK_NOFOLLOW} constant, to set the time of
-@var{pathname} even if it is a symbolic link.
+Last, @var{flags} may be either @code{0} or;
+if @var{pathname} is not a port, the @code{AT_SYMLINK_NOFOLLOW}
+constant, to set the time of @var{pathname} even if it is a
+symbolic link.
 @end deffn
 
 @findex unlink
diff --git a/libguile/posix.c b/libguile/posix.c
index f76722a43..351ce8c0c 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1629,7 +1629,8 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
             (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens,
              SCM flags),
 	    "@code{utime} sets the access and modification times for the\n"
-	    "file named by @var{pathname}.  If @var{actime} or @var{modtime} is\n"
+	    "file named by @var{pathname} (a string, or a file port if\n"
+	    "supported by the host system). If @var{actime} or @var{modtime} is\n"
 	    "not supplied, then the current time is used.  @var{actime} and\n"
 	    "@var{modtime} must be integer time values as returned by the\n"
 	    "@code{current-time} procedure.\n\n"
@@ -1703,8 +1704,23 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
     times[1].tv_sec = mtim_sec;
     times[1].tv_nsec = mtim_nsec;
 
-    STRING_SYSCALL (pathname, c_pathname,
-                    rv = utimensat (AT_FDCWD, c_pathname, times, f));
+#ifdef HAVE_FUTIMENS
+    if (SCM_OPFPORTP (pathname))
+      {
+        int fd;
+        fd = SCM_FPORT_FDES (pathname);
+        if (f != 0)
+          scm_out_of_range (FUNC_NAME, flags);
+
+        SCM_SYSCALL (rv = futimens (fd, times));
+        scm_remember_upto_here_1 (pathname);
+      }
+    else
+#endif
+      {
+        STRING_SYSCALL (pathname, c_pathname,
+                        rv = utimensat (AT_FDCWD, c_pathname, times, f));
+      }
   }
 #else
   {
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 135f09c11..88f9d8a58 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,6 +1,6 @@
 ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
 ;;;;
-;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019
+;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -211,7 +211,36 @@
                 (list (stat:atime info) (stat:mtime info))))
             (lambda ()
               (delete-file file))))
-        (throw 'unsupported))))
+        (throw 'unsupported)))
+
+  (pass-if-equal "file port"
+      '(1 1)
+    (let ((file "posix.test-utime"))
+      (dynamic-wind
+        (lambda ()
+          (close-port (open-output-file file)))
+        (lambda ()
+          (with-input-from-file file
+            (lambda ()
+              (catch 'system-error
+                (lambda ()
+                  (catch 'wrong-type-arg
+                    (lambda ()
+                      (utime file 1 1 0 0))
+                    ;; 'futimens' is not supported on all
+                    ;; platforms.
+                    (lambda _
+                      (throw 'unsupported))))
+                (lambda args
+                  ;; On some platforms, 'futimens' returns
+                  ;; ENOSYS according to Gnulib.
+                  (if (= (system-error-errno args) ENOSYS)
+                      (throw 'unsupported)
+                      (apply throw args))))))
+          (let ((info (stat file)))
+            (list (stat:atime info) (stat:mtime info))))
+        (lambda ()
+          (delete-file file))))))
 
 ;;
 ;; affinity
-- 
2.30.2


[-- Attachment #1.6: 0005-Define-symlinkat-wrapper-when-supported.patch --]
[-- Type: text/x-patch, Size: 3742 bytes --]

From 83e4862a1d9a023f1c2a19a1938d761cb020d6d8 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Wed, 10 Mar 2021 20:50:07 +0100
Subject: [PATCH 05/17] =?UTF-8?q?Define=20=E2=80=98symlinkat=E2=80=99=20wr?=
 =?UTF-8?q?apper=20when=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.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi |  6 ++++++
 libguile/filesys.c | 23 +++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 551856fc4..1af02bb7b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h 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 rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 80ee02b93..eff49b5a5 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -919,6 +919,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 06a550fc8..f86b5bb70 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1081,6 +1081,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);
-- 
2.30.2


[-- Attachment #1.7: 0006-Define-bindings-to-mkdirat-when-the-C-function-exist.patch --]
[-- Type: text/x-patch, Size: 3614 bytes --]

From 68f62489c75c8449bd6bdf8fa3c8aacbf19cc33f Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 11 Mar 2021 20:40:18 +0100
Subject: [PATCH 06/17] =?UTF-8?q?Define=20bindings=20to=20=E2=80=98mkdirat?=
 =?UTF-8?q?=E2=80=99=20when=20the=20C=20function=20exists.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* configure.ac: Detect if ‘mkdirat’ exists.
* libguile/filesys.c (scm_mkdirat): Define the Scheme binding.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi |  6 ++++++
 libguile/filesys.c | 25 +++++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 1af02bb7b..15b0ff4a9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat getcwd geteuid getsid							\
+  symlinkat mkdirat getcwd geteuid getsid				\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index eff49b5a5..72e0c3032 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -934,6 +934,12 @@ Otherwise they are set to the value specified with @var{mode}.
 The return value is unspecified.
 @end deffn
 
+@deffn {Scheme Proecdure} mkdirat dir path [mode]
+@deffnx {C Function} scm_mkdirat (dir, path, mode)
+Like @code{mkdir}, but resolve @var{path} relative to the directory
+referred to by the file port @var{dir} instead.
+@end deffn
+
 @deffn {Scheme Procedure} rmdir path
 @deffnx {C Function} scm_rmdir (path)
 Remove the existing directory named by @var{path}.  The directory must
diff --git a/libguile/filesys.c b/libguile/filesys.c
index f86b5bb70..2d0c619af 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1397,6 +1397,31 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_MKDIRAT
+SCM_DEFINE (scm_mkdirat, "mkdirat", 2, 1, 0,
+            (SCM dir, SCM path, SCM mode),
+            "Like @code{mkdir}, but resolve @var{path} relative to the directory\n"
+            "referred to by the file port @var{dir} instead.")
+#define FUNC_NAME s_scm_mkdirat
+{
+  int rv;
+  int dir_fdes;
+  mode_t c_mode;
+
+  c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (path, c_path, rv = mkdirat (dir_fdes, c_path, c_mode));
+  if (rv != 0)
+    SCM_SYSERROR;
+
+  scm_remember_upto_here_1 (dir);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, 
             (SCM path),
 	    "Remove the existing directory named by @var{path}.  The directory must\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index d181aca52..f0dd35ede 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -50,6 +50,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
+SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
 SCM_API SCM scm_rmdir (SCM path);
 SCM_API SCM scm_directory_stream_p (SCM obj);
 SCM_API SCM scm_opendir (SCM dirname);
-- 
2.30.2


[-- Attachment #1.8: 0007-Define-AT_REMOVEDIR-and-others-when-available.patch --]
[-- Type: text/x-patch, Size: 1169 bytes --]

From f2e681ec9562cd23f0cfaba7edd3702aafb673b6 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 11 Mar 2021 21:01:45 +0100
Subject: [PATCH 07/17] Define AT_REMOVEDIR and others when available.

* libguile/posix.c (scm_init_posix): Define (in Scheme)
  AT_REMOVEDIR, AT_FDCWD and AT_EACCESS when defined (in C).
---
 libguile/posix.c | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index 351ce8c0c..2ee459d2d 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2014,2016-2019
+/* Copyright 1995-2014,2016-2019,2021
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -2482,6 +2482,15 @@ scm_init_posix ()
 #ifdef AT_EMPTY_PATH
   scm_c_define ("AT_EMPTY_PATH", scm_from_int (AT_EMPTY_PATH));
 #endif
+#ifdef AT_REMOVEDIR
+  scm_c_define ("AT_REMOVEDIR", scm_from_int (AT_REMOVEDIR));
+#endif
+#ifdef AT_FDCWD
+  scm_c_define ("AT_FDCWD", scm_from_int (AT_FDCWD));
+#endif
+#ifdef AT_EACCESS
+  scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
+#endif
 
 #include "cpp-SIG.c"
 #include "posix.x"
-- 
2.30.2


[-- Attachment #1.9: 0008-Define-a-Scheme-binding-to-renameat-when-it-exists.patch --]
[-- Type: text/x-patch, Size: 4037 bytes --]

From cf9308cb74fee4f4401cf06a8701318f885a6bd3 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 11 Mar 2021 22:47:16 +0100
Subject: [PATCH 08/17] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
 =?UTF-8?q?=E2=80=98renameat=E2=80=99=20when=20it=20exists.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* configure.ac: Detect if ‘renameat’ is defined.
* libguile/filesys.c (scm_renameat): Define a Scheme binding
  to the ‘renameat’ system call.
* doc/ref/posix.texi (File System): Document it.
* libguile/filesys.h (scm_renameat): Make it part of the C API.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi |  8 ++++++++
 libguile/filesys.c | 27 +++++++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index 15b0ff4a9..a2ad3364f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat getcwd geteuid getsid				\
+  symlinkat mkdirat renameat getcwd geteuid getsid				\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 72e0c3032..a5dabf5e1 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -905,6 +905,14 @@ Renames the file specified by @var{oldname} to @var{newname}.
 The return value is unspecified.
 @end deffn
 
+@findex renameat
+@deffn {Scheme Procedure} rename-file-at olddir oldname newdir newname
+@deffnx {C Function} scm_renameat (olddir, oldname, newdir, newname)
+Like @code{rename-file}, but resolve @var{oldname} and @var{newname}
+relative to the directories referred to by the file ports @var{olddir}
+and @var{newdir} respectively.
+@end deffn
+
 @deffn {Scheme Procedure} link oldpath newpath
 @deffnx {C Function} scm_link (oldpath, newpath)
 Creates a new name @var{newpath} in the file system for the
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 2d0c619af..61a16f981 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1454,6 +1454,33 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_RENAMEAT
+SCM_DEFINE (scm_renameat, "rename-file-at", 4, 0, 0,
+            (SCM olddir, SCM oldname, SCM newdir, SCM newname),
+            "Like @code{rename-file}, but resolve @var{oldname} and @var{newname}\n"
+            "relative to the directories referred to by the file ports @var{olddir}\n"
+            "and @var{newdir} respectively.")
+#define FUNC_NAME s_scm_renameat
+{
+  int rv;
+  int old_fdes, new_fdes;
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir);
+  SCM_VALIDATE_OPFPORT (SCM_ARG3, newdir);
+
+  old_fdes = SCM_FPORT_FDES (olddir);
+  new_fdes = SCM_FPORT_FDES (newdir);
+
+  STRING2_SYSCALL (oldname, c_oldname,
+		   newname, c_newname,
+		   rv = renameat (old_fdes, c_oldname, new_fdes, c_newname));
+  scm_remember_upto_here_2 (olddir, newdir);
+  if (rv != 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
 
 SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, 
            (SCM str),
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f0dd35ede..7e17cc585 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -48,6 +48,7 @@ SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 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);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
 SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
-- 
2.30.2


[-- Attachment #1.10: 0009-Define-a-Scheme-binding-to-fchmodat-when-defined.patch --]
[-- Type: text/x-patch, Size: 10147 bytes --]

From e2ce6ad6d73f32bb630607abf6e90c0e51897db7 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 12 Mar 2021 13:20:45 +0100
Subject: [PATCH 09/17] Define a Scheme binding to fchmodat when defined.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

fchmodat on both regular files and symbolic links is known
to behave oddly when the flag AT_SYMLINK_NOFOLLOW is passed
on some Linux versions and file systems, and fchmodat is not
required by POSIX to function on symbolic links, so define a
few tests to make sure the situation is understood correctly.

* configure.ac: Detect existence of ‘fchmodat’.
* libguile/filesys.c (scm_chmodat): Define the Scheme binding.
* libguile/filesys.h (scm_chmodat): Make the binding part of the API.
* test-suite/tests/filesys.test: Test the Scheme binding, in particular
  whether ‘AT_SYMLINK_NOFOLLOW’ works as expected.
---
 configure.ac                  |   2 +-
 doc/ref/posix.texi            |  16 ++++++
 libguile/filesys.c            |  38 +++++++++++++
 libguile/filesys.h            |   1 +
 test-suite/tests/filesys.test | 104 ++++++++++++++++++++++++++++++++++
 5 files changed, 160 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index a2ad3364f..20357ce3b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat renameat getcwd geteuid getsid				\
+  symlinkat mkdirat renameat fchmodat getcwd geteuid getsid		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index a5dabf5e1..2bc067f74 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -829,6 +829,22 @@ the new permissions as a decimal number, e.g., @code{(chmod "foo" #o755)}.
 The return value is unspecified.
 @end deffn
 
+@findex fchmodat
+@deffn {Scheme Procedure} chmodat dir pathname mode [flags]
+@deffnx {C Function} scm_chmodat (dir, pathname, mode, flags)
+Like @var{chmod}, but modify the permissions of the file named
+@var{pathname} in the directory referred to by the file port
+@var{dir} instead.
+The optional @var{flags} argument may be 0 or @code{AT_SYMLINK_NOFOLLOW},
+in which case @var{pathname} is not dereferenced if it is a symbolic link,
+i.e., the permissions of the symbolic link itself are modified.
+
+Note that @code{AT_SYMLINK_NOFOLLOW} is not supported on all systems
+when @var{pathname} names a symbolic link and may result in @code{ENOTSUP}.
+Also, on some systems (e.g. GNU/Linux) using this flag for a regular file
+incorrectly results in @code{ENOTSUP}.
+@end deffn
+
 @deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]]
 @deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags)
 @code{utime} sets the access and modification times for the
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 61a16f981..52380cd20 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1588,6 +1588,44 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_FCHMODAT
+SCM_DEFINE (scm_chmodat, "chmodat", 3, 1, 0,
+            (SCM dir, SCM pathname, SCM mode, SCM flags),
+            "Like @var{chmod}, but modify the permissions of the file named\n"
+            "@var{pathname} in the directory referred to by the file port\n"
+            "@var{dir} instead.\n"
+            "The optional @var{flags} argument may be 0 or @code{AT_SYMLINK_NOFOLLOW},\n"
+            "in which case @var{pathname} is not dereferenced if it is a symbolic link,\n"
+            "i.e., the permissions of the symbolic link itself are modified.\n\n"
+            "Note that @code{AT_SYMLINK_NOFOLLOW} is not supported on all systems\n"
+            "when @var{pathname} names a symbolic link and may result in @code{ENOTSUP}.\n"
+            "Also, on some systems (e.g. GNU/Linux) using this flag for a regular file\n"
+            "incorrectly results in @code{ENOTSUP}.")
+#define FUNC_NAME s_scm_chmodat
+{
+  int rv;
+  int c_flags;
+  int dir_fdes;
+
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (pathname, c_pathname,
+                  rv = fchmodat (dir_fdes, c_pathname,
+                                 scm_to_int (mode), c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (rv == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 SCM_DEFINE (scm_umask, "umask", 0, 1, 0, 
             (SCM mode),
 	    "If @var{mode} is omitted, returns a decimal number representing the current\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 7e17cc585..377a3795e 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -40,6 +40,7 @@ SCM_API scm_t_bits scm_tc16_dir;
 
 SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
 SCM_API SCM scm_chmod (SCM object, SCM mode);
+SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
 SCM_API SCM scm_umask (SCM mode);
 SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6fed981e5..d85f51aac 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -265,3 +265,107 @@
                  (result   (eqv? 'directory (stat:type _stat))))
             (false-if-exception (rmdir name))
             result)))))
+
+;;;
+;;; chmodat
+;;;
+
+(with-test-prefix "chmodat"
+  (call-with-output-file (test-file) (const #f))
+  (chmod (test-file) #o000)
+
+  (pass-if-equal "regular file"
+      #o300
+    (unless (defined? 'chmodat)
+      (throw 'unsupported))
+    (let ((d (open "/" O_RDONLY)))
+      (chmodat d (test-file) #o300)
+      (let ((p (stat:perms (stat (test-file)))))
+        (close-port d)
+        p)))
+
+  (chmod (test-file) #o000)
+  (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW"
+      #o300
+    (unless (and (defined? 'chmodat)
+                 (defined? 'AT_SYMLINK_NOFOLLOW))
+      (throw 'unsupported))
+    (let ((dir (open "/" O_RDONLY)))
+      (catch 'system-error
+        (lambda ()
+          (chmodat dir (test-file) #o300 AT_SYMLINK_NOFOLLOW))
+        (lambda args
+          (close-port dir)
+          ;; AT_SYMLINK_NOFOLLOW is not supported on Linux (at least Linux 5.11.2
+          ;; with the btrfs file system), even for regular files.
+          (cond ((not (= ENOTSUP (system-error-errno args)))
+                 (apply throw args))
+                ((string-contains %host-type "linux")
+                 (display "warning: on this Linux version and file system, fchmodat incorrectly returns ENOTSUP even for regular files")
+                 (newline)
+                 (throw 'unresolved))
+                (#t (apply throw args)))))
+      (close-port dir)
+      (let ((p (stat:perms (stat (test-file)))))
+        (close-port dir)
+        p)))
+
+  (chmod (test-file) #o000)
+  (let* ((symlink-created
+          (not (false-if-exception
+	        (begin (symlink (test-file) (test-symlink)) #t))))
+         (has-required-procedures?
+          (and symlink-created (defined? 'chmodat) (defined? 'lstat))))
+
+    ;; Without AT_SYMLINK_NOFOLLOW, modify the file permissions
+    ;; of the file pointed at, and not the permissions of the
+    ;; symbolic link.
+    (pass-if "symbolic link"
+      (unless has-required-procedures?
+        (throw 'unsupported))
+      (let* ((old-perms (stat:perms (lstat (test-symlink))))
+             (dir (open "/" O_RDONLY)))
+        (chmodat dir (test-symlink) #o700)
+        (let ((ok (equal? (cons #o700 old-perms)
+                          (cons (stat:perms (stat (test-file)))
+                                (stat:perms (lstat (test-symlink)))))))
+          (close-port dir)
+          ok)))
+
+    (chmod (test-file) #o000)
+    ;; With AT_SYMLINK_NOFOLLOW, modify the file permissions
+    ;; of the symbolic link itself, instead of the file it points
+    ;; to -- unless this is not supported, of course.
+    (pass-if "symbolic link, AT_SYMLINK_NOFOLLOW"
+      (unless (and (defined? 'AT_SYMLINK_NOFOLLOW)
+                   has-required-procedures?)
+        (throw 'unsupported))
+      (let* ((old-perms (stat:perms (stat (test-file))))
+             (old-symlink-perms (stat:perms (lstat (test-symlink))))
+             (new-symlink-perms (logxor #o700 old-symlink-perms))
+             (dir (open "/" O_RDONLY)))
+        (catch 'system-error
+          (lambda ()
+            (chmodat dir (test-symlink) new-symlink-perms AT_SYMLINK_NOFOLLOW))
+          (lambda args
+            (close-port dir)
+            ;; AT_SYMLINK_NOFOLLOW is not supported on Linux (at least Linux 5.11.2
+            ;; with the btrfs file system).
+            (cond ((not (= ENOTSUP (system-error-errno args)))
+                   (apply throw args))
+                  ((and (= (stat:perms (stat (test-file))) old-perms)
+                        (= (stat:perms (lstat (test-symlink))) old-symlink-perms))
+                   (throw 'unresolved))
+                  ((string-contains %host-type "linux")
+                   (display "warning: on this Linux version and file system, fchmodat incorrectly returns ENOTSUP")
+                   (newline)
+                   (throw 'unresolved))
+                  (#t (apply throw args)))))
+        (close-port dir)
+        (equal? (pk 'p (cons old-perms new-symlink-perms))
+                (pk 'q (cons (stat:perms (stat (test-file)))
+                      (stat:perms (lstat (test-symlink))))))))))
+
+(delete-file (test-file))
+(when (file-exists? (test-symlink))
+  (delete-file (test-symlink)))
-- 
2.30.2


[-- Attachment #1.11: 0010-Define-delete-file-at-when-unlinkat-exists.patch --]
[-- Type: text/x-patch, Size: 5467 bytes --]

From 5c303d44bf094b777fb7d8eae5b4ce9cc00c597b Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 12 Mar 2021 15:10:23 +0100
Subject: [PATCH 10/17] Define delete-file-at when unlinkat exists.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

unlinkat is used for both unlinking regular files
and removing empty directories.

* configure.ac: Detect if unlinkat exists.
* doc/ref/posix.texi (File System): Document why there is no
  ‘rmdirat’ procedure, and document the ‘delete-file-at’ procedure.
* libguile/filesys.c
  (scm_rmdir): Adjust the docstring here as well.
  (scm_delete_file_at): Define a Scheme binding to ‘unlinkat’.
* libguile/filesys.h (scm_delete_file_at): Make ‘scm_delete_file_at’
  part of the C API.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi | 13 +++++++++++++
 libguile/filesys.c | 33 ++++++++++++++++++++++++++++++++-
 libguile/filesys.h |  1 +
 4 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index 20357ce3b..dea94a364 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat renameat fchmodat getcwd geteuid getsid		\
+  symlinkat mkdirat renameat fchmodat unlinkat getcwd geteuid getsid		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 2bc067f74..dcea0352a 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -878,6 +878,18 @@ Deletes (or ``unlinks'') the file whose path is specified by
 @var{str}.
 @end deffn
 
+@findex unlinkat
+@deffn {Scheme Procedure} delete-file-at dir str [flags]
+@deffnx {C Function} scm_delete_file_at (dir, str, flags)
+Like @code{unlink}, but resolve @var{str} relative to the
+directory referred to by the file port @var{dir} instead.
+
+The optional @var{flags} argument can be @code{AT_REMOVEDIR},
+in which case @code{delete-file-at} will act like @code{rmdir} instead
+of @code{delete-file}.  Why doesn't POSIX have a @code{rmdirat} function
+for this instead?  No idea!
+@end deffn
+
 @deffn {Scheme Procedure} copy-file oldfile newfile
 @deffnx {C Function} scm_copy_file (oldfile, newfile)
 Copy the file specified by @var{oldfile} to @var{newfile}.
@@ -968,6 +980,7 @@ referred to by the file port @var{dir} instead.
 @deffnx {C Function} scm_rmdir (path)
 Remove the existing directory named by @var{path}.  The directory must
 be empty for this to succeed.  The return value is unspecified.
+There is no @code{rmdirat} procedure; use @code{delete-file-at} instead.
 @end deffn
 
 @deffn {Scheme Procedure} opendir dirname
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 52380cd20..baa149a33 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1425,7 +1425,8 @@ SCM_DEFINE (scm_mkdirat, "mkdirat", 2, 1, 0,
 SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, 
             (SCM path),
 	    "Remove the existing directory named by @var{path}.  The directory must\n"
-	    "be empty for this to succeed.  The return value is unspecified.")
+	    "be empty for this to succeed.  The return value is unspecified.\n"
+	    "There is no @code{rmdirat} procedure, use @code{delete-file-at} instead.")
 #define FUNC_NAME s_scm_rmdir
 {
   int val;
@@ -1495,6 +1496,36 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_delete_file_at, "delete-file-at", 2, 1, 0,
+            (SCM dir, SCM str, SCM flags),
+            "Like @code{unlink}, but resolve @var{str} relative to the\n"
+            "directory referred to by the file port @var{dir} instead.\n\n"
+            "The optional @var{flags} argument can be @code{AT_REMOVEDIR},\n"
+            "in which case @code{delete-file-at} will act like @code{rmdir} instead\n"
+            "of @code{delete-file}.  Why doesn't POSIX have a @code{rmdirat} function\n"
+            "for this instead?  No idea!")
+#define FUNC_NAME s_scm_delete_file_at
+{
+  int ans;
+  int dir_fdes;
+  int c_flags;
+
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (str, c_str, ans = unlinkat (dir_fdes, c_str, c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (ans != 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_access, "access?", 2, 0, 0,
             (SCM path, SCM how),
 	    "Test accessibility of a file under the real UID and GID of the\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 377a3795e..37d084cd5 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -51,6 +51,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 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);
+SCM_API SCM scm_delete_file_at (SCM dir, SCM str, SCM flags);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
 SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
 SCM_API SCM scm_rmdir (SCM path);
-- 
2.30.2


[-- Attachment #1.12: 0011-Define-a-Scheme-binding-to-fchownat-when-available.patch --]
[-- Type: text/x-patch, Size: 4393 bytes --]

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

* configure.ac: Detect whether ‘fchownat’ is available.
* libguile/filesys.c (scm_chownat): Define a Scheme binding to
  ‘fchownat’ when available.
* libguile/filesys.h (scm_chownat): Make it part of the API.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac       |  3 ++-
 doc/ref/posix.texi | 11 +++++++++++
 libguile/filesys.c | 35 +++++++++++++++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index dea94a364..5f8389b82 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat renameat fchmodat unlinkat getcwd geteuid getsid		\
+  symlinkat mkdirat renameat fchmodat unlinkat fchownat			\
+  getcwd geteuid getsid	     	      	       				\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index dcea0352a..077ba8c79 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -817,6 +817,17 @@ unsupported at present).  If @var{owner} or @var{group} is specified
 as @code{-1}, then that ID is not changed.
 @end deffn
 
+@findex fchownat
+@deffn {Scheme Procedure} chownat dir name owner group [flags]
+@deffnx {C Function} scm_chownat (dir, name, owner, group, flags)
+Like @code{chown}, but modify the owner and/or group of
+the file named @var{name} in the directory referred to
+by the file port @var{dir} instead.  The optional argument
+@var{flags} is a bitmask.  If @code{AT_SYMLINK_NOFOLLOW} is
+present, then @var{name} will not be dereferenced if it is a
+symbolic link.
+@end deffn
+
 @findex fchmod
 @deffn {Scheme Procedure} chmod object mode
 @deffnx {C Function} scm_chmod (object, mode)
diff --git a/libguile/filesys.c b/libguile/filesys.c
index baa149a33..a319d9794 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -193,6 +193,41 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_CHOWN */
 
+#ifdef HAVE_FCHOWNAT
+SCM_DEFINE (scm_chownat, "chownat", 4, 1, 0,
+            (SCM dir, SCM name, SCM owner, SCM group, SCM flags),
+            "Like @code{chown}, but modify the owner and/or group of\n"
+            "the file named @var{name} in the directory referred to\n"
+            "by the file port @var{dir} instead.  The optional argument\n"
+            "@var{flags} is a bitmask.  If @code{AT_SYMLINK_NOFOLLOW} is\n"
+            "present, then @var{name} will not be dereferenced if it is a\n"
+            "symbolic link.")
+#define FUNC_NAME s_scm_chownat
+{
+  int rv;
+  int dir_fdes;
+  int c_flags;
+
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (name, c_name,
+                  rv = fchownat (dir_fdes, c_name,
+                                 scm_to_int (owner), scm_to_int (group),
+                                 c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (rv == -1)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_FCHOWNAT */
+
 \f
 
 SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 37d084cd5..7673c8051 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -39,6 +39,7 @@ SCM_API scm_t_bits scm_tc16_dir;
 \f
 
 SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
+SCM_API SCM scm_chownat (SCM dir, SCM object, SCM owner, SCM group, SCM flags);
 SCM_API SCM scm_chmod (SCM object, SCM mode);
 SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
 SCM_API SCM scm_umask (SCM mode);
-- 
2.30.2


[-- Attachment #1.13: 0012-Define-a-Scheme-binding-to-fstatat-when-available.patch --]
[-- Type: text/x-patch, Size: 5614 bytes --]

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

* configure.ac: Detect if ‘fstatat’ is defined.
* libguile/filesys.c (scm_statat): Define a Scheme binding to ‘fstatat’.
* libguile/filesys.h (scm_statat): Make it part of the C API.
* doc/ref/posix.texi (File System): Document it.
* libguile/syscalls.h (fstatat_or_fstatat64): Choose between ‘fstatat’
  and ‘fstatat64’.
---
 configure.ac        |  4 ++--
 doc/ref/posix.texi  | 12 ++++++++++++
 libguile/filesys.c  | 42 ++++++++++++++++++++++++++++++++++++++++++
 libguile/filesys.h  |  1 +
 libguile/syscalls.h |  1 +
 5 files changed, 58 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index 5f8389b82..22cdffdf8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,8 +482,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat renameat fchmodat unlinkat fchownat			\
-  getcwd geteuid getsid	     	      	       				\
+  symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat 	\
+  getcwd geteuid getsid	     	          	      	       		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 077ba8c79..b595fa44d 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -792,6 +792,18 @@ it will return information about a symbolic link itself, not the
 file it points to.  @var{path} must be a string.
 @end deffn
 
+@deffn {Scheme Procedure} statat dir filename [flags]
+@deffnx {C Function} scm_statat (dir, filename, flags)
+Similar to @code{stat}, but consider the file
+named @var{filename} in the directory referred to by the file
+port @var{dir} instead.
+
+The optional argument @var{flags} is a bitmask.  If it
+contains @code{AT_SYMLINK_NOFOLLOW}, @var{filename} will not be
+dereferenced even if it is a symbolic link, i.e., act as
+@code{lstat} instead of @code{stat}.
+@end deffn
+
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
 Return the value of the symbolic link named by @var{path} (a
diff --git a/libguile/filesys.c b/libguile/filesys.c
index a319d9794..454ce228e 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -637,6 +637,48 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_FSTATAT
+SCM_DEFINE (scm_statat, "statat", 2, 1, 0,
+            (SCM dir, SCM filename, SCM flags),
+            "Similar to @code{stat}, but consider the file named\n"
+            "@var{filename} in the directory referred to by the file\n"
+            "port @var{dir} instead.\n\n"
+            "The optional argument @var{flags} is a bitmask.  If it\n"
+            "contains @code{AT_SYMLINK_NOFOLLOW}, @var{filename} will not be\n"
+            "dereferenced even if it is a symbolic link, i.e., act as\n"
+            "@code{lstat} instead of @code{stat}.")
+#define FUNC_NAME s_scm_statat
+{
+  int rv;
+  int dir_fdes;
+  int c_flags;
+  struct stat_or_stat64 stat_temp;
+
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (filename, c_filename,
+                  rv = fstatat_or_fstatat64 (dir_fdes, c_filename,
+                                             &stat_temp, c_flags));
+  scm_remember_upto_here_1 (dir);
+
+  if (rv != 0)
+    {
+      int en = errno;
+      SCM_SYSERROR_MSG ("~A: ~S",
+                        scm_list_2 (scm_strerror (scm_from_int (en)), filename),
+                        en);
+    }
+  return scm_stat2scm (&stat_temp);
+}
+#undef FUNC_NAME
+#endif /* HAVE_FSTATAT */
+
 SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, 
             (SCM str),
 	    "Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 7673c8051..8af0f989a 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -48,6 +48,7 @@ SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_close (SCM fd_or_port);
 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_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
index 30b99c193..37d532e60 100644
--- a/libguile/syscalls.h
+++ b/libguile/syscalls.h
@@ -65,6 +65,7 @@
 # define readdir_r_or_readdir64_r       readdir_r
 #endif
 #define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
+#define fstatat_or_fstatat64            CHOOSE_LARGEFILE(fstatat,fstatat64)
 #define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
 #define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
 #define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
-- 
2.30.2


[-- Attachment #1.14: 0013-Define-a-Scheme-binding-to-openat-when-available.patch --]
[-- Type: text/x-patch, Size: 7355 bytes --]

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

* configure.ac: Detect if ‘openat’ is defined.
* libguile/filesys.c
  (scm_open_fdes_at, scm_openat): Define the Scheme bindings.
* libguile/filesys.h (scm_open_fdes_at, scm_openat): Make them part
  of the API.
* doc/ref/posix.texi (File System): Document them.
* libguile/syscalls.h (openat_or_openat64): Decide between ‘openat’
  and ‘openat64’.
---
 configure.ac        |  2 +-
 doc/ref/posix.texi  | 13 ++++++
 libguile/filesys.c  | 97 +++++++++++++++++++++++++++++++++++----------
 libguile/filesys.h  |  2 +
 libguile/syscalls.h |  1 +
 5 files changed, 93 insertions(+), 22 deletions(-)

diff --git a/configure.ac b/configure.ac
index 22cdffdf8..85a3a0dac 100644
--- a/configure.ac
+++ b/configure.ac
@@ -482,7 +482,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat		\
-  symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat 	\
+  symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat openat	\
   getcwd geteuid getsid	     	          	      	       		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index b595fa44d..29d9b8d28 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -333,12 +333,25 @@ See @xref{File Status Flags,,,libc,The GNU C Library Reference Manual}
 or @samp{man 3 strftime}, for additional flags and explanation.
 @end deffn
 
+@deffn {Scheme Procedure} openat dir path flags [mode]
+@deffnx {C Function} scm_openat (dir, path, flags, mode)
+Similar to @code{open}, but resolve the file name @var{path}
+relative to the directory referred to by the file port @var{dir}
+instead.
+@end deffn
+
 @deffn {Scheme Procedure} open-fdes path flags [mode]
 @deffnx {C Function} scm_open_fdes (path, flags, mode)
 Similar to @code{open} but return a file descriptor instead of
 a port.
 @end deffn
 
+@deffn {Scheme Procedure} open-fdes-at dir path flags [mode]
+@deffnx {C Function} scm_open_fdes_at (dir, path, flags, mode)
+Similar to @code{openat}, but return a file descriptor instead
+of a port.
+@end deffn
+
 @deffn {Scheme Procedure} close fd_or_port
 @deffnx {C Function} scm_close (fd_or_port)
 Similar to @code{close-port} (@pxref{Ports, close-port}),
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 454ce228e..d0566336a 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -249,6 +249,60 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_OPENAT
+SCM_DEFINE (scm_open_fdes_at, "open-fdes-at", 3, 1, 0,
+            (SCM dir, SCM path, SCM flags, SCM mode),
+            "Similar to @code{openat}, but return a file descriptor instead\n"
+            "of a port.\n")
+#define FUNC_NAME s_scm_open_fdes_at
+{
+  int dir_fdes;
+  int fd;
+  int iflags;
+  int imode;
+
+  iflags = SCM_NUM2INT (SCM_ARG2, flags);
+  imode = SCM_NUM2INT_DEF (3, mode, 0666);
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (path, c_path,
+                  fd = openat_or_openat64 (dir_fdes, c_path, iflags, imode));
+  scm_remember_upto_here_1 (dir);
+  if (fd == -1)
+    SCM_SYSERROR;
+  return scm_from_int (fd);
+}
+#undef FUNC_NAME
+#endif /* HAVE_OPENAT */
+
+/* A helper function for converting some open flags to
+   what scm_fdes_to_port expects. */
+static const char *
+flags_to_mode (int iflags)
+{
+  if ((iflags & O_RDWR) == O_RDWR)
+    {
+      /* Opened read-write.  */
+      if (iflags & O_APPEND)
+	return "a+";
+      else if (iflags & O_CREAT)
+	return "w+";
+      else
+	return "r+";
+    }
+  else
+    {
+      /* Opened read-only or write-only.  */
+      if (iflags & O_APPEND)
+	return "a";
+      else if (iflags & O_WRONLY)
+	return "w";
+      else
+	return "r";
+    }
+}
+
 SCM_DEFINE (scm_open, "open", 2, 1, 0, 
             (SCM path, SCM flags, SCM mode),
 	    "Open the file named by @var{path} for reading and/or writing.\n"
@@ -319,32 +373,33 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0,
 
   fd = scm_to_int (scm_open_fdes (path, flags, mode));
   iflags = SCM_NUM2INT (2, flags);
+  port_mode = (char *) flags_to_mode (iflags);
+  newpt = scm_fdes_to_port (fd, port_mode, path);
+  return newpt;
+}
+#undef FUNC_NAME
 
-  if ((iflags & O_RDWR) == O_RDWR)
-    {
-      /* Opened read-write.  */
-      if (iflags & O_APPEND)
-	port_mode = "a+";
-      else if (iflags & O_CREAT)
-	port_mode = "w+";
-      else
-	port_mode = "r+";
-    }
-  else
-    {
-      /* Opened read-only or write-only.  */
-      if (iflags & O_APPEND)
-	port_mode = "a";
-      else if (iflags & O_WRONLY)
-	port_mode = "w";
-      else
-	port_mode = "r";
-    }
+#ifdef HAVE_OPENAT
+SCM_DEFINE (scm_openat, "openat", 3, 1, 0,
+            (SCM dir, SCM path, SCM flags, SCM mode),
+            "Similar to @code{open}, but resolve the file name @var{path}\n"
+            "relative to the directory referred to by the file port @var{dir}\n"
+            "instead.")
+#define FUNC_NAME s_scm_openat
+{
+  SCM newpt;
+  char *port_mode;
+  int fd;
+  int iflags;
 
-  newpt = scm_fdes_to_port (fd, port_mode, path);
+  fd = scm_to_int (scm_open_fdes_at (dir, path, flags, mode));
+  iflags = SCM_NUM2INT (2, flags);
+  port_mode = (char *) flags_to_mode (iflags);
+  newpt = scm_fdes_to_port (fd, (char *) port_mode, path);
   return newpt;
 }
 #undef FUNC_NAME
+#endif /* HAVE_OPENAT */
 
 SCM_DEFINE (scm_close, "close", 1, 0, 0, 
             (SCM fd_or_port),
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 8af0f989a..1ce50d30e 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -44,7 +44,9 @@ SCM_API SCM scm_chmod (SCM object, SCM mode);
 SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
 SCM_API SCM scm_umask (SCM mode);
 SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
+SCM_API SCM scm_open_fdes_at (SCM dir, SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
+SCM_API SCM scm_openat (SCM dir, SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
index 37d532e60..6f4061138 100644
--- a/libguile/syscalls.h
+++ b/libguile/syscalls.h
@@ -58,6 +58,7 @@
 #define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
 #define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
 #define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
+#define openat_or_openat64              CHOOSE_LARGEFILE(openat,openat64)
 #define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
 #if SCM_HAVE_READDIR64_R == 1
 # define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
-- 
2.30.2


[-- Attachment #1.15: 0014-Define-a-Scheme-binding-to-readlinkat-when-it-exists.patch --]
[-- Type: text/x-patch, Size: 4839 bytes --]

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


[-- Attachment #1.16: 0015-Define-a-Scheme-binding-to-linkat-when-available.patch --]
[-- Type: text/x-patch, Size: 4557 bytes --]

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
+
 \f
 /* {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


[-- Attachment #1.17: 0016-Define-a-Scheme-binding-to-mknodat-when-supported.patch --]
[-- Type: text/x-patch, Size: 5998 bytes --]

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

* configure.ac: Detect if ‘mknodat’ exists.
* libguile/posix.texi
  (mknod, symbol_to_numeric_type): Split off common code with
  ‘mknodat’.
  (mknodat): Define the new Scheme binding.
* libguile/posix.h (scm_mknodat): Make it part of the C API.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac       |  2 +-
 doc/ref/posix.texi |  6 ++++
 libguile/posix.c   | 88 +++++++++++++++++++++++++++++++++-------------
 libguile/posix.h   |  1 +
 4 files changed, 72 insertions(+), 25 deletions(-)

diff --git a/configure.ac b/configure.ac
index 10320ce98..d5a8208f8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -483,7 +483,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid         \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat linkat	\
   symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat openat	\
-  getcwd geteuid getsid	     	          	      	       		\
+  mknodat getcwd geteuid getsid	          	      	       		\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid                            \
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index dbbf8cc7a..5844e271c 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1110,6 +1110,12 @@ E.g.,
 The return value is unspecified.
 @end deffn
 
+@deffn {Scheme Procedure} mknodat dir path type perms dev
+@deffnx {C Fuction} scm_mknodat (dir, path, type, perms, dev)
+Similar to @code{mknod}, but resolve @var{path} relative to
+@var{dir} instead.
+@end deffn
+
 @deffn {Scheme Procedure} tmpnam
 @deffnx {C Function} scm_tmpnam ()
 @cindex temporary file
diff --git a/libguile/posix.c b/libguile/posix.c
index 2ee459d2d..a74f87215 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1854,6 +1854,38 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SETLOCALE */
 
+#if defined(HAVE_MKNOD) || defined(HAVE_MKNODAT)
+/* Static helper function for converting symbols to their
+   corresponding S_* constants */
+static int
+symbol_to_numeric_type (const char *FUNC_NAME, int position, SCM type)
+{
+  const char *p;
+  p = scm_i_symbol_chars (type);
+  if (strcmp (p, "regular") == 0)
+    return S_IFREG;
+  else if (strcmp (p, "directory") == 0)
+    return S_IFDIR;
+#ifdef S_IFLNK
+  /* systems without symlinks probably don't have S_IFLNK defined */
+  else if (strcmp (p, "symlink") == 0)
+    return S_IFLNK;
+#endif
+  else if (strcmp (p, "block-special") == 0)
+    return S_IFBLK;
+  else if (strcmp (p, "char-special") == 0)
+    return S_IFCHR;
+  else if (strcmp (p, "fifo") == 0)
+    return S_IFIFO;
+#ifdef S_IFSOCK
+  else if (strcmp (p, "socket") == 0)
+    return S_IFSOCK;
+#endif
+  else
+    SCM_OUT_OF_RANGE (position, type);
+}
+#endif
+
 #ifdef HAVE_MKNOD
 SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
             (SCM path, SCM type, SCM perms, SCM dev),
@@ -1873,34 +1905,12 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
 #define FUNC_NAME s_scm_mknod
 {
   int val;
-  const char *p;
-  int ctype = 0;
+  int ctype;
 
   SCM_VALIDATE_STRING (1, path);
   SCM_VALIDATE_SYMBOL (2, type);
 
-  p = scm_i_symbol_chars (type);
-  if (strcmp (p, "regular") == 0)
-    ctype = S_IFREG;
-  else if (strcmp (p, "directory") == 0)
-    ctype = S_IFDIR;
-#ifdef S_IFLNK
-  /* systems without symlinks probably don't have S_IFLNK defined */
-  else if (strcmp (p, "symlink") == 0)
-    ctype = S_IFLNK;
-#endif
-  else if (strcmp (p, "block-special") == 0)
-    ctype = S_IFBLK;
-  else if (strcmp (p, "char-special") == 0)
-    ctype = S_IFCHR;
-  else if (strcmp (p, "fifo") == 0)
-    ctype = S_IFIFO;
-#ifdef S_IFSOCK
-  else if (strcmp (p, "socket") == 0)
-    ctype = S_IFSOCK;
-#endif
-  else
-    SCM_OUT_OF_RANGE (2, type);
+  ctype = symbol_to_numeric_type (FUNC_NAME, SCM_ARG2, type);
 
   STRING_SYSCALL (path, c_path,
 		  val = mknod (c_path,
@@ -1913,6 +1923,36 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_MKNOD */
 
+#ifdef HAVE_MKNODAT
+SCM_DEFINE (scm_mknodat, "mknodat", 5, 0, 0,
+            (SCM dir, SCM path, SCM type, SCM perms, SCM dev),
+            "Similar to @code{mknod}, but resolve @var{path} relative to\n"
+            "@var{dir} instead.")
+#define FUNC_NAME s_scm_mknodat
+{
+  int val;
+  int ctype;
+  int dir_fdes;
+
+  SCM_VALIDATE_STRING (2, path);
+  SCM_VALIDATE_SYMBOL (3, type);
+  SCM_VALIDATE_OPFPORT (1, dir);
+
+  dir_fdes = SCM_FPORT_FDES (dir);
+  ctype = symbol_to_numeric_type (FUNC_NAME, SCM_ARG3, type);
+
+  STRING_SYSCALL (path, c_path,
+		  val = mknodat (dir_fdes, c_path,
+                                 ctype | scm_to_int (perms),
+                                 scm_to_int (dev)));
+  scm_remember_upto_here_1 (dir);
+  if (val != 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MKNODAT */
+
 #ifdef HAVE_NICE
 SCM_DEFINE (scm_nice, "nice", 1, 0, 0, 
             (SCM incr),
diff --git a/libguile/posix.h b/libguile/posix.h
index ff3bec9ea..da82ae8eb 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -76,6 +76,7 @@ SCM_API SCM scm_getpid (void);
 SCM_API SCM scm_putenv (SCM str);
 SCM_API SCM scm_setlocale (SCM category, SCM locale);
 SCM_API SCM scm_mknod (SCM path, SCM type, SCM perms, SCM dev);
+SCM_API SCM scm_mknodat (SCM dir, SCM path, SCM type, SCM perms, SCM dev);
 SCM_API SCM scm_nice (SCM incr);
 SCM_API SCM scm_sync (void);
 SCM_API SCM scm_crypt (SCM key, SCM salt);
-- 
2.30.2


[-- Attachment #1.18: 0017-Document-recent-new-bindings-for-file-system-functio.patch --]
[-- Type: text/x-patch, Size: 1159 bytes --]

From e8d8b0ce279f0c1ba7243c4bd9ce3c88706a8656 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 12 Mar 2021 22:43:43 +0100
Subject: [PATCH 17/17] Document recent new bindings for file system functions.

* NEWS (New interfaces and functionality): Add some information
  on the new functionality of this patch series.
---
 NEWS | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/NEWS b/NEWS
index 3a5956bc3..95fca3b78 100644
--- a/NEWS
+++ b/NEWS
@@ -64,6 +64,17 @@ See "Bytevector Ports" in the manual.
 These include various open flags found on GNU/Linux, GNU/Hurd
 and BSD, on systems where they are supported.
 
+** Bindings to openat and other *at functions.
+
+See ‘File System’ in the manual.  The procedures are:
+mknodat, linkat, readlinkat, openat, statat, chownat,
+delete-file-at, renameat, chmodat, symlinkat and mkdirat.
+
+** More procedures accept file ports instead of only file names.
+
+See ‘File System’ in the manual.  The procedures are:
+chdir, readlink, utime.
+
 ** `(system foreign-library)' module
 
 See the newly reorganized "Foreign Function Interface", for details.
-- 
2.30.2


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

^ permalink raw reply related	[flat|nested] 26+ messages in thread

end of thread, other threads:[~2022-10-21 16:03 UTC | newest]

Thread overview: 26+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-03-12 21:59 [PATCH] Bindings to *at functions & allowing more functions to operate on ports Maxime Devos
2021-03-27 21:19 ` Maxime Devos
2021-03-28 11:17   ` tomas
2021-05-04 22:58     ` rob piko
2021-05-05 10:11       ` Maxime Devos
2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
2021-11-16 11:06   ` [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported Maxime Devos
2021-11-16 12:18     ` Maxime Devos
2021-11-16 17:10       ` Maxime Devos
2021-11-16 11:06   ` [PATCH v2 02/14] Allow file ports in ‘readlink’ Maxime Devos
2021-11-16 11:06   ` [PATCH v2 03/14] Allow file ports in ‘utime’ Maxime Devos
2021-11-16 11:06   ` [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported Maxime Devos
2021-11-16 11:06   ` [PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists Maxime Devos
2021-11-16 11:06   ` [PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask Maxime Devos
2021-11-16 11:06   ` [PATCH v2 07/14] Define AT_REMOVEDIR and others when available Maxime Devos
2021-11-16 11:06   ` [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists Maxime Devos
2021-11-16 11:06   ` [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ " Maxime Devos
2021-11-16 11:06   ` [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ " Maxime Devos
2021-11-16 11:06   ` [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ " Maxime Devos
2021-11-16 11:06   ` [PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available Maxime Devos
2021-11-16 11:06   ` [PATCH v2 13/14] Define Scheme bindings to ‘openat’ " Maxime Devos
2021-11-16 11:06   ` [PATCH v2 14/14] Update NEWS Maxime Devos
2021-11-16 12:16     ` Maxime Devos
2022-06-16  8:42   ` [PATCH v2 00/14] Bindings to *at functions Ludovic Courtès
2022-10-21 15:59     ` Ludovic Courtès
2022-10-21 16:03       ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).