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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
| | Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
From: Maxime Devos <maximedevos@telenet.be>
Subject: [PATCH v2 05/14]
=?UTF-8?q?Define=20bindings=20to=20=E2=80=98mkdi?=
=?UTF-8?q?rat=E2=80=99=20when=20the=20C=20function=20exists.?=
Date: Tue, 16 Nov 2021 11:06:28 +0000
Message-Id: <20211116110637.125579-6-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 if ‘mkdirat’ exists.
* libguile/filesys.c (scm_mkdirat): Define the Scheme binding.
* doc/ref/posix.texi (File System): Document it.
---
configure.ac | 2 +-
doc/ref/posix.texi | 6 ++++++
libguile/filesys.c | 25 +++++++++++++++++++++++
libguile/filesys.h | 1 +
test-suite/tests/filesys.test | 38 +++++++++++++++++++++++++++++++++++
5 files changed, 71 insertions(+), 1 deletion(-)
diff --git a/configure.ac b/configure.ac
index b2e9ef3e9..da8dfadd0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
- symlinkat getcwd geteuid getsid \
+ symlinkat mkdirat getcwd geteuid getsid \
gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
nice readlink rename rmdir setegid seteuid \
setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index a329eec39..d261ac8da 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -906,6 +906,12 @@ Otherwise they are set to the value specified with @var{mode}.
The return value is unspecified.
@end deffn
+@deffn {Scheme Procedure} mkdirat dir path [mode]
+@deffnx {C Function} scm_mkdirat (dir, path, mode)
+Like @code{mkdir}, but resolve @var{path} relative to the directory
+referred to by the file port @var{dir} instead.
+@end deffn
+
@deffn {Scheme Procedure} rmdir path
@deffnx {C Function} scm_rmdir (path)
Remove the existing directory named by @var{path}. The directory must
diff --git a/libguile/filesys.c b/libguile/filesys.c
index bfd223434..ee01b2e2c 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1364,6 +1364,31 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
}
#undef FUNC_NAME
+#ifdef HAVE_MKDIRAT
+SCM_DEFINE (scm_mkdirat, "mkdirat", 2, 1, 0,
+ (SCM dir, SCM path, SCM mode),
+ "Like @code{mkdir}, but resolve @var{path} relative to the directory\n"
+ "referred to by the file port @var{dir} instead.")
+#define FUNC_NAME s_scm_mkdirat
+{
+ int rv;
+ int dir_fdes;
+ mode_t c_mode;
+
+ c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
+ SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+ dir_fdes = SCM_FPORT_FDES (dir);
+
+ STRING_SYSCALL (path, c_path, rv = mkdirat (dir_fdes, c_path, c_mode));
+ if (rv != 0)
+ SCM_SYSERROR;
+
+ scm_remember_upto_here_1 (dir);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
(SCM path),
"Remove the existing directory named by @var{path}. The directory must\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index d181aca52..f0dd35ede 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -50,6 +50,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath);
SCM_API SCM scm_rename (SCM oldname, SCM newname);
SCM_API SCM scm_delete_file (SCM str);
SCM_API SCM scm_mkdir (SCM path, SCM mode);
+SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
SCM_API SCM scm_rmdir (SCM path);
SCM_API SCM scm_directory_stream_p (SCM obj);
SCM_API SCM scm_opendir (SCM dirname);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 64bf92333..4ea62d513 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -29,6 +29,8 @@
(data-file-name "filesys-test.tmp"))
(define (test-symlink)
(data-file-name "filesys-test-link.tmp"))
+(define (test-directory)
+ (data-file-name "filesys-test-dir.tmp"))
;;;
@@ -394,3 +396,39 @@
(throw 'unsupported))
(symlinkat (call-with-port (open "." O_RDONLY) identity)
(test-file) (test-symlink))))
+
+(with-test-prefix "mkdirat"
+ (define (skip-if-unsupported)
+ (unless (defined? 'mkdirat)
+ (throw 'unsupported)))
+ (define (maybe-delete-directory)
+ (when (file-exists? (test-directory))
+ (rmdir (test-directory))))
+ (maybe-delete-directory)
+
+ (pass-if-equal "create" 'directory
+ (skip-if-unsupported)
+ (call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+ (mkdirat port (test-directory))
+ (stat:type (stat (test-directory))))))
+ (maybe-delete-directory)
+
+ (pass-if-equal "explicit perms" (logand #o111 (lognot (umask)))
+ (skip-if-unsupported)
+ (call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+ (mkdirat port (test-directory) #o111)
+ (stat:perms (stat (test-directory))))))
+ (maybe-delete-directory)
+
+ (pass-if-equal "create, implicit perms" (logand #o777 (lognot (umask)))
+ (skip-if-unsupported)
+ (call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+ (mkdirat port (test-directory))
+ (stat:perms (stat (test-directory))))))
+ (maybe-delete-directory))
--
2.30.2
|