ref: 464aae9ae90dcb43ab003b922e4ae4d08611c55b
parent: 67b2ebda49f691acfd676bb5f662e4e7e5471000
author: Matthew Flatt <mflatt@racket-lang.org>
date: Sat Dec 10 10:48:44 CST 2022
refine permissions support in `cp`
--- a/lib/zuo/private/more.zuo
+++ b/lib/zuo/private/more.zuo
@@ -33,6 +33,7 @@
rm*
cp*
+ :no-replace-mode
:error :truncate :must-truncate :append :update :can-update
display
@@ -280,14 +281,15 @@
(ls p))
(rmdir p)])))
-(define (cp* src dest)
+(define (cp* src dest [options (hash)])
(unless (path-string? src) (arg-error 'cp* "path string" src))
(unless (path-string? dest) (arg-error 'cp* "path string" dest))
+ (unless (hash? options) (arg-error 'cp* "hash table" options))
(define info (stat src #f))
(when info
(define type (hash-ref info 'type))
(cond
- [(eq? type 'file) (cp src dest)]
+ [(eq? type 'file) (cp src dest options)]
[(eq? type 'link)
(when (stat dest #f) (rm dest))
(symlink (readlink src) dest)]
@@ -294,8 +296,10 @@
[else
(unless (directory-exists? dest) (mkdir dest))
(for-each (lambda (e)
- (cp* (build-path src e) (build-path dest e)))
+ (cp* (build-path src e) (build-path dest e) options))
(ls src))])))
+
+(define :no-replace-mode (hash 'replace-mode #false))
(define :error (hash 'exists 'error))
(define :truncate (hash 'exists 'truncate))
--- a/tests/filesystem.zuo
+++ b/tests/filesystem.zuo
@@ -155,3 +155,15 @@
(check-arg-fail (symlink "a" 10) not-path)
(rm* sub-dir)
+
+(check (cp exists.txt exists2.txt) (void))
+(check (equal? (hash-ref (stat exists.txt) 'mode)
+ (hash-ref (stat exists2.txt) 'mode)))
+(check (file-exists? exists.txt))
+(check (file-exists? exists2.txt))
+(check (cp exists.txt exists2.txt (hash 'replace-mode #f)) (void))
+(check (cp exists.txt exists2.txt :no-replace-mode) (void))
+
+(check-arg-fail (cp "exists.txt" "exists2.txt" 'oops) "not a hash")
+(check-arg-fail (cp "exists.txt" "exists2.txt" (hash 'mode 'oops)) "not an integer")
+(check-arg-fail (cp "exists.txt" "exists2.txt" (hash 'other 0)) "unrecognized or unused option")
--- a/zuo-doc/fake-zuo.rkt
+++ b/zuo-doc/fake-zuo.rkt
@@ -167,6 +167,7 @@
file-name-from-path
path->complete-path
ls* rm* cp* mkdir-p
+ :no-replace-mode
:error :truncate :must-truncate :append :update :can-update
cleanable-file
cleanable-cancel
--- a/zuo-doc/lang-zuo.scrbl
+++ b/zuo-doc/lang-zuo.scrbl
@@ -1292,18 +1292,43 @@
Gets the content of a link @racket[name]. This function is not
supported on Windows.}
-@defproc[(cp [source path-string?] [destination path-string?]) void?]{+@deftogether[(
+@defproc[(cp [source path-string?] [destination path-string?] [options hash? (hash)]) void?]
+@defthing[:no-replace-mode hash?]
+)]{-Copies the file at @racket[source] to @racket[destination],
-preserving permissions and replacing (or attempting to replace)
-@racket[destination] if it exists.}
+Copies the file at @racket[source] to @racket[destination], replacing
+(or attempting to replace) @racket[destination] if it exists.
-@defproc[(cp* [source path-string?] [destination path-string?]) void?]{+On Unix, if @racket[destination] does not exist, it is created with
+the mode (i.e., permissions) specified by @racket['mode] in
+@racket[options], which must be an integer between 0 and 65535
+inclusive; if @racket['mode] is not provided, the mode of
+@racket[source] is used. The creation-time mode can be modified by
+the process's umask, but unless @racket[options] maps
+@racket['replace-mode] to @racket[#false], the mode is explicitly applied again
+to @racket[destination]---whether @racket[destination] was just
+created or exists already, and ignoring the process's umask. On
+Windows, the attributes of @racket[source] are always copied to
+@racket[destination], and if @racket['mode] is provided, then the file
+is made read only if and only if the @scheme[bitwise-and] of the mode
+value and @racket[2] is @racket[0].
+The @racket[:no-replace-mode] hash table maps
+@racket['no-replace-mode] to @racket[#true].
+
+@history[#:changed "1.6" @elem{Added the @racket[options] argument and+ @racket[:no-replace-mode].}]}
+
+@defproc[(cp* [source path-string?] [destination path-string?] [options hash? (hash)]) void?]{+
Copies the file, directory, or link @racket[source] to a corresponding
new file, directory, or link @racket[destination], including the
directory content if @racket[source] refers to a directory (and not to
-a link to a directory),.}
+a link to a directory). The @racket[options] argument is passed
+along to individual file-copy operations.
+
+@history[#:changed "1.6" @elem{Added the @racket[options] argument.}]}@deftogether[(
@defproc[(file-exists? [name path-string?]) booelan?]
--- a/zuo.c
+++ b/zuo.c
@@ -3,7 +3,7 @@
declarations. */
#define ZUO_VERSION 1
-#define ZUO_MINOR_VERSION 5
+#define ZUO_MINOR_VERSION 6
#if defined(_MSC_VER) || defined(__MINGW32__)
# define ZUO_WINDOWS
@@ -5284,53 +5284,75 @@
return z.o_undefined;
}
-static zuo_t *zuo_cp(zuo_t *src_path, zuo_t *dest_path) {+static zuo_t *zuo_cp(zuo_t *src_path, zuo_t *dest_path, zuo_t *options) {const char *who = "cp";
+ int replace_perms;
+ zuo_t *perms, *replace_mode;
check_path_string(who, src_path);
check_path_string(who, dest_path);
-#ifdef ZUO_UNIX
- int src_fd, dest_fd;
- struct stat st_buf;
- zuo_int_t len, amt;
- char *buf;
- EINTR_RETRY(src_fd = open(ZUO_STRING_PTR(src_path), O_RDONLY));
- if (src_fd == -1)
- zuo_fail1w_errno(who, "source open failed", src_path);
+ if (options == z.o_undefined) options = z.o_empty_hash;
+ check_hash(who, options);
- if (fstat(src_fd, &st_buf) != 0)
- zuo_fail1w_errno(who, "source stat failed", src_path);
+ perms = zuo_consume_option(&options, "mode");
+ if (perms != z.o_undefined) {+ if ((perms->tag != zuo_integer_tag)
+ || (ZUO_INT_I(perms) < 0)
+ || (ZUO_INT_I(perms) > 65535))
+ zuo_fail1w(who, "not an integer in 0 to 65535", perms);
+ }
- /* Permissions may be reduced by umask, but the intent here is to
- make sure the file doesn't have more permissions than it will end
- up with: */
- EINTR_RETRY(dest_fd = open(ZUO_STRING_PTR(dest_path), O_WRONLY | O_CREAT | O_TRUNC, st_buf.st_mode));
+ replace_mode = zuo_consume_option(&options, "replace-mode");
+ replace_perms = ((replace_mode != z.o_undefined)
+ || (replace_mode != z.o_false));
- if (dest_fd == -1)
- zuo_fail1w_errno(who, "destination open failed", dest_path);
+ check_options_consumed(who, options);
- buf = malloc(4096);
+#ifdef ZUO_UNIX
+ {+ int src_fd, dest_fd;
+ struct stat st_buf;
+ zuo_int_t len, amt;
+ char *buf;
- while (1) {- EINTR_RETRY(amt = read(src_fd, buf, 4096));
- if (amt == 0)
- break;
- if (amt < 0)
- zuo_fail1w_errno(who, "source read failed", src_path);
- while (amt > 0) {- EINTR_RETRY(len = write(dest_fd, buf, amt));
- if (len < 0)
- zuo_fail1w_errno(who, "destination write failed", dest_path);
- amt -= len;
- }
- }
+ EINTR_RETRY(src_fd = open(ZUO_STRING_PTR(src_path), O_RDONLY));
+ if (src_fd == -1)
+ zuo_fail1w_errno(who, "source open failed", src_path);
- EINTR_RETRY(close(src_fd));
+ if (perms == z.o_undefined) {+ if (fstat(src_fd, &st_buf) != 0)
+ zuo_fail1w_errno(who, "source stat failed", src_path);
+ } else
+ st_buf.st_mode = ZUO_INT_I(perms);
- if (fchmod(dest_fd, st_buf.st_mode) != 0)
- zuo_fail1w_errno(who, "destination permissions update failed", dest_path);
+ EINTR_RETRY(dest_fd = open(ZUO_STRING_PTR(dest_path), O_WRONLY | O_CREAT | O_TRUNC, st_buf.st_mode));
- EINTR_RETRY(close(dest_fd));
+ if (dest_fd == -1)
+ zuo_fail1w_errno(who, "destination open failed", dest_path);
+
+ if (replace_perms)
+ if (fchmod(dest_fd, st_buf.st_mode) != 0)
+ zuo_fail1w_errno(who, "destination permissions update failed", dest_path);
+
+ buf = malloc(4096);
+
+ while (1) {+ EINTR_RETRY(amt = read(src_fd, buf, 4096));
+ if (amt == 0)
+ break;
+ if (amt < 0)
+ zuo_fail1w_errno(who, "source read failed", src_path);
+ while (amt > 0) {+ EINTR_RETRY(len = write(dest_fd, buf, amt));
+ if (len < 0)
+ zuo_fail1w_errno(who, "destination write failed", dest_path);
+ amt -= len;
+ }
+ }
+
+ EINTR_RETRY(close(src_fd));
+ EINTR_RETRY(close(dest_fd));
+ }
#endif
#ifdef ZUO_WINDOWS
{@@ -5338,6 +5360,27 @@
wchar_t *dest_w = zuo_to_wide(ZUO_STRING_PTR(dest_path));
if (!CopyFileW(src_w, dest_w, 0))
zuo_fail1w(who, "copy failed to destination", dest_path);
+
+ if (perms != z.o_undefined) {+ int read_only = !(ZUO_INT_I(perms) & 2);
+ int ok;
+ DWORD attrs = GetFileAttributesW(dest_w);
+ if (attrs != INVALID_FILE_ATTRIBUTES) {+ if (!(attrs & FILE_ATTRIBUTE_READONLY) != !read_only) {+ if (read_only)
+ attrs -= FILE_ATTRIBUTE_READONLY;
+ else
+ attrs |= FILE_ATTRIBUTE_READONLY;
+ ok = SetFileAttributesW(dest_w, attrs);
+ } else
+ ok = 1;
+ } else
+ ok = 0;
+
+ if (!ok)
+ zuo_fail1w(who, "failed making destination read-only", dest_path);
+ }
+
free(src_w);
free(dest_w);
}
@@ -7140,7 +7183,7 @@
ZUO_TOP_ENV_SET_PRIMITIVE1("ls", zuo_ls); ZUO_TOP_ENV_SET_PRIMITIVE2("symlink", zuo_ln); ZUO_TOP_ENV_SET_PRIMITIVE1("readlink", zuo_readlink);- ZUO_TOP_ENV_SET_PRIMITIVE2("cp", zuo_cp);+ ZUO_TOP_ENV_SET_PRIMITIVEc("cp", zuo_cp); ZUO_TOP_ENV_SET_PRIMITIVE0("current-time", zuo_current_time); ZUO_TOP_ENV_SET_PRIMITIVEN("process", zuo_process, -2);