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
From e4deaca45606a9ade686e7cf447c9cec93e8c9e2 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From af8c3fdfad9343dec8b44dedfb05da9c99cc8269 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 2fb0446d5b4f410608adcfe3297338bdeef23abe Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 021567541a2685b6b7467d08188c51cd22368374 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 83e4862a1d9a023f1c2a19a1938d761cb020d6d8 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 68f62489c75c8449bd6bdf8fa3c8aacbf19cc33f Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From f2e681ec9562cd23f0cfaba7edd3702aafb673b6 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From cf9308cb74fee4f4401cf06a8701318f885a6bd3 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From e2ce6ad6d73f32bb630607abf6e90c0e51897db7 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 5c303d44bf094b777fb7d8eae5b4ce9cc00c597b Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 1e322e6298ebed31e982bb4ad3a4132f8e7b2036 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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 */ + 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; 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
From b761434c6b7be1c6bcbe6eb0a179b7fb897272cc Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From bb3ff1b5fff3c759c7ec4c0d5c9b10060396b055 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 1d152d7fcc4fbf3c6b4492bed8aaf9502ffae778 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From 8b68e99cddf68e77a64f8179dbd3e8b4e3f1ef2b Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@telenet.be> Date: Fri, 12 Mar 2021 22:01:53 +0100 Subject: [PATCH 15/17] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= =?UTF-8?q?=E2=80=98linkat=E2=80=99=20when=20available.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: Detect if ‘linkat’ is available. * libguile/filesys.c (scm_linkat): Define the Scheme binding. * libguile/filesys.h (scm_linkat): Make it part of the C API. * doc/ref/posix.texi (File System): Document it. --- configure.ac | 2 +- doc/ref/posix.texi | 11 +++++++++++ libguile/filesys.c | 38 ++++++++++++++++++++++++++++++++++++++ libguile/filesys.h | 1 + 4 files changed, 51 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 85a3a0dac..10320ce98 100644 --- a/configure.ac +++ b/configure.ac @@ -481,7 +481,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # sendfile - non-POSIX, found in glibc # AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ - fesetround ftime ftruncate fchown fchmod fchdir readlinkat \ + fesetround ftime ftruncate fchown fchmod fchdir readlinkat linkat \ symlinkat mkdirat renameat fchmodat unlinkat fchownat fstatat openat \ getcwd geteuid getsid \ gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 58dcaec01..dbbf8cc7a 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -992,6 +992,17 @@ link, the link may or may not be followed depending on the system. @end deffn +@deffn {Scheme Procedure} linkat olddir oldpath newdir newpath [flags] +@deffnx {C Function} scm_linkat (olddir, oldpath, newdir, newpath, flags) +Like @code{link}, but resolve @var{oldpath} relative to +the directory referred to by the file port @var{olddir} +and @var{newpath} relative to @var{newdir} instead. + +The optional argument @var{flags} is a bitmask. If it contains +@code{AT_SYMLINK_FOLLOW}, then @var{oldpath} will be dereferenced +if it is a symbolic link. +@end deffn + @deffn {Scheme Procedure} symlink oldpath newpath @deffnx {C Function} scm_symlink (oldpath, newpath) Create a symbolic link named @var{newpath} with the value (i.e., pointing to) diff --git a/libguile/filesys.c b/libguile/filesys.c index ecea49822..f010397bd 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -782,6 +782,44 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, } #undef FUNC_NAME +#ifdef HAVE_LINKAT +SCM_DEFINE (scm_linkat, "linkat", 4, 1, 0, + (SCM olddir, SCM oldpath, SCM newdir, SCM newpath, SCM flags), + "Like @code{link}, but resolve @var{oldpath} relative to\n" + "the directory referred to by the file port @var{olddir}\n" + "and @var{newpath} relative to @var{newdir} instead.\n\n" + "The optional argument @var{flags} is a bitmask. If it contains\n" + "@code{AT_SYMLINK_FOLLOW}, then @var{oldpath} will be dereferenced\n" + "if it is a symbolic link.") +#define FUNC_NAME s_scm_linkat +{ + int val; + int c_flags; + int olddir_fdes, newdir_fdes; + + if (SCM_UNBNDP (flags)) + c_flags = 0; + else + c_flags = scm_to_int (flags); + + SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir); + SCM_VALIDATE_OPFPORT (SCM_ARG2, newdir); + olddir_fdes = SCM_FPORT_FDES (olddir); + newdir_fdes = SCM_FPORT_FDES (newdir); + + STRING2_SYSCALL (oldpath, c_oldpath, + newpath, c_newpath, + val = linkat (olddir_fdes, c_oldpath, + newdir_fdes, c_newpath, + c_flags)); + scm_remember_upto_here_2 (olddir, newdir); + if (val != 0) + SCM_SYSERROR; + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif + /* {Navigating Directories} */ diff --git a/libguile/filesys.h b/libguile/filesys.h index 65a3c5b75..16eab6d4e 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -52,6 +52,7 @@ SCM_API SCM scm_close_fdes (SCM fd); SCM_API SCM scm_stat (SCM object, SCM exception_on_error); SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags); SCM_API SCM scm_link (SCM oldpath, SCM newpath); +SCM_API SCM scm_linkat (SCM olddir, SCM oldpath, SCM newdir, SCM newpath, SCM flags); SCM_API SCM scm_rename (SCM oldname, SCM newname); SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname); SCM_API SCM scm_delete_file (SCM str); -- 2.30.2
From 239396557cd0f428ef803bb034ed1ec4db0cf887 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
From e8d8b0ce279f0c1ba7243c4bd9ce3c88706a8656 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximede...@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
signature.asc
Description: This is a digitally signed message part