From: Maxime Devos <maximedevos@telenet.be>
Cc: guile-devel@gnu.org
Subject: [PATCH] Bindings to *at functions & allowing more functions to operate on ports
Date: Fri, 12 Mar 2021 22:59:11 +0100 [thread overview]
Message-ID: <175c3a6572e832d84927937b309a3095cadf5702.camel@telenet.be> (raw)
[-- 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 --]
next reply other threads:[~2021-03-12 21:59 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-12 21:59 Maxime Devos [this message]
2021-03-27 21:19 ` [PATCH] Bindings to *at functions & allowing more functions to operate on ports 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=175c3a6572e832d84927937b309a3095cadf5702.camel@telenet.be \
--to=maximedevos@telenet.be \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).