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

* Re: [PATCH] Bindings to *at  functions & allowing more functions to operate on ports
  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-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
  1 sibling, 1 reply; 26+ messages in thread
From: Maxime Devos @ 2021-03-27 21:19 UTC (permalink / raw)
  Cc: Andy Wingo, Ludovic Courtès, guile-devel, Leo Famulari

[-- Attachment #1: Type: text/plain, Size: 2513 bytes --]

Hi,

[CC'ing some Guile and Guix maintainers because this is
important for the security of Guix System.]

I want to explain why these patches (and the O_FLAGS (*)
patch) should be included in Guile.  Functions like "openat"
are important to avoid TOCTTOU (time-of-check to time-of-use)
vulnerabilities involving symbolic links.

For example, suppose we have a web server implemented in
Guile.  Suppose the address is https://web.gnu.  It allows
a local user U (and some others) to define their own web
pages to host at http://web.gnu/~U, by writing files to
/home/U/www.  As there are multiple users, the server has
to run as root.

Now suppose U is the malicious kind of user.  Then $U
could create a symlink at /home/U/www/maliciousity pointing
to /home/other-user/.gnupg/private-keys-v1.d/FINGERPRINT.key.

Now U could download other-user's gpg key, for example
with "wget http://web.gnu/~U/maliciousity".  Oops!

How can this vulnerability be avoided?

* Use O_NOFOLLOW to *not* follow the symbolic link.
  Patch for adding O_NOFOLLOW to guile:
  <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=46220>.

And why do we need openat?  Well, suppose the web server
is not read-only, and supports (say) WebDAV or FTP for
modifying files remotely (I mean U can remotely modify
http://web.gnu/~U).  Then U could create a symlink
at /home/U/www/maliciousity pointing to /home/other-user.
Now U can peek into other-user's home directory and overwrite
files.  Oops!

How can the web server avoid this?

* First open "/home/U" as usual, resulting in a port $1.
  Then use (openat $1 "maliciousity" O_NOFOLLOW), resulting
  in a port $2.  Use (stat $2) to see if $2 is a directory
  or a regular file **and** to see if $2 is owned by $2!
  If necessary, recurse, etc.  Display a directory listing
  or display the file, etc.

How does this matter for Guix?

Guix has a TOCTTOU race:
<https://lists.gnu.org/archive/html/guix-devel/2021-01/msg00388.html>.
It has been partially fixed:
<https://git.savannah.gnu.org/cgit/guix.git/commit/?id=520bac7ed00a949a0391ad680de65a1498105c2b>.
However, a complete fix requires bindings to "openat".

I found another similar issue in Guix lately (not yet disclosed publicly).
While I think the conditions for this other potential security issue
to be exploitable don't ever happen in practice, I would still like
to fix this issue, and to be able to prevent similar issues from appearing
in the future.

Greetings,
Maxime.

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

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

* Re: [PATCH] Bindings to *at  functions & allowing more functions to operate on ports
  2021-03-27 21:19 ` Maxime Devos
@ 2021-03-28 11:17   ` tomas
  2021-05-04 22:58     ` rob piko
  0 siblings, 1 reply; 26+ messages in thread
From: tomas @ 2021-03-28 11:17 UTC (permalink / raw)
  To: Maxime Devos; +Cc: guile-devel

[-- Attachment #1: Type: text/plain, Size: 455 bytes --]

On Sat, Mar 27, 2021 at 10:19:20PM +0100, Maxime Devos wrote:
> Hi,
> 
> [CC'ing some Guile and Guix maintainers because this is
> important for the security of Guix System.]

[snipped CC, since my answer is just a thankyou]

> I want to explain why these patches (and the O_FLAGS (*)
> patch) should be included in Guile [...]

*THANK YOU*

This from someone striving to make Guile the "default tool for
around the house".

Cheers
 - t

[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 198 bytes --]

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

* Re: [PATCH] Bindings to *at functions & allowing more functions to operate on ports
  2021-03-28 11:17   ` tomas
@ 2021-05-04 22:58     ` rob piko
  2021-05-05 10:11       ` Maxime Devos
  0 siblings, 1 reply; 26+ messages in thread
From: rob piko @ 2021-05-04 22:58 UTC (permalink / raw)
  To: tomas; +Cc: Maxime Devos, guile-devel

[-- Attachment #1: Type: text/plain, Size: 1099 bytes --]

Hello Maxime,

> * Use O_NOFOLLOW to *not* follow the symbolic link.
>  Patch for adding O_NOFOLLOW to guile:

According to the man pages for the O_NOFOLLOW:

If the trailing component (i.e., basename) of *pathname* is
>               a symbolic link, then the open fails, with the error
>               *ELOOP*.  Symbolic links in earlier components of the
>               pathname will still be followed.
>
>
Sounds like O_NOFOLLOW would not fix the issue if the symlink is found in
other parts of the pathname outside of the basename?

Regards,
Kostyantyn Kovalskyy


On Sun, Mar 28, 2021 at 7:18 AM <tomas@tuxteam.de> wrote:

> On Sat, Mar 27, 2021 at 10:19:20PM +0100, Maxime Devos wrote:
> > Hi,
> >
> > [CC'ing some Guile and Guix maintainers because this is
> > important for the security of Guix System.]
>
> [snipped CC, since my answer is just a thankyou]
>
> > I want to explain why these patches (and the O_FLAGS (*)
> > patch) should be included in Guile [...]
>
> *THANK YOU*
>
> This from someone striving to make Guile the "default tool for
> around the house".
>
> Cheers
>  - t
>

[-- Attachment #2: Type: text/html, Size: 1772 bytes --]

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

* Re: [PATCH] Bindings to *at functions & allowing more functions to operate on ports
  2021-05-04 22:58     ` rob piko
@ 2021-05-05 10:11       ` Maxime Devos
  0 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-05-05 10:11 UTC (permalink / raw)
  To: rob piko, tomas; +Cc: guile-devel

[-- Attachment #1: Type: text/plain, Size: 1197 bytes --]

rob piko schreef op di 04-05-2021 om 18:58 [-0400]:
> Hello Maxime,
> 
> > * Use O_NOFOLLOW to *not* follow the symbolic link.
> >  Patch for adding O_NOFOLLOW to guile:
> 
> According to the man pages for the O_NOFOLLOW:
> 
> > If the trailing component (i.e., basename) of pathname is
> >               a symbolic link, then the open fails, with the error
> >               ELOOP.  Symbolic links in earlier components of the
> >               pathname will still be followed.
> 
> Sounds like O_NOFOLLOW would not fix the issue if the symlink is found in other parts of the pathname outside of the basename?
Indeed! To avoid *all* symlinks, and not only a symlink in the trailing component,
you would need to call 'open' with O_NOFOLLOW in a loop.

Something like:
  (let* ((dir (open "/symlinks/acceptable-here" O_RDONLY))
         ;; Symlinks are not followed here.
         (dir* (openat dir "dir" (logior O_RDONLY O_NOFOLLOW)))
         (file (openat dir* "file" (logior O_RDONLY O_NOFOLLOW))))
    (close dir)
    (close dir*)
    file)

It has been a while since I wrote the patch though, maybe the argument
order is a little different.

Greetings,
Maxime.

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

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

* [PATCH v2 00/14] Bindings to *at functions
  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-11-16 11:06 ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported Maxime Devos
                     ` (14 more replies)
  1 sibling, 15 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

This is a v2 of
https://lists.gnu.org/archive/html/guile-devel/2021-03/msg0026.html,
with a lot more tests, a few less functions and more consistent documentation.
‘rename-file-at’ has been modified to support #f as one of the two directory
arguments, denoting the current working directory.

Maxime Devos (14):
  Allow file ports in ‘chdir’ when supported.
  Allow file ports in ‘readlink’.
  Allow file ports in ‘utime’.
  Define ‘symlinkat’ wrapper when supported.
  Define bindings to ‘mkdirat’ when the C function exists.
  Correct documentation of ‘mkdir’ w.r.t. the umask.
  Define AT_REMOVEDIR and others when available.
  Define a Scheme binding to ‘renameat’ when it exists.
  Define a Scheme binding to ‘fchmodat’ when it exists.
  Define a Scheme binding to ‘unlinkat’ when it exists.
  Define a Scheme binding to ‘fchownat’ when it exists.
  Define a Scheme binding to ‘fstatat’ when available.
  Define Scheme bindings to ‘openat’ when available.
  Update NEWS.

 NEWS                          |  12 +
 configure.ac                  |   9 +-
 doc/ref/guile.texi            |   3 +-
 doc/ref/posix.texi            |  97 +++++-
 libguile/filesys.c            | 395 +++++++++++++++++++++++--
 libguile/filesys.h            |   9 +
 libguile/posix.c              |  34 ++-
 libguile/posix.h              |   2 +-
 libguile/syscalls.h           |   2 +
 test-suite/tests/filesys.test | 536 ++++++++++++++++++++++++++++++++++
 test-suite/tests/posix.test   |  71 ++++-
 11 files changed, 1120 insertions(+), 50 deletions(-)


base-commit: 6f1b620b829bc0a1852a43e9cb843fd719954a0f
-- 
2.30.2




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

* [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 12:18     ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 02/14] Allow file ports in ‘readlink’ Maxime Devos
                     ` (13 subsequent siblings)
  14 siblings, 1 reply; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* configure.ac: Check for ‘fchdir’.
* libguile/filesys.c
(scm_chdir): Support file ports.
(scm_init_filesys): Report support of file ports.
* doc/ref/posix.texi (Processes): Update accordingly.
* doc/ref/guile.texi: Add copyright line for new documentation in this
patch and later patches.
* test-suite/tests/filesys.test ("chdir"): Test it.
---
 configure.ac                  |  3 ++-
 doc/ref/guile.texi            |  3 ++-
 doc/ref/posix.texi            |  5 ++++-
 libguile/filesys.c            | 23 +++++++++++++++++++-
 test-suite/tests/filesys.test | 41 +++++++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 4 deletions(-)

diff --git a/configure.ac b/configure.ac
index bd49bf162..b7e4663f7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,7 +484,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/guile.texi b/doc/ref/guile.texi
index 660b1ae90..48af1f820 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -14,7 +14,8 @@
 This manual documents Guile version @value{VERSION}.
 
 Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation,
-Inc.
+Inc. \\
+Copyright (C) 2021 Maxime Devos
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 7633bd5a3..7555f9319 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2,6 +2,7 @@
 @c This is part of the GNU Guile Reference Manual.
 @c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
 @c   2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc.
+@c Copyright (C)  2021 Maxime Devos <maximedevos@telenet.be>
 @c See the file guile.texi for copying conditions.
 
 @node POSIX
@@ -1605,7 +1606,9 @@ The return value is unspecified.
 @deffn {Scheme Procedure} chdir str
 @deffnx {C Function} scm_chdir (str)
 @cindex current directory
-Change the current working directory to @var{str}.
+Change the current working directory to @var{str}.  @var{str} can be a
+string containing a file name, or a port if supported by the system.
+@code{(provided? 'chdir-port)} reports whether ports are supported.
 The return value is unspecified.
 @end deffn
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 6247734e8..2a9c36a12 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,5 +1,6 @@
 /* Copyright 1996-2002,2004,2006,2009-2019,2021
      Free Software Foundation, Inc.
+   Copyright 2021 Maxime Devos <maximedevos@telenet.be>
 
    This file is part of Guile.
 
@@ -621,12 +622,28 @@ 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 supported by the system.\n"
+            "@code{(provided? 'chdir-port)} reports whether ports "
+            "are supported."
 	    "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;
@@ -2066,5 +2083,9 @@ scm_init_filesys ()
 
   scm_dot_string = scm_from_utf8_string (".");
 
+#ifdef HAVE_FCHDIR
+  scm_add_feature("chdir-port");
+#endif
+
 #include "filesys.x"
 }
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6fed981e5..6b09a2ba0 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,7 @@
 ;;;; filesys.test --- test file system functions -*- scheme -*-
 ;;;; 
 ;;;; Copyright (C) 2004, 2006, 2013, 2019, 2021 Free Software Foundation, Inc.
+;;;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -265,3 +266,43 @@
                  (result   (eqv? 'directory (stat:type _stat))))
             (false-if-exception (rmdir name))
             result)))))
+
+(with-test-prefix "chdir"
+  (pass-if-equal "current directory" (getcwd)
+    (begin (chdir ".") (getcwd)))
+  (define file (search-path %load-path "ice-9/boot-9.scm"))
+
+
+  (pass-if-equal "test directory" (dirname file)
+    (let ((olddir (getcwd))
+          (dir #f))
+      (chdir (dirname file))
+      (set! dir (getcwd))
+      (chdir olddir)
+      dir))
+
+  (pass-if-equal "test directory, via port" (dirname file)
+    (unless (provided? 'chdir-port)
+      (throw 'unresolved))
+    (let ((olddir (getcwd))
+          (port (open (dirname file) O_RDONLY))
+          (dir #f))
+      (chdir port)
+      (set! dir (getcwd))
+      (chdir olddir)
+      dir))
+
+  (pass-if-exception "closed port"  exception:wrong-type-arg
+    (unless (provided? 'chdir-port)
+      (throw 'unresolved))
+    (let ((port (open (dirname file) O_RDONLY))
+          (olddir (getcwd)))
+      (close-port port)
+      (chdir port)
+      (chdir olddir))) ; should not be reached
+
+  (pass-if-exception "not a port or file name" exception:wrong-type-arg
+    (chdir '(stuff)))
+
+  (pass-if-exception "non-file port" exception:wrong-type-arg
+    (chdir (open-input-string ""))))
-- 
2.30.2




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

* [PATCH v2 02/14] Allow file ports in ‘readlink’.
  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 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 03/14] Allow file ports in ‘utime’ Maxime Devos
                     ` (12 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* configure.ac: Detect whether ‘readlinkat’ is defined.
* libguile/filesys.c (scm_readlink): Support file ports
  when ‘readlinkat’ exists.
  (scm_init_filesys): Provide ‘chdir-ports’ when it exists.
* doc/ref/posix.texi (File System): Document it.
* test-suite/tests/filesys.test ("readlink"): Test it.
---
 configure.ac                  |  2 +-
 doc/ref/posix.texi            |  9 ++++--
 libguile/filesys.c            | 52 +++++++++++++++++++++++------
 test-suite/tests/filesys.test | 61 +++++++++++++++++++++++++++++++++++
 4 files changed, 112 insertions(+), 12 deletions(-)

diff --git a/configure.ac b/configure.ac
index b7e4663f7..4888f880d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,7 +484,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 7555f9319..cd23240c4 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -757,8 +757,13 @@ file it points to.  @var{path} must be a string.
 
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
-Return the value of the symbolic link named by @var{path} (a
-string), i.e., the file that the link points to.
+Return the value of the symbolic link named by @var{path} (a string, or
+a port if supported by the system), i.e., the file that the link points
+to.
+
+To read a symbolic link represented by a port, the symbolic link must
+have been opened with the @code{O_NOFOLLOW} and @code{O_PATH} flags.
+@code{(provided? 'readlink-port)} reports whether ports are supported.
 @end deffn
 
 @findex fchown
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 2a9c36a12..c5bedec07 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1045,10 +1045,30 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYMLINK */
 
-SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, 
+/* Static helper function for choosing between readlink
+   and readlinkat. */
+static int
+do_readlink (int fd, const char *c_path, char *buf, size_t size)
+{
+#ifdef HAVE_READLINKAT
+  if (fd != -1)
+    return readlinkat (fd, c_path, buf, size);
+#else
+  (void) fd;
+#endif
+  return readlink (c_path, buf, size);
+}
+
+SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
             (SCM path),
-	    "Return the value of the symbolic link named by @var{path} (a\n"
-	    "string), i.e., the file that the link points to.")
+            "Return the value of the symbolic link named by @var{path} (a\n"
+            "string, or a port if supported by the system),\n"
+            "i.e., the file that the link points to.\n"
+            "To read a symbolic link represented by a port, the symbolic\n"
+            "link must have been opened with the @code{O_NOFOLLOW} and\n"
+            "@code{O_PATH} flags."
+            "@code{(provided? 'readlink-port)} reports whether ports are\n"
+            "supported.")
 #define FUNC_NAME s_scm_readlink
 {
   int rv;
@@ -1056,20 +1076,31 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   char *buf;
   SCM result;
   char *c_path;
-  
-  scm_dynwind_begin (0);
-
-  c_path = scm_to_locale_string (path);
-  scm_dynwind_free (c_path);
+  int fdes;
 
+  scm_dynwind_begin (0);
+#ifdef HAVE_READLINKAT
+  if (SCM_OPFPORTP (path))
+    {
+      c_path = "";
+      fdes = SCM_FPORT_FDES (path);
+    }
+  else
+#endif
+    {
+      fdes = -1;
+      c_path = scm_to_locale_string (path);
+      scm_dynwind_free (c_path);
+    }
   buf = scm_malloc (size);
 
-  while ((rv = readlink (c_path, buf, size)) == size)
+  while ((rv = do_readlink (fdes, c_path, buf, size)) == size)
     {
       free (buf);
       size *= 2;
       buf = scm_malloc (size);
     }
+  scm_remember_upto_here_1 (path);
   if (rv == -1)
     {
       int save_errno = errno;
@@ -2086,6 +2117,9 @@ scm_init_filesys ()
 #ifdef HAVE_FCHDIR
   scm_add_feature("chdir-port");
 #endif
+#ifdef HAVE_READLINKAT
+  scm_add_feature("readlink-port");
+#endif
 
 #include "filesys.x"
 }
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6b09a2ba0..7feb3492f 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -306,3 +306,64 @@
 
   (pass-if-exception "non-file port" exception:wrong-type-arg
     (chdir (open-input-string ""))))
+
+(with-test-prefix "readlink"
+  (false-if-exception (delete-file (test-symlink)))
+  (false-if-exception (delete-file (test-file)))
+  (call-with-output-file (test-file)
+    (lambda (port)
+      (display "hello" port)))
+  (if (not (false-if-exception
+	    (begin (symlink (test-file) (test-symlink)) #t)))
+      (display "cannot create symlink, some readlink tests skipped\n")
+      (let ()
+        (pass-if-equal "file name of symlink" (test-file)
+          (readlink (test-symlink)))
+
+        (pass-if-equal "port representing a symlink" (test-file)
+          (let ()
+            (unless (and (provided? 'readlink-port)
+                         (defined? 'O_NOFOLLOW)
+                         (defined? 'O_PATH)
+                         (not (= 0 O_NOFOLLOW))
+                         (not (= 0 O_PATH)))
+              (throw 'unsupported))
+            (define port (open (test-symlink) (logior O_NOFOLLOW O_PATH)))
+            (define points-to (false-if-exception (readlink port)))
+            (close-port port)
+            points-to))
+
+        (pass-if-exception "not a port or file name" exception:wrong-type-arg
+          (readlink '(stuff)))))
+
+  (pass-if-equal "port representing a regular file" EINVAL
+    (call-with-input-file (test-file)
+      (lambda (port)
+        (unless (provided? 'readlink-port)
+          (throw 'unsupported))
+        (catch 'system-error
+          (lambda ()
+            (readlink port)
+            (close-port port) ; should be unreachable
+            #f)
+          (lambda args
+            (close-port port)
+            ;; At least Linux 5.10.46 returns ENOENT instead of EINVAL.
+            ;; Possibly surprising, but it is documented in some man
+            ;; pages and it doesn't appear to be an accident:
+            ;; <https://elixir.bootlin.com/linux/v5.10.46/source/fs/stat.c#L419>.
+            (define error (system-error-errno args))
+            (if (= error ENOENT)
+                EINVAL
+                error))))))
+
+  (pass-if-exception "non-file port" exception:wrong-type-arg
+    (readlink (open-input-string "")))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+    (let ((port (open-file (test-file) "r")))
+      (close-port port)
+      (readlink port)))
+
+  (false-if-exception (delete-file (test-symlink)))
+  (false-if-exception (delete-file (test-file))))
-- 
2.30.2




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

* [PATCH v2 03/14] Allow file ports in ‘utime’.
  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 11:06   ` [PATCH v2 02/14] Allow file ports in ‘readlink’ Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported Maxime Devos
                     ` (11 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

Ports representing symbolic links are currently unsupported.

* configure.ac: Detect 'futimens'.
* doc/ref/posix.texi (utime): Update documentation.
* libguile/posix.c (scm_utime): Support ports.
* libguile/posix.h (scm_utime): Rename argument.
* test-suite/tests/posix.test ("utime"): Add more tests.
---
 configure.ac                |  4 +--
 doc/ref/posix.texi          | 15 +++++---
 libguile/posix.c            | 28 +++++++++++----
 libguile/posix.h            |  2 +-
 test-suite/tests/posix.test | 71 ++++++++++++++++++++++++++++++++++++-
 5 files changed, 106 insertions(+), 14 deletions(-)

diff --git a/configure.ac b/configure.ac
index 4888f880d..ddf330d96 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,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)
@@ -494,7 +494,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])
+  futimens sched_getaffinity sched_setaffinity sendfile])
 
 # 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 cd23240c4..b6deffd43 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -796,14 +796,16 @@ the new permissions as a decimal number, e.g., @code{(chmod "foo" #o755)}.
 The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]]
-@deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags)
+@deffn {Scheme Procedure} utime object [actime [modtime [actimens [modtimens [flags]]]]]
+@deffnx {C Function} scm_utime (object, 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{object}.  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.
 
+@var{object} must be a file name or a port (if supported by the system).
+
 The optional @var{actimens} and @var{modtimens} are nanoseconds
 to add @var{actime} and @var{modtime}. Nanosecond precision is
 only supported on some combinations of file systems and operating
@@ -817,9 +819,14 @@ 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.
+@var{object} even if it is a symbolic link.
 @end deffn
 
+On GNU/Linux systems, at least when using the Linux kernel 5.10.46,
+if @var{object} is a port, it may not be a symbolic link,
+even if @code{AT_SYMLINK_NOFOLLOW} is set.  This is either a bug
+in Linux or Guile's wrappers.  The exact cause is unclear.
+
 @findex unlink
 @deffn {Scheme Procedure} delete-file str
 @deffnx {C Function} scm_delete_file (str)
diff --git a/libguile/posix.c b/libguile/posix.c
index 3ab12b99e..bd7f40ca8 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,5 +1,6 @@
 /* Copyright 1995-2014,2016-2019,2021
      Free Software Foundation, Inc.
+   Copyright 2021 Maxime Devos <maximedevos@telenet.be>
 
    This file is part of Guile.
 
@@ -1648,13 +1649,14 @@ SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
-            (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens,
+            (SCM object, 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{object}.  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"
+            "@var{object} must be a file name or a port (if supported by the system).\n\n"
             "The optional @var{actimens} and @var{modtimens} are nanoseconds\n"
             "to add @var{actime} and @var{modtime}. Nanosecond precision is\n"
             "only supported on some combinations of file systems and operating\n"
@@ -1666,7 +1668,11 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
 	    "modification time to the current time.\n\n"
             "Last, @var{flags} may be either @code{0} or the\n"
             "@code{AT_SYMLINK_NOFOLLOW} constant, to set the time of\n"
-            "@var{pathname} even if it is a symbolic link.\n")
+            "@var{pathname} even if it is a symbolic link.\n\n"
+            "On GNU/Linux systems, at least when using the Linux kernel\n"
+            "5.10.46, if @var{object} is a port, it may not be a symbolic\n"
+            "link, even if @code{AT_SYMLINK_NOFOLLOW} is set.  This is either\n"
+            "a bug in Linux or Guile's wrappers.  The exact cause is unclear.")
 #define FUNC_NAME s_scm_utime
 {
   int rv;
@@ -1725,8 +1731,18 @@ 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));
+    if (SCM_OPFPORTP (object))
+      {
+        int fd;
+        fd = SCM_FPORT_FDES (object);
+        SCM_SYSCALL (rv = futimens (fd, times));
+        scm_remember_upto_here_1 (object);
+      }
+    else
+      {
+        STRING_SYSCALL (object, c_pathname,
+                        rv = utimensat (AT_FDCWD, c_pathname, times, f));
+      }
   }
 #else
   {
@@ -1740,7 +1756,7 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
     if (f != 0)
       scm_out_of_range(FUNC_NAME, flags);
 
-    STRING_SYSCALL (pathname, c_pathname,
+    STRING_SYSCALL (object, c_pathname,
                     rv = utime (c_pathname, &utm));
   }
 #endif
diff --git a/libguile/posix.h b/libguile/posix.h
index ff3bec9ea..dda8013a5 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -69,7 +69,7 @@ SCM_API SCM scm_tmpfile (void);
 SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
 SCM_API SCM scm_close_pipe (SCM port);
 SCM_API SCM scm_system_star (SCM cmds);
-SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime,
+SCM_API SCM scm_utime (SCM object, SCM actime, SCM modtime,
                        SCM actimens, SCM modtimens, SCM flags);
 SCM_API SCM scm_access (SCM path, SCM how);
 SCM_API SCM scm_getpid (void);
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 1e552d16f..8e32251b5 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -2,6 +2,7 @@
 ;;;;
 ;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021
 ;;;;   Free Software Foundation, Inc.
+;;;; Copyright 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -201,7 +202,75 @@
                 (list (stat:atime info) (stat:mtime info))))
             (lambda ()
               (delete-file file))))
-        (throw 'unsupported))))
+        (throw 'unsupported)))
+
+  (define (utime-unless-unsupported oops . arguments)
+    (catch 'system-error
+      (lambda ()
+        (catch 'wrong-type-arg
+          (lambda ()
+            (apply utime arguments))
+          (lambda _
+            ;; 'futimens' is not supported on all platforms.
+            (oops))))
+      (lambda args
+        ;; On some platforms, 'futimens' returns ENOSYS according to Gnulib.
+        (if (= (system-error-errno args) ENOSYS)
+            (oops)
+            (apply throw args)))))
+
+  (pass-if-equal "file port"
+      '(1 1)
+    (let ((file "posix.test-utime"))
+      (false-if-exception (delete-file file))
+      (close-port (open-output-file file))
+      (define (delete)
+        (delete-file file))
+      (define (oops)
+        (delete)
+        (throw 'unsupported))
+      (call-with-input-file file
+        (lambda (port)
+          (utime-unless-unsupported oops port 1 1 0 0)
+          (define info (stat file))
+          (delete)
+          (list (stat:atime info) (stat:mtime info))))))
+
+  ;; This causes an EBADF system error on GNU/Linux with the 5.10.46 kernel.
+  #;
+  (pass-if-equal "file port (port representing symbolic link)"
+      '(1 1)
+    (let ((file "posix.test-utime"))
+      (unless (false-if-exception
+               (begin (symlink "/should-be-irrelevant" file)
+                      #t))
+        (display "cannot create symlink, a utime test skipped\n")
+        (throw 'unresolved))
+      (unless (and (defined? 'O_NOFOLLOW)
+                   (defined? 'O_PATH)
+                   (not (= 0 O_NOFOLLOW))
+                   (not (= 0 O_PATH)))
+        (display "cannot open symlinks, a utime test skipped\n")
+        (throw 'unresolved))
+      (define (delete)
+        (when port (close-port port))
+        (false-if-exception (delete-file file)))
+      (define (oops)
+        (delete)
+        (throw 'unsupported))
+      (define port #f)
+      (catch #t
+        (lambda ()
+          (set! port
+            (open file (logior O_NOFOLLOW O_PATH)))
+          (utime-unless-unsupported oops port 1 1 0 0))
+        (lambda args
+          (pk 'deleting file)
+          (delete)
+          (apply throw args)))
+      (define info (lstat file))
+      (delete)
+      (list (stat:mtime info) (stat:atime info)))))
 
 ;;
 ;; affinity
-- 
2.30.2




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

* [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (2 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 03/14] Allow file ports in ‘utime’ Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists Maxime Devos
                     ` (10 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* configure.ac: Detect whether ‘symlinkat’ exists.
* libguile/filesys.c (scm_symlinkat): Define a Scheme binding
  when it exists.
* libguile/filesys.h: Make the binding part of the public C API.
* doc/ref/posix.texi (File System): Document the binding.
* test-suite/tests/filesys.test ("symlinkat"): Test it.
---
 configure.ac                  |  2 +-
 doc/ref/posix.texi            |  6 ++++++
 libguile/filesys.c            | 23 +++++++++++++++++++++++
 libguile/filesys.h            |  1 +
 test-suite/tests/filesys.test | 27 +++++++++++++++++++++++++++
 5 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index ddf330d96..b2e9ef3e9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,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 b6deffd43..a329eec39 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -891,6 +891,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 c5bedec07..bfd223434 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1045,6 +1045,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYMLINK */
 
+#ifdef HAVE_SYMLINKAT
+SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0,
+            (SCM dir, SCM oldpath, SCM newpath),
+            "Like @code{symlink}, but resolve @var{newpath} relative\n"
+            "to the directory referred to by the file port @var{dir}.")
+#define FUNC_NAME s_scm_symlinkat
+{
+  int val;
+  int fdes;
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  fdes = SCM_FPORT_FDES (dir);
+  STRING2_SYSCALL (oldpath, c_oldpath,
+		   newpath, c_newpath,
+		   val = symlinkat (c_oldpath, fdes, c_newpath));
+  scm_remember_upto_here_1 (dir);
+  if (val != 0)
+    SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SYMLINKAT */
+
 /* Static helper function for choosing between readlink
    and readlinkat. */
 static int
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a3b257c12..d181aca52 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
 SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value);
 SCM_API SCM scm_fsync (SCM object);
 SCM_API SCM scm_symlink (SCM oldpath, SCM newpath);
+SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath);
 SCM_API SCM scm_readlink (SCM path);
 SCM_API SCM scm_lstat (SCM str);
 SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 7feb3492f..64bf92333 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -367,3 +367,30 @@
 
   (false-if-exception (delete-file (test-symlink)))
   (false-if-exception (delete-file (test-file))))
+
+(with-test-prefix "symlinkat"
+  (pass-if-equal "create" (test-file)
+    (unless (defined? 'symlinkat)
+      (throw 'unsupported))
+    (call-with-port
+     (open "." O_RDONLY)
+     (lambda (port)
+       (symlinkat port (test-file) (test-symlink))
+       (readlink (test-symlink)))))
+  (false-if-exception (delete-file (test-symlink)))
+
+  (pass-if-exception "not a port" exception:wrong-type-arg
+    (unless (defined? 'symlinkat)
+      (throw 'unsupported))
+    (symlinkat "bogus" (test-file) (test-symlink)))
+
+  (pass-if-exception "not a file port" exception:wrong-type-arg
+    (unless (defined? 'symlinkat)
+      (throw 'unsupported))
+    (symlinkat (open-input-string "") (test-file) (test-symlink)))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+    (unless (defined? 'symlinkat)
+      (throw 'unsupported))
+    (symlinkat (call-with-port (open "." O_RDONLY) identity)
+               (test-file) (test-symlink))))
-- 
2.30.2




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

* [PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (3 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask Maxime Devos
                     ` (9 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* 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 +
 test-suite/tests/filesys.test | 38 +++++++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index b2e9ef3e9..da8dfadd0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,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 a329eec39..d261ac8da 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -906,6 +906,12 @@ Otherwise they are set to the value specified with @var{mode}.
 The return value is unspecified.
 @end deffn
 
+@deffn {Scheme Procedure} 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 bfd223434..ee01b2e2c 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1364,6 +1364,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);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 64bf92333..4ea62d513 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -29,6 +29,8 @@
   (data-file-name "filesys-test.tmp"))
 (define (test-symlink)
   (data-file-name "filesys-test-link.tmp"))
+(define (test-directory)
+  (data-file-name "filesys-test-dir.tmp"))
 
 
 ;;;
@@ -394,3 +396,39 @@
       (throw 'unsupported))
     (symlinkat (call-with-port (open "." O_RDONLY) identity)
                (test-file) (test-symlink))))
+
+(with-test-prefix "mkdirat"
+  (define (skip-if-unsupported)
+    (unless (defined? 'mkdirat)
+      (throw 'unsupported)))
+  (define (maybe-delete-directory)
+    (when (file-exists? (test-directory))
+      (rmdir (test-directory))))
+  (maybe-delete-directory)
+
+  (pass-if-equal "create" 'directory
+    (skip-if-unsupported)
+    (call-with-port
+     (open "." O_RDONLY)
+     (lambda (port)
+       (mkdirat port (test-directory))
+       (stat:type (stat (test-directory))))))
+  (maybe-delete-directory)
+
+  (pass-if-equal "explicit perms" (logand #o111 (lognot (umask)))
+    (skip-if-unsupported)
+    (call-with-port
+     (open "." O_RDONLY)
+     (lambda (port)
+       (mkdirat port (test-directory) #o111)
+       (stat:perms (stat (test-directory))))))
+  (maybe-delete-directory)
+
+  (pass-if-equal "create, implicit perms" (logand #o777 (lognot (umask)))
+    (skip-if-unsupported)
+    (call-with-port
+     (open "." O_RDONLY)
+     (lambda (port)
+       (mkdirat port (test-directory))
+       (stat:perms (stat (test-directory))))))
+  (maybe-delete-directory))
-- 
2.30.2




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

* [PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (4 preceding siblings ...)
  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   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 07/14] Define AT_REMOVEDIR and others when available Maxime Devos
                     ` (8 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* doc/ref/posix.texi (mkdir): Note that the umask is applied even if the
  mode argument is set.
---
 doc/ref/posix.texi | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index d261ac8da..7f136376b 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -902,7 +902,8 @@ the directory referred to by the file port @var{dir}.
 Create a new directory named by @var{path}.  If @var{mode} is omitted
 then the permissions of the directory are set to @code{#o777}
 masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
+Otherwise they are set to the value specified with @var{mode}
+masked with the current umask.
 The return value is unspecified.
 @end deffn
 
-- 
2.30.2




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

* [PATCH v2 07/14] Define AT_REMOVEDIR and others when available.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (5 preceding siblings ...)
  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   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists Maxime Devos
                     ` (7 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

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

diff --git a/libguile/posix.c b/libguile/posix.c
index bd7f40ca8..a6f7c9a0d 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -2503,6 +2503,12 @@ 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_EACCESS
+  scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
+#endif
 
 #include "cpp-SIG.c"
 #include "posix.x"
-- 
2.30.2




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

* [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (6 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 07/14] Define AT_REMOVEDIR and others when available Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ " Maxime Devos
                     ` (6 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* 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.
* test-suite/tests/filesys.test ("rename-file-at"): New tests.
---
 configure.ac                  |   2 +-
 doc/ref/posix.texi            |   9 +++
 libguile/filesys.c            |  34 +++++++++++
 libguile/filesys.h            |   1 +
 test-suite/tests/filesys.test | 104 ++++++++++++++++++++++++++++++++++
 5 files changed, 149 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index da8dfadd0..e67892feb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,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 7f136376b..ebb001581 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -877,6 +877,15 @@ 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 when @var{olddir} or @var{newdir} is true,
+resolve @var{oldname} or @var{newname} relative to the directory
+specified by the file port @var{olddir} or @var{newdir} instead of the
+current working directory.
+@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 ee01b2e2c..9c63beaa8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1421,6 +1421,40 @@ 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 when @var{olddir} or @var{newdir}\n"
+            "is true, resolve @var{oldname} or @var{newname} relative to\n"
+            "the directory specified by file port @var{olddir} or\n"
+            "@var{newdir} instead of the current working directory.")
+#define FUNC_NAME s_scm_renameat
+{
+  int rv;
+  int old_fdes, new_fdes;
+
+  old_fdes = AT_FDCWD;
+  new_fdes = AT_FDCWD;
+
+  if (scm_is_true (olddir)) {
+    SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir);
+    old_fdes = SCM_FPORT_FDES (olddir);
+  }
+  if (scm_is_true (newdir)) {
+    SCM_VALIDATE_OPFPORT (SCM_ARG3, newdir);
+    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);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 4ea62d513..bbce2c858 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -31,6 +31,8 @@
   (data-file-name "filesys-test-link.tmp"))
 (define (test-directory)
   (data-file-name "filesys-test-dir.tmp"))
+(define (test-directory2)
+  (data-file-name "filesys-test-dir2.tmp"))
 
 
 ;;;
@@ -432,3 +434,105 @@
        (mkdirat port (test-directory))
        (stat:perms (stat (test-directory))))))
   (maybe-delete-directory))
+
+(with-test-prefix "rename-file-at"
+  (define (skip-if-unsupported)
+    (unless (defined? 'rename-file-at)
+      (throw 'unsupported)))
+  (pass-if-equal "current working directory" '(#f "hello")
+    (skip-if-unsupported)
+    ;; Create a file in the test directory
+    (call-with-output-file "filesys-test-a.tmp"
+      (lambda (port) (display "hello" port)))
+    ;; Try to rename it
+    (rename-file-at #f "filesys-test-a.tmp" #f "filesys-test-b.tmp")
+    ;; Verify it exists under the new name, and not under the old name
+    (list (file-exists? "filesys-test-a.tmp")
+          (call-with-input-file "filesys-test-b.tmp" get-string-all)))
+
+  (false-if-exception (delete-file "filesys-test-a.tmp"))
+  (false-if-exception (delete-file "filesys-test-b.tmp"))
+
+  (pass-if-equal "two ports" '(#f "hello")
+    (skip-if-unsupported)
+    (mkdir (test-directory))
+    (mkdir (test-directory2))
+    ;; Create a file in the first directory
+    (call-with-output-file (in-vicinity (test-directory) "a")
+      (lambda (port) (display "hello" port)))
+    (let ((port1 (open (test-directory) O_RDONLY))
+          (port2 (open (test-directory2) O_RDONLY)))
+      ;; Try to rename it
+      (rename-file-at port1 "a" port2 "b")
+      (close-port port1)
+      (close-port port2)
+      ;; Verify it exists under the new name, and not under the old name
+      (list (file-exists? (in-vicinity (test-directory) "a"))
+            (call-with-input-file (in-vicinity (test-directory2) "b")
+              get-string-all))))
+  (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
+  (false-if-exception (delete-file (in-vicinity (test-directory2) "b")))
+  (false-if-exception (rmdir (test-directory)))
+  (false-if-exception (rmdir (test-directory2)))
+
+  (pass-if-equal "port and current working directory" '(#f "hello")
+    (skip-if-unsupported)
+    (mkdir (test-directory))
+    ;; Create a file in (test-directory)
+    (call-with-output-file (in-vicinity (test-directory) "a")
+      (lambda (port) (display "hello" port)))
+    (let ((port (open (test-directory) O_RDONLY)))
+      ;; Try to rename it
+      (rename-file-at port "a" #f (basename (test-file)))
+      (close-port port)
+      ;; Verify it exists under the new name, and not under the old name.
+      (list (file-exists? (in-vicinity (test-directory) "a"))
+            (call-with-input-file (test-file) get-string-all))))
+  (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
+  (false-if-exception (rmdir (test-directory)))
+  (false-if-exception (delete-file (test-file)))
+
+  (pass-if-equal "current working directory and port" '(#f "hello")
+    (skip-if-unsupported)
+    (mkdir (test-directory))
+    ;; Create a file in the working directory
+    (call-with-output-file (test-file)
+      (lambda (port) (display "hello" port)))
+    (let ((port (open (test-directory) O_RDONLY)))
+      ;; Try to rename it
+      (rename-file-at #f (basename (test-file)) port "b")
+      (close-port port)
+      ;; Verify it exists under the new name, and not under the old name.
+      (list (file-exists? (test-file))
+            (call-with-input-file (in-vicinity (test-directory) "b")
+              get-string-all))))
+
+  (false-if-exception (delete-file (in-vicinity (test-directory) "b")))
+  (false-if-exception (delete-file (test-file)))
+  (false-if-exception (rmdir (test-directory)))
+
+  (pass-if-exception "not a file port (1)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at (open-input-string "") "some" #f "thing"))
+
+  (pass-if-exception "not a file port (2)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at #f "some" (open-input-string "") "thing"))
+
+  (pass-if-exception "closed port (1)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at (call-with-port (open "." O_RDONLY) identity)
+                    "some" #f "thing"))
+
+  (pass-if-exception "closed port (2)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at #f "some" (call-with-port (open "." O_RDONLY) identity)
+                    "thing"))
+
+  (pass-if-exception "not a string (1)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at #f 'what #f "thing"))
+
+  (pass-if-exception "not a string (2)" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (rename-file-at #f "some" #f 'what)))
-- 
2.30.2




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

* [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (7 preceding siblings ...)
  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   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ " Maxime Devos
                     ` (5 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* configure.ac: Detect existence of fchmodat.
* libguile/filesys.c (scm_chmodat): New procedure.
* libguile/filesys.h (scm_chmodat): Make it part of the API.
* test-suite/tests/filesys.test ("chmodat"): Test it.
---
 configure.ac                  |  4 +--
 libguile/filesys.c            | 36 ++++++++++++++++++++++++
 libguile/filesys.h            |  1 +
 test-suite/tests/filesys.test | 53 +++++++++++++++++++++++++++++++++++
 4 files changed, 92 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index e67892feb..2a5485990 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,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, futimens - POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -485,7 +485,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				\
+  fchmodat 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/libguile/filesys.c b/libguile/filesys.c
index 9c63beaa8..4dd9c7b48 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1561,6 +1561,42 @@ 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"
+            "and may result 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 bbce2c858..204f3414c 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -271,6 +271,59 @@
             (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))
+    (call-with-port
+     (open (dirname (test-file)) O_RDONLY)
+     (lambda (port)
+       (chmodat port (test-file) #o300)))
+    (stat:perms (stat (test-file))))
+
+  (chmod (test-file) #o000)
+
+  (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW"
+      #o300
+    (unless (and (defined? 'chmodat)
+                 (defined? 'AT_SYMLINK_NOFOLLOW))
+      (throw 'unsupported))
+    (call-with-port
+     (open (dirname (test-file)) O_RDONLY)
+     (lambda (port)
+       (catch 'system-error
+         (lambda ()
+           (chmodat port (basename (test-file)) #o300 AT_SYMLINK_NOFOLLOW))
+         (lambda args
+           (close-port port)
+           ;; AT_SYMLINK_NOFOLLOW is not supported on Linux (at least Linux
+           ;; 5.11.2 with the btrfs file system), even for regular files.
+           (if (= ENOTSUP (system-error-errno args))
+               (begin
+                 (display "fchmodat doesn't support AT_SYMLINK_NOFOLLOW\n")
+                 (throw 'unresolved))
+               (apply throw args))))))
+    (stat:perms (stat (test-file))))
+
+  (pass-if-exception "not a port" exception:wrong-type-arg
+    (chmodat "bogus" (test-file) #o300))
+
+  (pass-if-exception "not a file port" exception:wrong-type-arg
+    (chmodat (open-input-string "") (test-file) #o300))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+    (chmodat (call-with-port (open "." O_RDONLY) identity) (test-file) #o300))
+
+  (delete-file (test-file)))
+
 (with-test-prefix "chdir"
   (pass-if-equal "current directory" (getcwd)
     (begin (chdir ".") (getcwd)))
-- 
2.30.2




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

* [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ when it exists.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (8 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ " Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ " Maxime Devos
                     ` (4 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

‘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                  |  5 +--
 doc/ref/posix.texi            | 12 +++++++
 libguile/filesys.c            | 32 +++++++++++++++++++
 libguile/filesys.h            |  1 +
 test-suite/tests/filesys.test | 59 +++++++++++++++++++++++++++++++++++
 5 files changed, 107 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index 2a5485990..e1c090321 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,8 @@ 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, futimens, fchmodat - POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
+#   unlinkat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -485,7 +486,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		\
-  fchmodat symlinkat mkdirat renameat getcwd geteuid getsid		\
+  fchmodat symlinkat mkdirat renameat 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 ebb001581..ad10585d9 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -834,6 +834,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}.
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 4dd9c7b48..7e6d89626 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1469,6 +1469,38 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_UNLINKAT
+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
+#endif
+
 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);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 204f3414c..33b68e16d 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -589,3 +589,62 @@
   (pass-if-exception "not a string (2)" exception:wrong-type-arg
     (skip-if-unsupported)
     (rename-file-at #f "some" #f 'what)))
+
+(with-test-prefix "delete-file-at"
+  (define (skip-if-unsupported)
+    (when (not (and (defined? 'delete-file-at)
+                    (defined? 'AT_REMOVEDIR)))
+      (throw 'unsupported)))
+  (define (create-test-file)
+    (call-with-output-file (test-file) identity))
+  (define (create-test-directory)
+    (mkdir (test-directory)))
+  (define (delete-test-file)
+    (when (file-exists? (test-file))
+      (delete-file (test-file))))
+  (define (delete-test-directory)
+    (when (file-exists? (test-directory))
+      (rmdir (test-directory))))
+
+  (pass-if-equal "regular file" #f
+    (skip-if-unsupported)
+    (create-test-file)
+    (call-with-port
+     (open (dirname (test-file)) O_RDONLY)
+     (lambda (port)
+       (delete-file-at port (basename (test-file)))))
+    (file-exists? (test-file)))
+  (delete-test-file)
+
+  (pass-if-equal "regular file, explicit flags" #f
+    (skip-if-unsupported)
+    (create-test-file)
+    (call-with-port
+     (open (dirname (test-file)) O_RDONLY)
+     (lambda (port)
+       (delete-file-at port (basename (test-file)) 0)))
+    (file-exists? (test-file)))
+  (delete-test-file)
+
+  (pass-if-equal "directory, explicit flags" #f
+    (skip-if-unsupported)
+    (create-test-directory)
+    (call-with-port
+     (open (dirname (test-directory)) O_RDONLY)
+     (lambda (port)
+       (delete-file-at port (basename (test-directory)) AT_REMOVEDIR)))
+    (file-exists? (test-directory)))
+  (delete-test-directory)
+
+  (pass-if-exception "not a port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (delete-file-at 'bogus "irrelevant"))
+
+  (pass-if-exception "not a file port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (delete-file-at (open-input-string "") "irrelevant"))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (delete-file-at (call-with-port (open "." O_RDONLY) identity)
+                    "irrelevant")))
-- 
2.30.2




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

* [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ when it exists.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (9 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ " Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available Maxime Devos
                     ` (3 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* 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       |  4 ++--
 doc/ref/posix.texi | 11 +++++++++++
 libguile/filesys.c | 35 +++++++++++++++++++++++++++++++++++
 libguile/filesys.h |  1 +
 4 files changed, 49 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index e1c090321..dcb6bceb5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,14 +478,14 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat - POSIX.1-2008
+#   unlinkat, fchownat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
 #   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 fchownat fchmod fchdir readlinkat	\
   fchmodat symlinkat mkdirat renameat unlinkat 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 ad10585d9..3d06f1c73 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -784,6 +784,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 7e6d89626..c257bb59c 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, "chown-at", 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




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

* [PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (10 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ " Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 13/14] Define Scheme bindings to ‘openat’ " Maxime Devos
                     ` (2 subsequent siblings)
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* 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            |  8 ++++
 libguile/filesys.c            | 39 +++++++++++++++++
 libguile/filesys.h            |  1 +
 libguile/syscalls.h           |  1 +
 test-suite/tests/filesys.test | 80 +++++++++++++++++++++++++++++++++++
 6 files changed, 131 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index dcb6bceb5..e073e04f4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,7 +478,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat, fchownat - POSIX.1-2008
+#   unlinkat, fchownat, fstatat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -495,7 +495,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     \
-  futimens sched_getaffinity sched_setaffinity sendfile])
+  fstatat futimens sched_getaffinity sched_setaffinity sendfile])
 
 # 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 3d06f1c73..cdd03f141 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -755,6 +755,14 @@ 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
+Like @code{stat}, but resolve @var{filename} relative to the directory
+referred to by the file port @var{dir} instead.  The optional argument
+@var{flags} argument can be @code{AT_SYMLINK_NOFOLLOW}, in which case
+@var{filename} will not be dereferenced even if it is a symbolic link.
+@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 string, or
diff --git a/libguile/filesys.c b/libguile/filesys.c
index c257bb59c..d045a672f 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -601,6 +601,45 @@ 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),
+            "Like @code{stat}, but resolve @var{filename} relative to the\n"
+            "directory referred to by the file port @var{dir} instead.\n\n"
+            "The optional argument @var{flags} argument can be\n"
+            "@code{AT_SYMLINK_NOFOLLOW}, in which case @var{filename} will\n"
+            "not be dereferenced even if it is a symbolic link.")
+#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)
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 33b68e16d..b794b07b3 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -134,6 +134,86 @@
 	(close-port port)
 	(eqv? 5 (stat:size st))))))
 
+(with-test-prefix "statat"
+  ;; file-exists? from (ice-9 boot) dereferences symbolic links
+  ;; (a bug?).
+  (define (file-exists? filename)
+    (catch 'system-error
+      (lambda () (lstat filename) #t)
+      (lambda args
+        (if (= (system-error-errno args) ENOENT)
+            ;; For the purposes of the following tests,
+            ;; it is safe to ignore errors like EPERM, but a correct
+            ;; implementation would return #t for that error.
+            #f
+            (apply throw  args)))))
+  (define (maybe-delete-directory)
+    (when (file-exists? (test-directory))
+      (for-each
+       (lambda (filename)
+         (define full-name (in-vicinity (test-directory) filename))
+         (when (file-exists? full-name)
+           (delete-file full-name)))
+       '("test-file" "test-symlink"))
+      (rmdir (test-directory))))
+  (define (skip-unless-defined . things)
+    (for-each (lambda (thing)
+                (unless (defined? thing)
+                  (throw 'unsupported)))
+              things))
+  (maybe-delete-directory)
+  (mkdir (test-directory))
+  (call-with-output-file (in-vicinity (test-directory) "test-file")
+    (lambda (port)
+      (display "hello" port)))
+
+  ;; Return #true if the symlink was created, #false otherwise.
+  (define (maybe-create-symlink)
+    (if (file-exists? (in-vicinity (test-directory) "test-symlink"))
+        #t
+        (false-if-exception
+         (symlink "test-file"
+                  (in-vicinity (test-directory) "test-symlink")))))
+
+  (pass-if-equal "regular file" 5
+    (skip-unless-defined 'statat)
+    (call-with-port
+     (open (test-directory) O_RDONLY)
+     (lambda (port)
+       (stat:size (statat port "test-file")))))
+
+  (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW" 5
+    (skip-unless-defined 'statat 'AT_SYMLINK_NOFOLLOW)
+    (call-with-port
+     (open (test-directory) O_RDONLY)
+     (lambda (port)
+       (stat:size (statat port "test-file" AT_SYMLINK_NOFOLLOW)))))
+
+  (pass-if-equal "symbolic links are dereferenced" '(regular 5)
+    ;; Not all systems support symlinks.
+    (skip-unless-defined 'statat 'symlink)
+    (unless (maybe-create-symlink)
+      (throw 'unresolved))
+    (call-with-port
+     (open (test-directory) O_RDONLY)
+     (lambda (port)
+       (define result (statat port "test-symlink"))
+       (list (stat:type result) (stat:size result)))))
+
+  (pass-if-equal "symbolic links are not dereferenced"
+      `(symlink ,(string-length "test-file"))
+    ;; Not all systems support symlinks.
+    (skip-unless-defined 'statat 'symlink)
+    (unless (maybe-create-symlink)
+      (throw 'unresolved))
+    (call-with-port
+     (open (test-directory) O_RDONLY)
+     (lambda (port)
+       (define result (statat port "test-symlink" AT_SYMLINK_NOFOLLOW))
+       (list (stat:type result) (stat:size result)))))
+
+  (maybe-delete-directory))
+
 (with-test-prefix "sendfile"
 
   (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
-- 
2.30.2




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

* [PATCH v2 13/14] Define Scheme bindings to ‘openat’ when available.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (11 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available Maxime Devos
@ 2021-11-16 11:06   ` Maxime Devos
  2021-11-16 11:06   ` [PATCH v2 14/14] Update NEWS Maxime Devos
  2022-06-16  8:42   ` [PATCH v2 00/14] Bindings to *at functions Ludovic Courtès
  14 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

* configure.ac: Detect if ‘openat’ is defined.
* libguile/filesys.c
  (flags_to_mode): Extract from ...
  (scm_mode): ... here.
  (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.
* test-suite/tests/filesys.test ("openat"): Test ‘openat’.
* libguile/syscalls.h (openat_or_openat64): Decide between ‘openat’
  and ‘openat64’.
---
 configure.ac                  |  3 +-
 doc/ref/posix.texi            | 13 +++++
 libguile/filesys.c            | 96 +++++++++++++++++++++++++++--------
 libguile/filesys.h            |  2 +
 libguile/syscalls.h           |  1 +
 test-suite/tests/filesys.test | 73 ++++++++++++++++++++++++++
 6 files changed, 167 insertions(+), 21 deletions(-)

diff --git a/configure.ac b/configure.ac
index e073e04f4..905e4d465 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,7 +478,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat, fchownat, fstatat - POSIX.1-2008
+#   unlinkat, fchownat, fstatat, openat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -495,6 +495,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     \
+  openat \
   fstatat futimens sched_getaffinity sched_setaffinity sendfile])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index cdd03f141..3619ee2c3 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -296,12 +296,25 @@ Create the file if it does not already exist.
 for additional flags.
 @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 d045a672f..dadbe3393 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.")
+#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 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"
@@ -285,31 +339,33 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0,
   fd = scm_to_int (scm_open_fdes (path, flags, mode));
   iflags = SCM_NUM2INT (2, flags);
 
-  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";
-    }
+  port_mode = (char *) flags_to_mode (iflags);
+  newpt = scm_fdes_to_port (fd, port_mode, path);
+  return newpt;
+}
+#undef FUNC_NAME
 
+#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;
+
+  iflags = SCM_NUM2INT (2, flags);
+  port_mode = (char *) flags_to_mode (iflags);
+  fd = scm_to_int (scm_open_fdes_at (dir, path, flags, mode));
   newpt = scm_fdes_to_port (fd, 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)
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index b794b07b3..45e77c823 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -728,3 +728,76 @@
     (skip-if-unsupported)
     (delete-file-at (call-with-port (open "." O_RDONLY) identity)
                     "irrelevant")))
+
+(with-test-prefix "openat"
+  (define (skip-if-unsupported)
+    (unless (defined? 'openat)
+      (throw 'unsupported)))
+
+  (define file (search-path %load-path "ice-9/boot-9.scm"))
+
+  (define (call-with-relatively-opened-file directory-arguments file-arguments
+                                            proc)
+    (call-with-port
+     (apply open directory-arguments)
+     (lambda (directory)
+       (call-with-port
+        (apply openat directory file-arguments)
+        (lambda (port)
+          (proc port))))))
+
+  (pass-if-equal "mode read-only" "r"
+    (skip-if-unsupported)
+    (call-with-relatively-opened-file
+     (list (dirname file) O_RDONLY)
+     (list (basename file) O_RDONLY)
+     (lambda (port) (port-mode port))))
+
+  (pass-if-equal "port-revealed count" 0
+    (skip-if-unsupported)
+    (call-with-relatively-opened-file
+     (list (dirname file) O_RDONLY)
+     (list (basename file) O_RDONLY)
+     (lambda (port) (port-revealed port))))
+
+  (when (file-exists? (test-file))
+    (delete-file (test-file)))
+
+  (pass-if-equal "O_CREAT/O_WRONLY" (list #t (logand (lognot (umask)) #o666) "w")
+    (skip-if-unsupported)
+    (call-with-relatively-opened-file
+     (list (dirname (test-file)) O_RDONLY)
+     (list (basename (test-file)) (logior O_WRONLY O_CREAT))
+     (lambda (port)
+       (list (file-exists? (test-file))
+             (stat:perms (stat (test-file)))
+             (port-mode port)))))
+
+  (when (file-exists? (test-file))
+    (delete-file (test-file)))
+
+  (pass-if-equal "O_CREAT/O_WRONLY, non-default mode"
+      (list #t (logand (lognot (umask)) #o700) "w")
+    (skip-if-unsupported)
+    (call-with-relatively-opened-file
+     (list (dirname (test-file)) O_RDONLY)
+     (list (basename (test-file)) (logior O_WRONLY O_CREAT) #o700)
+     (lambda (port)
+       (list (file-exists? (test-file))
+             (stat:perms (stat (test-file)))
+             (port-mode port)))))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (openat (call-with-port (open "." O_RDONLY) identity) "." O_RDONLY))
+
+  (pass-if-exception "non-file port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (openat (open-input-string "") "." O_RDONLY))
+
+  (pass-if-exception "not a port" exception:wrong-type-arg
+    (skip-if-unsupported)
+    (openat "not a port" "." O_RDONLY))
+
+  (when (file-exists? (test-file))
+    (delete-file (test-file))))
-- 
2.30.2




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

* [PATCH v2 14/14] Update NEWS.
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (12 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 13/14] Define Scheme bindings to ‘openat’ " Maxime Devos
@ 2021-11-16 11:06   ` 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
  14 siblings, 1 reply; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 11:06 UTC (permalink / raw)
  To: guile-devel; +Cc: Maxime Devos

---
 NEWS | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/NEWS b/NEWS
index 710b8ddda..922543a31 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,9 @@ Changes in 3.0.8 (since 3.0.7)
 ** Fix compilation of (ash x N), where N is a literal, at -O1 and below
 ** Texinfo and XML parsers are now thread-safe
    (<https://bugs.gnu.org/51264>)
+** Fix documentation of ‘mkdir’
+   Previously, the documentation implied the umask was ignored if the
+   mode was set explicitely.  However, this is not the case.
 
 * New deprecations
 
@@ -28,6 +31,15 @@ This function was undocumented.
 
 * New interfaces and functionality
 
+** Bindings to openat and friends
+
+The procedures `openat', `open-fdes-at', `statat', `chownat',
+`unlinkat', `chmodat', `renameat', `mkdirat' and `symlinkat' have been
+added.  They resolve file names relative to a directory passed as a file
+port.  The procedures `chdir' `readlink' and `utime' have been extended
+to support file ports.  The related flags `AT_REMOVEDIR' and
+`AT_EACCESS' have been added. See `File System' in the manual
+
 ** Typed vector copy functions
 
 The functions `u8vector-copy' `s8vector-copy' `u16vector-copy'
-- 
2.30.2




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

* Re: [PATCH v2 14/14] Update NEWS.
  2021-11-16 11:06   ` [PATCH v2 14/14] Update NEWS Maxime Devos
@ 2021-11-16 12:16     ` Maxime Devos
  0 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 12:16 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 362 bytes --]

Maxime Devos schreef op di 16-11-2021 om 11:06 [+0000]:
> [...]
> +** Fix documentation of ‘mkdir’
> +   Previously, the documentation implied the umask was ignored if
> the
> +   mode was set explicitely.  However, this is not the case.

As noted by Thien-Thi Nguyen, the spelling is ‘explicitly’, not
‘explicitely’. Revised patch is attached.

[-- Attachment #2: 0001-Update-NEWS.patch --]
[-- Type: text/x-patch, Size: 1373 bytes --]

From 6aa21f7287f98c9a79fa7014688f3cfdf1803422 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 15 Nov 2021 21:17:10 +0000
Subject: [PATCH] Update NEWS.

---
 NEWS | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/NEWS b/NEWS
index 710b8ddda..298dbaabb 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,9 @@ Changes in 3.0.8 (since 3.0.7)
 ** Fix compilation of (ash x N), where N is a literal, at -O1 and below
 ** Texinfo and XML parsers are now thread-safe
    (<https://bugs.gnu.org/51264>)
+** Fix documentation of ‘mkdir’
+   Previously, the documentation implied the umask was ignored if the
+   mode was set explicitly.  However, this is not the case.
 
 * New deprecations
 
@@ -28,6 +31,15 @@ This function was undocumented.
 
 * New interfaces and functionality
 
+** Bindings to openat and friends
+
+The procedures `openat', `open-fdes-at', `statat', `chownat',
+`unlinkat', `chmodat', `renameat', `mkdirat' and `symlinkat' have been
+added.  They resolve file names relative to a directory passed as a file
+port.  The procedures `chdir' `readlink' and `utime' have been extended
+to support file ports.  The related flags `AT_REMOVEDIR' and
+`AT_EACCESS' have been added. See `File System' in the manual
+
 ** Typed vector copy functions
 
 The functions `u8vector-copy' `s8vector-copy' `u16vector-copy'
-- 
2.30.2


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

* Re: [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.
  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
  0 siblings, 1 reply; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 12:18 UTC (permalink / raw)
  To: guile-devel

Maxime Devos schreef op di 16-11-2021 om 11:06 [+0000]:
>  Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software
> Foundation,
> -Inc.
> +Inc. \\
> +Copyright (C) 2021 Maxime Devos


\\ doesn't work. I'll try something else




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

* Re: [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.
  2021-11-16 12:18     ` Maxime Devos
@ 2021-11-16 17:10       ` Maxime Devos
  0 siblings, 0 replies; 26+ messages in thread
From: Maxime Devos @ 2021-11-16 17:10 UTC (permalink / raw)
  To: guile-devel

Maxime Devos schreef op di 16-11-2021 om 12:18 [+0000]:
> Maxime Devos schreef op di 16-11-2021 om 11:06 [+0000]:
> >  Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software
> > Foundation,
> > -Inc.
> > +Inc. \\
> > +Copyright (C) 2021 Maxime Devos
> 
> 
> \\ doesn't work. I'll try something else

@* instead of \\ appears to work. (to put it in a separate line, but
not a separate paragraph).




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

* Re: [PATCH v2 00/14] Bindings to *at functions
  2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
                     ` (13 preceding siblings ...)
  2021-11-16 11:06   ` [PATCH v2 14/14] Update NEWS Maxime Devos
@ 2022-06-16  8:42   ` Ludovic Courtès
  2022-10-21 15:59     ` Ludovic Courtès
  14 siblings, 1 reply; 26+ messages in thread
From: Ludovic Courtès @ 2022-06-16  8:42 UTC (permalink / raw)
  To: Maxime Devos; +Cc: guile-devel

Hi Maxime,

First, apologies for the embarrassingly-long silence…

Maxime Devos <maximedevos@telenet.be> skribis:

> This is a v2 of
> https://lists.gnu.org/archive/html/guile-devel/2021-03/msg0026.html,
> with a lot more tests, a few less functions and more consistent documentation.
> ‘rename-file-at’ has been modified to support #f as one of the two directory
> arguments, denoting the current working directory.
>
> Maxime Devos (14):
>   Allow file ports in ‘chdir’ when supported.
>   Allow file ports in ‘readlink’.
>   Allow file ports in ‘utime’.
>   Define ‘symlinkat’ wrapper when supported.
>   Define bindings to ‘mkdirat’ when the C function exists.
>   Correct documentation of ‘mkdir’ w.r.t. the umask.
>   Define AT_REMOVEDIR and others when available.
>   Define a Scheme binding to ‘renameat’ when it exists.
>   Define a Scheme binding to ‘fchmodat’ when it exists.
>   Define a Scheme binding to ‘unlinkat’ when it exists.
>   Define a Scheme binding to ‘fchownat’ when it exists.
>   Define a Scheme binding to ‘fstatat’ when available.
>   Define Scheme bindings to ‘openat’ when available.
>   Update NEWS.

I applied the whole series locally, skimmed over the patches, ran the
tests, and it all LGTM.

I think the strategy to accept a string or a port where applicable
(utime, readlink) makes sense and is consistent with existing
interfaces; the new *at procedures look fine as well (there’s a naming
scheme discrepancy with ‘rename-file-at’ and ‘delete-file-at’, but I
think it’s fine: it’s just an evolution of the discrepancy that was
already there with ‘delete-file’ and ‘rename-file’.)

Copyright for Guile code is assigned to the FSF.  I’d like to offer you
to do the same if that’s an option for you (I’ll send you the details
off-list.)  This would add another delay, but hopefully a short one.

Thank you!

Ludo’.



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

* Re: [PATCH v2 00/14] Bindings to *at functions
  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
  0 siblings, 1 reply; 26+ messages in thread
From: Ludovic Courtès @ 2022-10-21 15:59 UTC (permalink / raw)
  To: Maxime Devos; +Cc: guile-devel

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> Maxime Devos <maximedevos@telenet.be> skribis:
>
>> This is a v2 of
>> https://lists.gnu.org/archive/html/guile-devel/2021-03/msg0026.html,
>> with a lot more tests, a few less functions and more consistent documentation.
>> ‘rename-file-at’ has been modified to support #f as one of the two directory
>> arguments, denoting the current working directory.
>>
>> Maxime Devos (14):
>>   Allow file ports in ‘chdir’ when supported.
>>   Allow file ports in ‘readlink’.
>>   Allow file ports in ‘utime’.
>>   Define ‘symlinkat’ wrapper when supported.
>>   Define bindings to ‘mkdirat’ when the C function exists.
>>   Correct documentation of ‘mkdir’ w.r.t. the umask.
>>   Define AT_REMOVEDIR and others when available.
>>   Define a Scheme binding to ‘renameat’ when it exists.
>>   Define a Scheme binding to ‘fchmodat’ when it exists.
>>   Define a Scheme binding to ‘unlinkat’ when it exists.
>>   Define a Scheme binding to ‘fchownat’ when it exists.
>>   Define a Scheme binding to ‘fstatat’ when available.
>>   Define Scheme bindings to ‘openat’ when available.
>>   Update NEWS.
>
> I applied the whole series locally, skimmed over the patches, ran the
> tests, and it all LGTM.

And this is finally pushed as commit
793fb46a1e69fa2156805e4a97b340cf62e096a6!  \o/

I erroneously pushed a variant without copyright lines for yourself.  If
you confirm that you are the copyright holder, I’ll just readd them as
you had done.

If you choose to pursue your copyright assignment process despite the
delays and stumbling blocks, we can drop those lines again.

Thanks!

Ludo’.



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

* Re: [PATCH v2 00/14] Bindings to *at functions
  2022-10-21 15:59     ` Ludovic Courtès
@ 2022-10-21 16:03       ` Ludovic Courtès
  0 siblings, 0 replies; 26+ messages in thread
From: Ludovic Courtès @ 2022-10-21 16:03 UTC (permalink / raw)
  To: Maxime Devos; +Cc: guile-devel

Ludovic Courtès <ludo@gnu.org> skribis:

> I erroneously pushed a variant without copyright lines for yourself.  If
> you confirm that you are the copyright holder, I’ll just readd them as
> you had done.

Actually no, this is all fine.  I guess I just need some rest.  :-)

Ludo’.



^ permalink raw reply	[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).