1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
| | Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
From: Maxime Devos <maximedevos@telenet.be>
Subject: [PATCH v2 04/14] =?UTF-8?q?Define=20=E2=80=98symlinkat=E2=80=99?=
=?UTF-8?q?=20wrapper=20when=20supported.?=
Date: Tue, 16 Nov 2021 11:06:27 +0000
Message-Id: <20211116110637.125579-5-maximedevos@telenet.be>
In-Reply-To: <20211116110637.125579-1-maximedevos@telenet.be>
References: <175c3a6572e832d84927937b309a3095cadf5702.camel@telenet.be>
<20211116110637.125579-1-maximedevos@telenet.be>
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.
* test-suite/tests/filesys.test ("symlinkat"): Test it.
---
configure.ac | 2 +-
doc/ref/posix.texi | 6 ++++++
libguile/filesys.c | 23 +++++++++++++++++++++++
libguile/filesys.h | 1 +
test-suite/tests/filesys.test | 27 +++++++++++++++++++++++++++
5 files changed, 58 insertions(+), 1 deletion(-)
diff --git a/configure.ac b/configure.ac
index ddf330d96..b2e9ef3e9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
- getcwd geteuid getsid \
+ symlinkat getcwd geteuid getsid \
gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
nice readlink rename rmdir setegid seteuid \
setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index b6deffd43..a329eec39 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -891,6 +891,12 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
@var{oldpath}. The return value is unspecified.
@end deffn
+@deffn {Scheme Procedure} symlinkat dir oldpath newpath
+@deffnx {C Function} scm_symlinkat (dir, oldpath, newpath)
+Like @code{symlink}, but resolve @var{newpath} relative to
+the directory referred to by the file port @var{dir}.
+@end deffn
+
@deffn {Scheme Procedure} mkdir path [mode]
@deffnx {C Function} scm_mkdir (path, mode)
Create a new directory named by @var{path}. If @var{mode} is omitted
diff --git a/libguile/filesys.c b/libguile/filesys.c
index c5bedec07..bfd223434 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1045,6 +1045,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_SYMLINK */
+#ifdef HAVE_SYMLINKAT
+SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0,
+ (SCM dir, SCM oldpath, SCM newpath),
+ "Like @code{symlink}, but resolve @var{newpath} relative\n"
+ "to the directory referred to by the file port @var{dir}.")
+#define FUNC_NAME s_scm_symlinkat
+{
+ int val;
+ int fdes;
+
+ SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+ fdes = SCM_FPORT_FDES (dir);
+ STRING2_SYSCALL (oldpath, c_oldpath,
+ newpath, c_newpath,
+ val = symlinkat (c_oldpath, fdes, c_newpath));
+ scm_remember_upto_here_1 (dir);
+ if (val != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SYMLINKAT */
+
/* Static helper function for choosing between readlink
and readlinkat. */
static int
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a3b257c12..d181aca52 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value);
SCM_API SCM scm_fsync (SCM object);
SCM_API SCM scm_symlink (SCM oldpath, SCM newpath);
+SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath);
SCM_API SCM scm_readlink (SCM path);
SCM_API SCM scm_lstat (SCM str);
SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 7feb3492f..64bf92333 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -367,3 +367,30 @@
(false-if-exception (delete-file (test-symlink)))
(false-if-exception (delete-file (test-file))))
+
+(with-test-prefix "symlinkat"
+ (pass-if-equal "create" (test-file)
+ (unless (defined? 'symlinkat)
+ (throw 'unsupported))
+ (call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+ (symlinkat port (test-file) (test-symlink))
+ (readlink (test-symlink)))))
+ (false-if-exception (delete-file (test-symlink)))
+
+ (pass-if-exception "not a port" exception:wrong-type-arg
+ (unless (defined? 'symlinkat)
+ (throw 'unsupported))
+ (symlinkat "bogus" (test-file) (test-symlink)))
+
+ (pass-if-exception "not a file port" exception:wrong-type-arg
+ (unless (defined? 'symlinkat)
+ (throw 'unsupported))
+ (symlinkat (open-input-string "") (test-file) (test-symlink)))
+
+ (pass-if-exception "closed port" exception:wrong-type-arg
+ (unless (defined? 'symlinkat)
+ (throw 'unsupported))
+ (symlinkat (call-with-port (open "." O_RDONLY) identity)
+ (test-file) (test-symlink))))
--
2.30.2
|