suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

open-output-file et al.: add #:permissions argument

Browse Source 
Add a `#:permissions` optional argument that is a permissions integer
in the same style as `file-or-directory-permissions` and that is used
when a file is created. On Unix, the given permissions are combined
with the process's umask.

Closes #1654
This commit is contained in:
Matthew Flatt 2021-04-28 13:12:14 -06:00
parent bff31f0768
commit 09480c86e8
17 changed files with 628 additions and 401 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -14,7 +14,7 @@
;; In the Racket source repo, this version should change only when
;; "racket_version.h" changes:
(define version "8.1.0.2")
(define version "8.1.0.3")
(define deps `("racket-lib"
["racket" #:version ,version]))

44
pkgs/racket-doc/scribblings/reference/file-ports.scrbl
View File

@ -33,6 +33,8 @@
"")
@(define default-permissions @racketvalfont{#o666})
@title[#:tag "file-ports"]{File Ports}
A port created by @racket[open-input-file], @racket[open-output-file],
@ -123,7 +125,8 @@ then the raised exception is either
[#:mode mode-flag (or/c 'binary 'text) 'binary]
[#:exists exists-flag (or/c 'error 'append 'update 'can-update
'replace 'truncate
'must-truncate 'truncate/replace) 'error])
'must-truncate 'truncate/replace) 'error]
[#:permissions permissions (integer-in 0 65535) @#,default-permissions])
output-port?]{
Opens the file specified by @racket[path] for output. The
@ -183,6 +186,16 @@ files that already exist:
]
When the file specified by @racket[path] is created,
@racket[permissions] specifies the permissions of the created file,
where an integer representation of permissions is treated the same as
for @racket[file-or-directory-permissions]. On Unix and Mac OS, these
permissions bits are combined with the process's umask. On Windows,
the only relevant property of @racket[permissions] is whether it has
the @racketvalfont{#o2} bit set for write permission. Note that a
read-only file can be created with @racket[open-output-file], in which
case writing is prohibited only for later attempts to open the file.
The file specified by @racket[path] need not be a regular file. It
might be a device that is connected through the filesystem, such as
@filepath{aux} on Windows or @filepath{/dev/null} on Unix. The output
@ -218,12 +231,14 @@ then @exnraise[exn:fail:filesystem:errno].
like @racket['truncate/replace].}
#:changed "7.4.0.5" @elem{Changed handling of a fifo on Unix and Mac OS to
make the port block for output until the fifo has a
reader.}]}
reader.}
#:changed "8.1.0.3" @elem{Added the @racket[#:permissions] argument.}]}
@defproc[(open-input-output-file [path path-string?]
[#:mode mode-flag (or/c 'binary 'text) 'binary]
[#:exists exists-flag (or/c 'error 'append 'update 'can-update
'replace 'truncate 'truncate/replace) 'error])
'replace 'truncate 'truncate/replace) 'error]
[#:permissions permissions (integer-in 0 65535) @#,default-permissions])
(values input-port? output-port?)]{
Like @racket[open-output-file], but producing two values: an input
@ -258,10 +273,11 @@ when @racket[proc] returns.
[proc (output-port? . -> . any)]
[#:mode mode-flag (or/c 'binary 'text) 'binary]
[#:exists exists-flag (or/c 'error 'append 'update
'replace 'truncate 'truncate/replace) 'error])
'replace 'truncate 'truncate/replace) 'error]
[#:permissions permissions (integer-in 0 65535) @#,default-permissions])
any]{
Analogous to @racket[call-with-input-file], but passing @racket[path],
@racket[mode-flag] and @racket[exists-flag] to
@racket[mode-flag], @racket[exists-flag], and @racket[permissions] to
@racket[open-output-file].
@file-examples[
@ -271,7 +287,9 @@ Analogous to @racket[call-with-input-file], but passing @racket[path],
(call-with-input-file some-file
(lambda (in)
(read-string 5 in)))
]}
]
@history[#:changed "8.1.0.3" @elem{Added the @racket[#:permissions] argument.}]}
@defproc[(call-with-input-file* [path path-string?]
[proc (input-port? . -> . any)]
@ -286,12 +304,15 @@ return, a continuation application, or a prompt-based abort.}
[proc (output-port? . -> . any)]
[#:mode mode-flag (or/c 'binary 'text) 'binary]
[#:exists exists-flag (or/c 'error 'append 'update
'replace 'truncate 'truncate/replace) 'error])
'replace 'truncate 'truncate/replace) 'error]
[#:permissions permissions (integer-in 0 65535) @#,default-permissions])
any]{
Like @racket[call-with-output-file], but the newly opened port is
closed whenever control escapes the dynamic extent of the
@racket[call-with-output-file*] call, whether through @racket[proc]'s
return, a continuation application, or a prompt-based abort.}
return, a continuation application, or a prompt-based abort.
@history[#:changed "8.1.0.3" @elem{Added the @racket[#:permissions] argument.}]}
@defproc[(with-input-from-file [path path-string?]
[thunk (-> any)]
@ -313,7 +334,8 @@ the current input port (see @racket[current-input-port]) using
[thunk (-> any)]
[#:mode mode-flag (or/c 'binary 'text) 'binary]
[#:exists exists-flag (or/c 'error 'append 'update
'replace 'truncate 'truncate/replace) 'error])
'replace 'truncate 'truncate/replace) 'error]
[#:permissions permissions (integer-in 0 65535) @#,default-permissions])
any]{
Like @racket[call-with-output-file*], but instead of passing the newly
opened port to the given procedure argument, the port is installed as
@ -325,7 +347,9 @@ the current output port (see @racket[current-output-port]) using
(lambda () (printf "hello")))
(with-input-from-file some-file
(lambda () (read-string 5)))
]}
]
@history[#:changed "8.1.0.3" @elem{Added the @racket[#:permissions] argument.}]}
@defproc[(port-try-file-lock? [port file-stream-port?]

36
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -2441,6 +2441,42 @@
(delete-file file)
(delete-directory dir))
;; Check that permissions for file creation work
(let ()
(define dir (make-temporary-file "~a-tmp" 'directory))
(define file (build-path dir "f"))
(define (check open)
(open file #x444)
(err/rt-test/once (open file #x666) exn:fail:filesystem?)
(delete-file file))
(check (lambda (file perms)
(close-output-port (open-output-file file #:exists 'truncate #:permissions perms))))
(check (lambda (file perms)
(define-values (i o)
(open-input-output-file file #:exists 'truncate #:permissions perms))
(close-input-port i)
(close-output-port o)))
(check (lambda (file perms)
(with-output-to-file file
#:permissions perms
#:exists 'truncate
void)))
(check (lambda (file perms)
(call-with-output-file file
#:permissions perms
#:exists 'truncate
void)))
(check (lambda (file perms)
(call-with-output-file* file
#:permissions perms
#:exists 'truncate
void)))
(delete-directory dir))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([tf (make-temporary-file)])

40
racket/collects/racket/private/kw-file.rkt
View File

@ -24,6 +24,11 @@
(define binary-or-text-desc
"(or/c 'binary 'text)")
(define DEFAULT-CREATE-PERMS #o666)
(define (permissions? perms)
(and (exact-integer? perms) (<= 0 perms 65535)))
(define perms-desc "(integer-in 0 65535)")
(define (open-input-file path #:mode [mode 'binary] #:for-module? [for-module? #f])
(unless (path-string? path)
(raise-argument-error 'open-input-file "path-string?" path))
@ -32,24 +37,30 @@
(k:open-input-file path mode (if for-module? 'module 'none)))
(define (open-output-file path #:mode [mode 'binary]
#:exists [exists 'error])
#:exists [exists 'error]
#:permissions [perms DEFAULT-CREATE-PERMS])
(unless (path-string? path)
(raise-argument-error 'open-output-file "path-string?" path))
(unless (memq mode '(binary text))
(raise-argument-error 'open-output-file binary-or-text-desc mode))
(unless (memq exists exists-syms)
(raise-argument-error 'open-output-file exists-desc exists))
(k:open-output-file path mode exists))
(unless (permissions? perms)
(raise-argument-error 'open-output-file perms-desc perms))
(k:open-output-file path mode exists perms))
(define (open-input-output-file path #:mode [mode 'binary]
#:exists [exists 'error])
#:exists [exists 'error]
#:permissions [perms DEFAULT-CREATE-PERMS])
(unless (path-string? path)
(raise-argument-error 'open-input-output-file "path-string?" path))
(unless (memq mode '(binary text))
(raise-argument-error 'open-input-output-file binary-or-text-desc mode))
(unless (memq exists exists-syms)
(raise-argument-error 'open-input-output-file exists-desc exists))
(k:open-input-output-file path mode exists))
(unless (permissions? perms)
(raise-argument-error 'open-input-output-file perms-desc perms))
(k:open-input-output-file path mode exists perms))
(define (call-with-input-file path proc #:mode [mode 'binary])
(unless (path-string? path)
@ -63,7 +74,8 @@
(define (call-with-output-file path proc
#:mode [mode 'binary]
#:exists [exists 'error])
#:exists [exists 'error]
#:permissions [perms DEFAULT-CREATE-PERMS])
(unless (path-string? path)
(raise-argument-error 'call-with-output-file "path-string?" path))
(unless (and (procedure? proc)
@ -73,7 +85,9 @@
(raise-argument-error 'call-with-output-file binary-or-text-desc mode))
(unless (memq exists exists-syms)
(raise-argument-error 'call-with-output-file exists-desc exists))
(k:call-with-output-file path proc mode exists))
(unless (permissions? perms)
(raise-argument-error 'call-with-output-file perms-desc perms))
(k:call-with-output-file path proc mode exists perms))
(define (with-input-from-file path proc #:mode [mode 'binary])
(unless (path-string? path)
@ -87,7 +101,8 @@
(define (with-output-to-file path proc
#:mode [mode 'binary]
#:exists [exists 'error])
#:exists [exists 'error]
#:permissions [perms DEFAULT-CREATE-PERMS])
(unless (path-string? path)
(raise-argument-error 'with-output-to-file "path-string?" path))
(unless (and (procedure? proc)
@ -97,7 +112,9 @@
(raise-argument-error 'with-output-to-file binary-or-text-desc mode))
(unless (memq exists exists-syms)
(raise-argument-error 'with-output-to-file exists-desc exists))
(k:with-output-to-file path proc mode exists))
(unless (permissions? perms)
(raise-argument-error 'with-output-to-file perms-desc perms))
(k:with-output-to-file path proc mode exists perms))
(define (call-with-input-file* path proc #:mode [mode 'binary])
(unless (path-string? path)
@ -115,7 +132,8 @@
(define (call-with-output-file* path proc
#:mode [mode 'binary]
#:exists [exists 'error])
#:exists [exists 'error]
#:permissions [perms DEFAULT-CREATE-PERMS])
(unless (path-string? path)
(raise-argument-error 'call-with-output-file* "path-string?" path))
(unless (and (procedure? proc)
@ -125,7 +143,9 @@
(raise-argument-error 'call-with-output-file* binary-or-text-desc mode))
(unless (memq exists exists-syms)
(raise-argument-error 'call-with-output-file* exists-desc exists))
(let ([p (k:open-output-file path mode exists)])
(unless (permissions? perms)
(raise-argument-error 'call-with-output-file* perms-desc perms))
(let ([p (k:open-output-file path mode exists perms)])
(dynamic-wind
void
(lambda () (proc p))

142
racket/src/bc/src/port.c
View File

@ -3784,6 +3784,7 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
char *filename;
char mode[4];
int typepos;
int perms;
rktio_fd_t *fd;
mode[0] = 'w';
@ -3791,79 +3792,86 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
mode[2] = 0;
mode[3] = 0;
typepos = 1;
perms = RKTIO_DEFAULT_PERM_BITS;
if (!SCHEME_PATH_STRINGP(argv[0]))
scheme_wrong_contract(name, "path-string?", 0, argc, argv);
for (i = 1 + offset; argc > i; i++) {
if (!SCHEME_SYMBOLP(argv[i]))
scheme_wrong_contract(name, "symbol?", i, argc, argv);
if (SAME_OBJ(argv[i], append_symbol)) {
mode[0] = 'a';
open_flags = RKTIO_OPEN_APPEND;
e_set++;
} else if (SAME_OBJ(argv[i], replace_symbol)) {
try_replace = 1;
e_set++;
} else if (SAME_OBJ(argv[i], truncate_symbol)) {
open_flags = RKTIO_OPEN_TRUNCATE | RKTIO_OPEN_CAN_EXIST;
e_set++;
} else if (SAME_OBJ(argv[i], must_truncate_symbol)) {
open_flags = RKTIO_OPEN_MUST_EXIST | RKTIO_OPEN_TRUNCATE;
e_set++;
} else if (SAME_OBJ(argv[i], truncate_replace_symbol)) {
open_flags = RKTIO_OPEN_TRUNCATE | RKTIO_OPEN_CAN_EXIST;
try_replace = 1;
e_set++;
} else if (SAME_OBJ(argv[i], update_symbol)) {
open_flags = RKTIO_OPEN_MUST_EXIST;
if (typepos == 1) {
mode[2] = mode[1];
typepos = 2;
}
mode[0] = 'r';
mode[1] = '+';
e_set++;
} else if (SAME_OBJ(argv[i], can_update_symbol)) {
open_flags = RKTIO_OPEN_CAN_EXIST;
if (typepos == 1) {
mode[2] = mode[1];
typepos = 2;
}
mode[0] = 'r';
mode[1] = '+';
e_set++;
} else if (SAME_OBJ(argv[i], error_symbol)) {
/* This is the default */
e_set++;
} else if (SAME_OBJ(argv[i], text_symbol)) {
mode[typepos] = 't';
m_set++;
} else if (SAME_OBJ(argv[i], binary_symbol)) {
/* This is the default */
m_set++;
if (SCHEME_INTP(argv[i])
&& (SCHEME_INT_VAL(argv[i]) >= 0)
&& (SCHEME_INT_VAL(argv[i]) <= 65535)) {
perms = SCHEME_INT_VAL(argv[i]);
} else {
char *astr;
intptr_t alen;
if (!SCHEME_SYMBOLP(argv[i]))
scheme_wrong_contract(name, "(or/c symbol? (integer-in 0 65535))", i, argc, argv);
astr = scheme_make_args_string("other ", i, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: bad mode symbol\n"
" given symbol: : %s%s", name,
scheme_make_provided_string(argv[i], 1, NULL),
astr, alen);
}
if (SAME_OBJ(argv[i], append_symbol)) {
mode[0] = 'a';
open_flags = RKTIO_OPEN_APPEND;
e_set++;
} else if (SAME_OBJ(argv[i], replace_symbol)) {
try_replace = 1;
e_set++;
} else if (SAME_OBJ(argv[i], truncate_symbol)) {
open_flags = RKTIO_OPEN_TRUNCATE | RKTIO_OPEN_CAN_EXIST;
e_set++;
} else if (SAME_OBJ(argv[i], must_truncate_symbol)) {
open_flags = RKTIO_OPEN_MUST_EXIST | RKTIO_OPEN_TRUNCATE;
e_set++;
} else if (SAME_OBJ(argv[i], truncate_replace_symbol)) {
open_flags = RKTIO_OPEN_TRUNCATE | RKTIO_OPEN_CAN_EXIST;
try_replace = 1;
e_set++;
} else if (SAME_OBJ(argv[i], update_symbol)) {
open_flags = RKTIO_OPEN_MUST_EXIST;
if (typepos == 1) {
mode[2] = mode[1];
typepos = 2;
}
mode[0] = 'r';
mode[1] = '+';
e_set++;
} else if (SAME_OBJ(argv[i], can_update_symbol)) {
open_flags = RKTIO_OPEN_CAN_EXIST;
if (typepos == 1) {
mode[2] = mode[1];
typepos = 2;
}
mode[0] = 'r';
mode[1] = '+';
e_set++;
} else if (SAME_OBJ(argv[i], error_symbol)) {
/* This is the default */
e_set++;
} else if (SAME_OBJ(argv[i], text_symbol)) {
mode[typepos] = 't';
m_set++;
} else if (SAME_OBJ(argv[i], binary_symbol)) {
/* This is the default */
m_set++;
} else {
char *astr;
intptr_t alen;
if (m_set > 1 || e_set > 1) {
char *astr;
intptr_t alen;
astr = scheme_make_args_string("other ", i, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: bad mode symbol\n"
" given symbol: : %s%s", name,
scheme_make_provided_string(argv[i], 1, NULL),
astr, alen);
}
astr = scheme_make_args_string("", -1, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: conflicting or redundant file modes given%t",
name,
astr, alen);
if (m_set > 1 || e_set > 1) {
char *astr;
intptr_t alen;
astr = scheme_make_args_string("", -1, argc, argv, &alen);
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: conflicting or redundant file modes given%t",
name,
astr, alen);
}
}
}
@ -3890,10 +3898,12 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
scheme_custodian_check_available(NULL, name, "file-stream");
while (1) {
fd = rktio_open(scheme_rktio, filename, (RKTIO_OPEN_WRITE
fd = rktio_open_with_create_permissions(scheme_rktio, filename,
(RKTIO_OPEN_WRITE
| open_flags
| (and_read ? RKTIO_OPEN_READ : 0)
| ((mode[1] == 't') ? RKTIO_OPEN_TEXT : 0)));
| ((mode[1] == 't') ? RKTIO_OPEN_TEXT : 0)),
perms);
if (!fd
&& try_replace

8
racket/src/bc/src/portfun.c
View File

@ -227,20 +227,20 @@ scheme_init_port_fun(Scheme_Startup_Env *env)
ADD_NONCM_PRIM("open-input-file", open_input_file, 1, 3, env);
ADD_NONCM_PRIM("open-input-bytes", open_input_byte_string, 1, 2, env);
ADD_NONCM_PRIM("open-input-string", open_input_char_string, 1, 2, env);
ADD_NONCM_PRIM("open-output-file", open_output_file, 1, 3, env);
ADD_NONCM_PRIM("open-output-file", open_output_file, 1, 4, env);
ADD_NONCM_PRIM("open-output-bytes", open_output_string, 0, 1, env);
ADD_NONCM_PRIM("open-output-string", open_output_string, 0, 1, env);
ADD_NONCM_PRIM("get-output-bytes", get_output_byte_string, 1, 4, env);
ADD_NONCM_PRIM("get-output-string", get_output_char_string, 1, 1, env);
ADD_NONCM_PRIM("open-input-output-file", open_input_output_file, 1, 3, env);
ADD_NONCM_PRIM("open-input-output-file", open_input_output_file, 1, 4, env);
ADD_NONCM_PRIM("close-input-port", close_input_port, 1, 1, env);
ADD_NONCM_PRIM("close-output-port", close_output_port, 1, 1, env);
ADD_NONCM_PRIM("make-input-port", make_input_port, 4, 10, env);
ADD_NONCM_PRIM("make-output-port", make_output_port, 4, 11, env);
ADD_PRIM_W_ARITY2("call-with-output-file", call_with_output_file, 2, 4, 0, -1, env);
ADD_PRIM_W_ARITY2("call-with-output-file", call_with_output_file, 2, 5, 0, -1, env);
ADD_PRIM_W_ARITY2("call-with-input-file", call_with_input_file, 2, 3, 0, -1, env);
ADD_PRIM_W_ARITY2("with-output-to-file", with_output_to_file, 2, 4, 0, -1, env);
ADD_PRIM_W_ARITY2("with-output-to-file", with_output_to_file, 2, 5, 0, -1, env);
ADD_PRIM_W_ARITY2("with-input-from-file", with_input_from_file, 2, 3, 0, -1, env);
ADD_PRIM_W_ARITY2("make-pipe", sch_pipe, 0, 3, 2, 2, env);
ADD_PRIM_W_ARITY2("port-next-location", port_next_location, 1, 1, 3, 3, env);

16
racket/src/bc/src/startup.inc
View File

@ -2461,12 +2461,12 @@ static const char *startup_source =
"(open-input-file path_0 mode_0(if for-module?_0 'module 'none))))))))))"
"(define-values"
"(with-input-from-file.1)"
"(lambda(mode31_0 path33_0 proc34_0)"
"(lambda(mode37_0 path39_0 proc40_0)"
"(begin"
" 'with-input-from-file"
"(let-values(((path_0) path33_0))"
"(let-values(((proc_0) proc34_0))"
"(let-values(((mode_0) mode31_0))"
"(let-values(((path_0) path39_0))"
"(let-values(((proc_0) proc40_0))"
"(let-values(((mode_0) mode37_0))"
"(let-values()"
"(begin"
"(if(path-string? path_0)"
@ -2481,12 +2481,12 @@ static const char *startup_source =
"(with-input-from-file path_0 proc_0 mode_0)))))))))"
"(define-values"
"(call-with-input-file*.1)"
"(lambda(mode43_0 path45_0 proc46_0)"
"(lambda(mode51_0 path53_0 proc54_0)"
"(begin"
" 'call-with-input-file*"
"(let-values(((path_0) path45_0))"
"(let-values(((proc_0) proc46_0))"
"(let-values(((mode_0) mode43_0))"
"(let-values(((path_0) path53_0))"
"(let-values(((proc_0) proc54_0))"
"(let-values(((mode_0) mode51_0))"
"(let-values()"
"(begin"
"(if(path-string? path_0)"

38
racket/src/cs/schemified/expander.scm
View File

@ -3431,57 +3431,57 @@
(define with-input-from-file.1
(|#%name|
with-input-from-file
(lambda (mode31_0 path33_0 proc34_0)
(lambda (mode37_0 path39_0 proc40_0)
(begin
(begin
(if (path-string? path33_0)
(if (path-string? path39_0)
(void)
(raise-argument-error
'with-input-from-file
"path-string?"
path33_0))
(if (if (procedure? proc34_0)
(procedure-arity-includes? proc34_0 0)
path39_0))
(if (if (procedure? proc40_0)
(procedure-arity-includes? proc40_0 0)
#f)
(void)
(raise-argument-error 'with-input-from-file "(-> any)" proc34_0))
(if (memq mode31_0 '(binary text))
(raise-argument-error 'with-input-from-file "(-> any)" proc40_0))
(if (memq mode37_0 '(binary text))
(void)
(raise-argument-error
'with-input-from-file
binary-or-text-desc
mode31_0))
(with-input-from-file path33_0 proc34_0 mode31_0))))))
mode37_0))
(with-input-from-file path39_0 proc40_0 mode37_0))))))
(define call-with-input-file*.1
(|#%name|
call-with-input-file*
(lambda (mode43_0 path45_0 proc46_0)
(lambda (mode51_0 path53_0 proc54_0)
(begin
(begin
(if (path-string? path45_0)
(if (path-string? path53_0)
(void)
(raise-argument-error
'call-with-input-file*
"path-string?"
path45_0))
(if (if (procedure? proc46_0)
(procedure-arity-includes? proc46_0 1)
path53_0))
(if (if (procedure? proc54_0)
(procedure-arity-includes? proc54_0 1)
#f)
(void)
(raise-argument-error
'call-with-input-file*
"(input-port? . -> . any)"
proc46_0))
(if (memq mode43_0 '(binary text))
proc54_0))
(if (memq mode51_0 '(binary text))
(void)
(raise-argument-error
'call-with-input-file*
binary-or-text-desc
mode43_0))
(let ((p_0 (open-input-file path45_0 mode43_0)))
mode51_0))
(let ((p_0 (open-input-file path53_0 mode51_0)))
(dynamic-wind
void
(lambda () (|#%app| proc46_0 p_0))
(lambda () (|#%app| proc54_0 p_0))
(lambda () (close-input-port p_0)))))))))
(define print-value-columns
(make-parameter

616
racket/src/cs/schemified/io.scm
View File

@ -2964,6 +2964,8 @@
(begin-unsafe (hash-ref rktio-table 'rktio_fd_is_pending_open)))
(define rktio_fd_modes (begin-unsafe (hash-ref rktio-table 'rktio_fd_modes)))
(define rktio_open (begin-unsafe (hash-ref rktio-table 'rktio_open)))
(define rktio_open_with_create_permissions
(begin-unsafe (hash-ref rktio-table 'rktio_open_with_create_permissions)))
(define rktio_close (begin-unsafe (hash-ref rktio-table 'rktio_close)))
(define rktio_close_noerr
(begin-unsafe (hash-ref rktio-table 'rktio_close_noerr)))
@ -25981,12 +25983,12 @@
(1/format app_0 (host-> host-path_0)))))
(void))
(let ((p_0
(let ((temp33_0 (host-> host-path_0)))
(let ((temp38_0 (host-> host-path_0)))
(open-input-fd.1
unsafe-undefined
unsafe-undefined
fd_0
temp33_0))))
temp38_0))))
(begin
(unsafe-end-atomic)
(if (1/port-count-lines-enabled)
@ -26001,284 +26003,334 @@
((path_0 mode1_0 mode22_0) (open-input-file_0 path_0 mode1_0 mode22_0))
((path_0 mode11_0)
(open-input-file_0 path_0 mode11_0 unsafe-undefined))))))
(define permissions?
(lambda (perms_0) (if (exact-integer? perms_0) (<= 0 perms_0 65535) #f)))
(define permissions-desc "(integer-in 0 65535)")
(define do-open-output-file.1
(|#%name|
do-open-output-file
(lambda (plus-input?4_0 who6_0 path7_0 mode18_0 mode29_0)
(lambda (plus-input?4_0 who6_0 path7_0 mode18_0 mode29_0 perms10_0)
(begin
(begin
(if (path-string? path7_0)
(void)
(raise-argument-error who6_0 "path-string?" path7_0))
(let ((mode->flags_0
(|#%name|
mode->flags
(lambda (mode_0)
(begin
(if (eq? mode_0 'text)
4
(if (if (eq? mode_0 'truncate)
#t
(eq? mode_0 'truncate/replace))
72
(if (eq? mode_0 'must-truncate)
40
(if (eq? mode_0 'can-update)
64
(if (eq? mode_0 'update)
32
(if (eq? mode_0 'append) 16 0)))))))))))
(let ((mode?_0
(begin
(if (permissions? perms10_0)
(void)
(raise-argument-error who6_0 permissions-desc perms10_0))
(let ((mode->flags_0
(|#%name|
mode?
(lambda (v_0)
mode->flags
(lambda (mode_0)
(begin
(let ((or-part_0 (eq? mode18_0 v_0)))
(if or-part_0 or-part_0 (eq? mode29_0 v_0))))))))
(let ((host-path_0
(->host
path7_0
who6_0
(let ((app_0
(if (let ((or-part_0 (mode?_0 'replace)))
(if or-part_0
or-part_0
(mode?_0 'truncate/replace)))
'(delete)
'())))
(append
'(write)
app_0
(if (let ((or-part_0 (mode?_0 'append)))
(if or-part_0
or-part_0
(let ((or-part_1 (mode?_0 'update)))
(if or-part_1
or-part_1
(mode?_0 'must-update)))))
'(read)
'()))))))
(begin
(unsafe-start-atomic)
(if (eq? mode_0 'text)
4
(if (if (eq? mode_0 'truncate)
#t
(eq? mode_0 'truncate/replace))
72
(if (eq? mode_0 'must-truncate)
40
(if (eq? mode_0 'can-update)
64
(if (eq? mode_0 'update)
32
(if (eq? mode_0 'append) 16 0)))))))))))
(let ((mode?_0
(|#%name|
mode?
(lambda (v_0)
(begin
(let ((or-part_0 (eq? mode18_0 v_0)))
(if or-part_0 or-part_0 (eq? mode29_0 v_0))))))))
(let ((host-path_0
(->host
path7_0
who6_0
(let ((app_0
(if (let ((or-part_0 (mode?_0 'replace)))
(if or-part_0
or-part_0
(mode?_0 'truncate/replace)))
'(delete)
'())))
(append
'(write)
app_0
(if (let ((or-part_0 (mode?_0 'append)))
(if or-part_0
or-part_0
(let ((or-part_1 (mode?_0 'update)))
(if or-part_1
or-part_1
(mode?_0 'must-update)))))
'(read)
'()))))))
(begin
(check-current-custodian who6_0)
(let ((flags_0
(let ((app_0 (if plus-input?4_0 1 0)))
(let ((app_1 (mode->flags_0 mode18_0)))
(+ 2 app_0 app_1 (mode->flags_0 mode29_0))))))
(let ((fd0_0
(|#%app|
rktio_open
(unsafe-place-local-ref cell.1)
host-path_0
flags_0)))
(let ((fd_0
(if (not (vector? fd0_0))
fd0_0
(if (if (let ((or-part_0
(racket-error? fd0_0 4)))
(unsafe-start-atomic)
(begin
(check-current-custodian who6_0)
(let ((flags_0
(let ((app_0 (if plus-input?4_0 1 0)))
(let ((app_1 (mode->flags_0 mode18_0)))
(+ 2 app_0 app_1 (mode->flags_0 mode29_0))))))
(let ((fd0_0
(|#%app|
rktio_open_with_create_permissions
(unsafe-place-local-ref cell.1)
host-path_0
flags_0
perms10_0)))
(let ((fd_0
(if (not (vector? fd0_0))
fd0_0
(if (if (let ((or-part_0
(racket-error? fd0_0 4)))
(if or-part_0
or-part_0
(racket-error? fd0_0 5)))
(let ((or-part_0 (mode?_0 'replace)))
(if or-part_0
or-part_0
(racket-error? fd0_0 5)))
(let ((or-part_0 (mode?_0 'replace)))
(if or-part_0
or-part_0
(mode?_0 'truncate/replace)))
#f)
(let ((r_0
(|#%app|
rktio_delete_file
(unsafe-place-local-ref cell.1)
host-path_0
(1/current-force-delete-permissions))))
(begin
(if (vector? r_0)
(begin
(unsafe-end-atomic)
(raise-filesystem-error
who6_0
r_0
(let ((app_0
(string-append
"error deleting file\n"
" path: ~a")))
(1/format
app_0
(host-> host-path_0)))))
(void))
(|#%app|
rktio_open
(unsafe-place-local-ref cell.1)
host-path_0
flags_0)))
fd0_0))))
(begin
(if (vector? fd_0)
(begin
(unsafe-end-atomic)
(raise-filesystem-error
who6_0
fd_0
(let ((app_0
(string-append "~a\n" " path: ~a")))
(let ((app_1
(if (racket-error? fd0_0 4)
"file exists"
(if (racket-error? fd0_0 9)
"path is a directory"
"error opening file"))))
(1/format
app_0
app_1
(host-> host-path_0))))))
(void))
(let ((opened-path_0 (host-> host-path_0)))
(let ((refcount_0 (box (if plus-input?4_0 2 1))))
(let ((op_0
(open-output-fd.1
'infer
unsafe-undefined
refcount_0
unsafe-undefined
fd_0
opened-path_0)))
(let ((ip_0
(if plus-input?4_0
(open-input-fd.1
unsafe-undefined
refcount_0
fd_0
opened-path_0)
#f)))
(begin
(unsafe-end-atomic)
(if (1/port-count-lines-enabled)
(begin
(1/port-count-lines! op_0)
(if plus-input?4_0
(1/port-count-lines! ip_0)
(void)))
(void))
(if plus-input?4_0
(values ip_0 op_0)
op_0))))))))))))))))))))
(mode?_0 'truncate/replace)))
#f)
(let ((r_0
(|#%app|
rktio_delete_file
(unsafe-place-local-ref cell.1)
host-path_0
(1/current-force-delete-permissions))))
(begin
(if (vector? r_0)
(begin
(unsafe-end-atomic)
(raise-filesystem-error
who6_0
r_0
(let ((app_0
(string-append
"error deleting file\n"
" path: ~a")))
(1/format
app_0
(host-> host-path_0)))))
(void))
(|#%app|
rktio_open
(unsafe-place-local-ref cell.1)
host-path_0
flags_0)))
fd0_0))))
(begin
(if (vector? fd_0)
(begin
(unsafe-end-atomic)
(raise-filesystem-error
who6_0
fd_0
(let ((app_0
(string-append "~a\n" " path: ~a")))
(let ((app_1
(if (racket-error? fd0_0 4)
"file exists"
(if (racket-error? fd0_0 9)
"path is a directory"
"error opening file"))))
(1/format
app_0
app_1
(host-> host-path_0))))))
(void))
(let ((opened-path_0 (host-> host-path_0)))
(let ((refcount_0
(box (if plus-input?4_0 2 1))))
(let ((op_0
(open-output-fd.1
'infer
unsafe-undefined
refcount_0
unsafe-undefined
fd_0
opened-path_0)))
(let ((ip_0
(if plus-input?4_0
(open-input-fd.1
unsafe-undefined
refcount_0
fd_0
opened-path_0)
#f)))
(begin
(unsafe-end-atomic)
(if (1/port-count-lines-enabled)
(begin
(1/port-count-lines! op_0)
(if plus-input?4_0
(1/port-count-lines! ip_0)
(void)))
(void))
(if plus-input?4_0
(values ip_0 op_0)
op_0)))))))))))))))))))))
(define DEFAULT-CREATE-PERMS 438)
(define 1/open-output-file
(let ((open-output-file_0
(|#%name|
open-output-file
(lambda (path13_0 mode111_0 mode212_0)
(lambda (path15_0 mode112_0 mode213_0 perms14_0)
(begin
(let ((mode1_0
(if (eq? mode111_0 unsafe-undefined) none$1 mode111_0)))
(if (eq? mode112_0 unsafe-undefined) none$1 mode112_0)))
(let ((mode2_0
(if (eq? mode212_0 unsafe-undefined) none$1 mode212_0)))
(do-open-output-file.1
#f
'open-output-file
path13_0
mode1_0
mode2_0))))))))
(if (eq? mode213_0 unsafe-undefined) none$1 mode213_0)))
(let ((perms_0
(if (eq? perms14_0 unsafe-undefined) 438 perms14_0)))
(do-open-output-file.1
#f
'open-output-file
path15_0
mode1_0
mode2_0
perms_0)))))))))
(|#%name|
open-output-file
(case-lambda
((path_0)
(begin (open-output-file_0 path_0 unsafe-undefined unsafe-undefined)))
((path_0 mode1_0 mode212_0)
(open-output-file_0 path_0 mode1_0 mode212_0))
((path_0 mode111_0)
(open-output-file_0 path_0 mode111_0 unsafe-undefined))))))
(begin
(open-output-file_0
path_0
unsafe-undefined
unsafe-undefined
unsafe-undefined)))
((path_0 mode1_0 mode2_0 perms14_0)
(open-output-file_0 path_0 mode1_0 mode2_0 perms14_0))
((path_0 mode1_0 mode213_0)
(open-output-file_0 path_0 mode1_0 mode213_0 unsafe-undefined))
((path_0 mode112_0)
(open-output-file_0
path_0
mode112_0
unsafe-undefined
unsafe-undefined))))))
(define 1/open-input-output-file
(let ((open-input-output-file_0
(|#%name|
open-input-output-file
(lambda (path16_0 mode114_0 mode215_0)
(lambda (path19_0 mode116_0 mode217_0 perms18_0)
(begin
(let ((mode1_0
(if (eq? mode114_0 unsafe-undefined) none$1 mode114_0)))
(if (eq? mode116_0 unsafe-undefined) none$1 mode116_0)))
(let ((mode2_0
(if (eq? mode215_0 unsafe-undefined) none$1 mode215_0)))
(do-open-output-file.1
#t
'open-input-output-file
path16_0
mode1_0
mode2_0))))))))
(if (eq? mode217_0 unsafe-undefined) none$1 mode217_0)))
(let ((perms_0
(if (eq? perms18_0 unsafe-undefined) 438 perms18_0)))
(do-open-output-file.1
#t
'open-input-output-file
path19_0
mode1_0
mode2_0
perms_0)))))))))
(|#%name|
open-input-output-file
(case-lambda
((path_0)
(begin
(open-input-output-file_0 path_0 unsafe-undefined unsafe-undefined)))
((path_0 mode1_0 mode215_0)
(open-input-output-file_0 path_0 mode1_0 mode215_0))
((path_0 mode114_0)
(open-input-output-file_0 path_0 mode114_0 unsafe-undefined))))))
(open-input-output-file_0
path_0
unsafe-undefined
unsafe-undefined
unsafe-undefined)))
((path_0 mode1_0 mode2_0 perms18_0)
(open-input-output-file_0 path_0 mode1_0 mode2_0 perms18_0))
((path_0 mode1_0 mode217_0)
(open-input-output-file_0 path_0 mode1_0 mode217_0 unsafe-undefined))
((path_0 mode116_0)
(open-input-output-file_0
path_0
mode116_0
unsafe-undefined
unsafe-undefined))))))
(define 1/call-with-input-file
(let ((call-with-input-file_0
(|#%name|
call-with-input-file
(lambda (path18_0 proc19_0 mode17_0)
(lambda (path21_0 proc22_0 mode20_0)
(begin
(let ((mode_0
(if (eq? mode17_0 unsafe-undefined) none$1 mode17_0)))
(if (eq? mode20_0 unsafe-undefined) none$1 mode20_0)))
(begin
(if (path-string? path18_0)
(if (path-string? path21_0)
(void)
(raise-argument-error
'call-with-input-file
"path-string?"
path18_0))
path21_0))
(begin
(if (if (procedure? proc19_0)
(procedure-arity-includes? proc19_0 1)
(if (if (procedure? proc22_0)
(procedure-arity-includes? proc22_0 1)
#f)
(void)
(raise-argument-error
'call-with-input-file
"(procedure-arity-includes/c 1)"
proc19_0))
(let ((i_0 (1/open-input-file path18_0 mode_0)))
proc22_0))
(let ((i_0 (1/open-input-file path21_0 mode_0)))
(begin0
(|#%app| proc19_0 i_0)
(|#%app| proc22_0 i_0)
(1/close-input-port i_0)))))))))))
(|#%name|
call-with-input-file
(case-lambda
((path_0 proc_0)
(begin (call-with-input-file_0 path_0 proc_0 unsafe-undefined)))
((path_0 proc_0 mode17_0)
(call-with-input-file_0 path_0 proc_0 mode17_0))))))
((path_0 proc_0 mode20_0)
(call-with-input-file_0 path_0 proc_0 mode20_0))))))
(define 1/call-with-output-file
(let ((call-with-output-file_0
(|#%name|
call-with-output-file
(lambda (path22_0 proc23_0 mode120_0 mode221_0)
(lambda (path26_0 proc27_0 mode123_0 mode224_0 perms25_0)
(begin
(let ((mode1_0
(if (eq? mode120_0 unsafe-undefined) none$1 mode120_0)))
(if (eq? mode123_0 unsafe-undefined) none$1 mode123_0)))
(let ((mode2_0
(if (eq? mode221_0 unsafe-undefined) none$1 mode221_0)))
(begin
(if (path-string? path22_0)
(void)
(raise-argument-error
'call-with-output-file
"path-string?"
path22_0))
(if (eq? mode224_0 unsafe-undefined) none$1 mode224_0)))
(let ((perms_0
(if (eq? perms25_0 unsafe-undefined) 438 perms25_0)))
(begin
(if (if (procedure? proc23_0)
(procedure-arity-includes? proc23_0 1)
#f)
(if (path-string? path26_0)
(void)
(raise-argument-error
'call-with-output-file
"(procedure-arity-includes/c 1)"
proc23_0))
(let ((o_0
(1/open-output-file path22_0 mode1_0 mode2_0)))
(begin0
(|#%app| proc23_0 o_0)
(1/close-output-port o_0))))))))))))
"path-string?"
path26_0))
(begin
(if (if (procedure? proc27_0)
(procedure-arity-includes? proc27_0 1)
#f)
(void)
(raise-argument-error
'call-with-output-file
"(procedure-arity-includes/c 1)"
proc27_0))
(begin
(if (permissions? perms_0)
(void)
(raise-argument-error
'call-with-output-file
permissions-desc
perms_0))
(let ((o_0
(1/open-output-file
path26_0
mode1_0
mode2_0
perms_0)))
(begin0
(|#%app| proc27_0 o_0)
(1/close-output-port o_0))))))))))))))
(|#%name|
call-with-output-file
(case-lambda
@ -26288,36 +26340,49 @@
path_0
proc_0
unsafe-undefined
unsafe-undefined
unsafe-undefined)))
((path_0 proc_0 mode1_0 mode221_0)
(call-with-output-file_0 path_0 proc_0 mode1_0 mode221_0))
((path_0 proc_0 mode120_0)
(call-with-output-file_0 path_0 proc_0 mode120_0 unsafe-undefined))))))
((path_0 proc_0 mode1_0 mode2_0 perms25_0)
(call-with-output-file_0 path_0 proc_0 mode1_0 mode2_0 perms25_0))
((path_0 proc_0 mode1_0 mode224_0)
(call-with-output-file_0
path_0
proc_0
mode1_0
mode224_0
unsafe-undefined))
((path_0 proc_0 mode123_0)
(call-with-output-file_0
path_0
proc_0
mode123_0
unsafe-undefined
unsafe-undefined))))))
(define 1/with-input-from-file
(let ((with-input-from-file_0
(|#%name|
with-input-from-file
(lambda (path25_0 proc26_0 mode24_0)
(lambda (path29_0 proc30_0 mode28_0)
(begin
(let ((mode_0
(if (eq? mode24_0 unsafe-undefined) none$1 mode24_0)))
(if (eq? mode28_0 unsafe-undefined) none$1 mode28_0)))
(begin
(if (path-string? path25_0)
(if (path-string? path29_0)
(void)
(raise-argument-error
'with-input-from-file
"path-string?"
path25_0))
path29_0))
(begin
(if (if (procedure? proc26_0)
(procedure-arity-includes? proc26_0 0)
(if (if (procedure? proc30_0)
(procedure-arity-includes? proc30_0 0)
#f)
(void)
(raise-argument-error
'with-input-from-file
"(procedure-arity-includes/c 0)"
proc26_0))
(let ((i_0 (1/open-input-file path25_0 mode_0)))
proc30_0))
(let ((i_0 (1/open-input-file path29_0 mode_0)))
(with-continuation-mark*
authentic
parameterization-key
@ -26327,54 +26392,70 @@
i_0)
(dynamic-wind
void
proc26_0
proc30_0
(lambda () (1/close-input-port i_0)))))))))))))
(|#%name|
with-input-from-file
(case-lambda
((path_0 proc_0)
(begin (with-input-from-file_0 path_0 proc_0 unsafe-undefined)))
((path_0 proc_0 mode24_0)
(with-input-from-file_0 path_0 proc_0 mode24_0))))))
((path_0 proc_0 mode28_0)
(with-input-from-file_0 path_0 proc_0 mode28_0))))))
(define 1/with-output-to-file
(let ((with-output-to-file_0
(|#%name|
with-output-to-file
(lambda (path29_0 proc30_0 mode127_0 mode228_0)
(lambda (path34_0 proc35_0 mode131_0 mode232_0 perms33_0)
(begin
(let ((mode1_0
(if (eq? mode127_0 unsafe-undefined) none$1 mode127_0)))
(if (eq? mode131_0 unsafe-undefined) none$1 mode131_0)))
(let ((mode2_0
(if (eq? mode228_0 unsafe-undefined) none$1 mode228_0)))
(begin
(if (path-string? path29_0)
(void)
(raise-argument-error
'with-output-to-file
"path-string?"
path29_0))
(if (eq? mode232_0 unsafe-undefined) none$1 mode232_0)))
(let ((perms_0
(if (eq? perms33_0 unsafe-undefined) 438 perms33_0)))
(begin
(if (if (procedure? proc30_0)
(procedure-arity-includes? proc30_0 0)
#f)
(if (path-string? path34_0)
(void)
(raise-argument-error
'with-output-to-file
"(procedure-arity-includes/c 0)"
proc30_0))
(let ((o_0
(1/open-output-file path29_0 mode1_0 mode2_0)))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-output-port
o_0)
(dynamic-wind
void
proc30_0
(lambda () (1/close-output-port o_0))))))))))))))
"path-string?"
path34_0))
(begin
(if (if (procedure? proc35_0)
(procedure-arity-includes? proc35_0 0)
#f)
(void)
(raise-argument-error
'with-output-to-file
"(procedure-arity-includes/c 0)"
proc35_0))
(begin
(if (permissions? perms_0)
(void)
(raise-argument-error
'with-output-to-file
permissions-desc
perms_0))
(let ((o_0
(1/open-output-file
path34_0
mode1_0
mode2_0
perms_0)))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-output-port
o_0)
(dynamic-wind
void
proc35_0
(lambda ()
(1/close-output-port o_0))))))))))))))))
(|#%name|
with-output-to-file
(case-lambda
@ -26384,11 +26465,24 @@
path_0
proc_0
unsafe-undefined
unsafe-undefined
unsafe-undefined)))
((path_0 proc_0 mode1_0 mode228_0)
(with-output-to-file_0 path_0 proc_0 mode1_0 mode228_0))
((path_0 proc_0 mode127_0)
(with-output-to-file_0 path_0 proc_0 mode127_0 unsafe-undefined))))))
((path_0 proc_0 mode1_0 mode2_0 perms33_0)
(with-output-to-file_0 path_0 proc_0 mode1_0 mode2_0 perms33_0))
((path_0 proc_0 mode1_0 mode232_0)
(with-output-to-file_0
path_0
proc_0
mode1_0
mode232_0
unsafe-undefined))
((path_0 proc_0 mode131_0)
(with-output-to-file_0
path_0
proc_0
mode131_0
unsafe-undefined
unsafe-undefined))))))
(define path-or-fd-identity.1
(|#%name|
path-or-fd-identity
@ -34259,11 +34353,11 @@
'subprocess
"(or/c (and/c output-port? file-stream-port?) #f 'stdout)"
stderr_0))
(let ((lr1323 unsafe-undefined)
(let ((lr1324 unsafe-undefined)
(group_0 unsafe-undefined)
(command_0 unsafe-undefined)
(exact/args_0 unsafe-undefined))
(set! lr1323
(set! lr1324
(call-with-values
(lambda ()
(if (path-string? group/command_0)
@ -34318,9 +34412,9 @@
((group_1 command_1 exact/args_1)
(vector group_1 command_1 exact/args_1))
(args (raise-binding-result-arity-error 3 args)))))
(set! group_0 (unsafe-vector*-ref lr1323 0))
(set! command_0 (unsafe-vector*-ref lr1323 1))
(set! exact/args_0 (unsafe-vector*-ref lr1323 2))
(set! group_0 (unsafe-vector*-ref lr1324 0))
(set! command_0 (unsafe-vector*-ref lr1324 1))
(set! exact/args_0 (unsafe-vector*-ref lr1324 2))
(call-with-values
(lambda ()
(if (if (pair? exact/args_0)

29
racket/src/io/port/file-port.rkt
View File

@ -54,8 +54,13 @@
(port-count-lines! p))
p)
(define (do-open-output-file #:plus-input? [plus-input? #f] who path mode1 mode2)
(define (permissions? perms)
(and (exact-integer? perms) (<= 0 perms 65535)))
(define permissions-desc "(integer-in 0 65535)")
(define (do-open-output-file #:plus-input? [plus-input? #f] who path mode1 mode2 perms)
(check who path-string? path)
(check who permissions? #:contract permissions-desc perms)
(define (mode->flags mode)
(case mode
[(text) RKTIO_OPEN_TEXT]
@ -87,7 +92,7 @@
(mode->flags mode1)
(mode->flags mode2)))
(define fd0
(rktio_open rktio host-path flags))
(rktio_open_with_create_permissions rktio host-path flags perms))
(define fd
(cond
[(not (rktio-error? fd0)) fd0]
@ -135,11 +140,13 @@
(values ip op)
op))
(define/who (open-output-file path [mode1 none] [mode2 none])
(do-open-output-file who path mode1 mode2))
(define DEFAULT-CREATE-PERMS #o666)
(define/who (open-input-output-file path [mode1 none] [mode2 none])
(do-open-output-file #:plus-input? #t who path mode1 mode2))
(define/who (open-output-file path [mode1 none] [mode2 none] [perms DEFAULT-CREATE-PERMS])
(do-open-output-file who path mode1 mode2 perms))
(define/who (open-input-output-file path [mode1 none] [mode2 none] [perms DEFAULT-CREATE-PERMS])
(do-open-output-file #:plus-input? #t who path mode1 mode2 perms))
(define/who (call-with-input-file path proc [mode none])
(check who path-string? path)
@ -149,10 +156,11 @@
(proc i)
(close-input-port i)))
(define/who (call-with-output-file path proc [mode1 none] [mode2 none])
(define/who (call-with-output-file path proc [mode1 none] [mode2 none] [perms DEFAULT-CREATE-PERMS])
(check who path-string? path)
(check who (procedure-arity-includes/c 1) proc)
(define o (open-output-file path mode1 mode2))
(check who permissions? #:contract permissions-desc perms)
(define o (open-output-file path mode1 mode2 perms))
(begin0
(proc o)
(close-output-port o)))
@ -168,10 +176,11 @@
(lambda ()
(close-input-port i)))))
(define/who (with-output-to-file path proc [mode1 none] [mode2 none])
(define/who (with-output-to-file path proc [mode1 none] [mode2 none] [perms DEFAULT-CREATE-PERMS])
(check who path-string? path)
(check who (procedure-arity-includes/c 0) proc)
(define o (open-output-file path mode1 mode2))
(check who permissions? #:contract permissions-desc perms)
(define o (open-output-file path mode1 mode2 perms))
(parameterize ([current-output-port o])
(dynamic-wind
void

2
racket/src/rktio/parse.rkt
View File

@ -88,6 +88,8 @@
[(:seq (:or #\_ (:/ #\A #\Z #\a #\z))
(:* (:or #\_ (:/ #\A #\Z #\a #\z #\0 #\9))))
(token-ID (string->symbol lexeme))]
[(:seq (:? "-") "0" (:+ (:/ "0" "7")))
(token-NUM (string->number lexeme 8))]
[(:seq (:? "-") (:+ (:/ "0" "9")))
(token-NUM (string->number lexeme))]
[(:seq "0x" (:+ (:/ "0" "9") (:/ "A" "F") (:/ "a" "f")))

1
racket/src/rktio/rktio.def
View File

@ -15,6 +15,7 @@ rktio_fd_is_text_converted
rktio_fd_is_pending_open
rktio_fd_modes
rktio_open
rktio_open_with_create_permissions
rktio_close
rktio_close_noerr
rktio_dup

10
racket/src/rktio/rktio.h
View File

@ -227,6 +227,16 @@ RKTIO_EXTERN rktio_fd_t *rktio_open(rktio_t *rktio, rktio_const_string_t src, in
without `RKTIO_OPEN_READ`, then the result may be a file descriptor
in pending-open mode until the read end is opened. */
RKTIO_EXTERN rktio_fd_t *rktio_open_with_create_permissions(rktio_t *rktio,
rktio_const_string_t src,
int modes, int perm_bits);
/* Like `rktio_open`, but accepts permission bits that are used if the
file is created (which is only relevant if `modes` includes
`RKTIO_OPEN_WRITE`). On Unix, perm_bits are adjusted by a umask.
Otherwise, permission bits are treated in the same way as
by `rktio_set_file_or_directory_permissions`. */
#define RKTIO_DEFAULT_PERM_BITS 0666
RKTIO_EXTERN rktio_ok_t rktio_close(rktio_t *rktio, rktio_fd_t *fd);
/* Can report `RKTIO_ERROR_EXISTS` in place of system error,
and can report `RKTIO_ERROR_UNSUPPORTED_TEXT_MODE` on Windows.

1
racket/src/rktio/rktio.inc
View File

@ -15,6 +15,7 @@ Sforeign_symbol("rktio_fd_is_text_converted", (void *)rktio_fd_is_text_converted
Sforeign_symbol("rktio_fd_is_pending_open", (void *)rktio_fd_is_pending_open);
Sforeign_symbol("rktio_fd_modes", (void *)rktio_fd_modes);
Sforeign_symbol("rktio_open", (void *)rktio_open);
Sforeign_symbol("rktio_open_with_create_permissions", (void *)rktio_open_with_create_permissions);
Sforeign_symbol("rktio_close", (void *)rktio_close);
Sforeign_symbol("rktio_close_noerr", (void *)rktio_close_noerr);
Sforeign_symbol("rktio_dup", (void *)rktio_dup);

10
racket/src/rktio/rktio.rktl
View File

@ -15,6 +15,7 @@
(define-constant RKTIO_OPEN_NOT_DIR (<< 1 12))
(define-constant RKTIO_OPEN_INIT (<< 1 13))
(define-constant RKTIO_OPEN_OWN (<< 1 14))
(define-constant RKTIO_DEFAULT_PERM_BITS 438)
(define-constant RKTIO_STDIN 0)
(define-constant RKTIO_STDOUT 1)
(define-constant RKTIO_STDERR 2)
@ -278,6 +279,15 @@
(ref rktio_fd_t)
rktio_open
(((ref rktio_t) rktio) (rktio_const_string_t src) (int modes)))
(define-function/errno
NULL
()
(ref rktio_fd_t)
rktio_open_with_create_permissions
(((ref rktio_t) rktio)
(rktio_const_string_t src)
(int modes)
(int perm_bits)))
(define-function/errno
#f
()

32
racket/src/rktio/rktio_file.c
View File

@ -20,7 +20,7 @@ static rktio_fd_t *finish_unix_fd_creation(rktio_t *rktio, int fd, int modes, rk
#endif
#ifdef RKTIO_USE_PENDING_OPEN
static rktio_fd_t *open_via_thread(rktio_t *rktio, const char *filename, int modes, int flags);
static rktio_fd_t *open_via_thread(rktio_t *rktio, const char *filename, int modes, int flags, int perm_bits);
static int do_pending_open_release(rktio_t *rktio, struct open_in_thread_t *data, int close_fd);
#endif
@ -113,7 +113,7 @@ static rktio_fd_t *open_read(rktio_t *rktio, const char *filename, int modes)
#endif
}
static rktio_fd_t *open_write(rktio_t *rktio, const char *filename, int modes)
static rktio_fd_t *open_write(rktio_t *rktio, const char *filename, int modes, int perm_bits)
{
#ifdef RKTIO_SYSTEM_UNIX
int fd;
@ -130,19 +130,19 @@ static rktio_fd_t *open_write(rktio_t *rktio, const char *filename, int modes)
flags |= O_EXCL;
do {
fd = open(filename, flags | RKTIO_NONBLOCKING | RKTIO_BINARY, 0666);
fd = open(filename, flags | RKTIO_NONBLOCKING | RKTIO_BINARY, perm_bits);
} while ((fd == -1) && (errno == EINTR));
if (errno == ENXIO) {
/* FIFO with no reader? */
#ifdef RKTIO_USE_PENDING_OPEN
return open_via_thread(rktio, filename, modes, flags | RKTIO_BINARY);
return open_via_thread(rktio, filename, modes, flags | RKTIO_BINARY, perm_bits);
#else
/* Try opening in RW mode: */
flags -= O_WRONLY;
flags |= O_RDWR;
do {
fd = open(filename, flags | RKTIO_NONBLOCKING | RKTIO_BINARY, 0666);
fd = open(filename, flags | RKTIO_NONBLOCKING | RKTIO_BINARY, perm_bits);
} while ((fd == -1) && (errno == EINTR));
#endif
}
@ -167,13 +167,16 @@ static rktio_fd_t *open_write(rktio_t *rktio, const char *filename, int modes)
wp = WIDE_PATH_temp(filename);
if (!wp) return NULL;
fd = CreateFileW(wp,
GENERIC_WRITE | ((modes & RKTIO_OPEN_READ) ? GENERIC_READ : 0),
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL,
hmode,
FILE_FLAG_BACKUP_SEMANTICS, /* lets us detect directories in NT */
(FILE_FLAG_BACKUP_SEMANTICS /* lets us detect directories in NT */
| ((perm_bits & RKTIO_PERMISSION_WRITE)
? 0
: FILE_ATTRIBUTE_READONLY)),
NULL);
if (fd == INVALID_HANDLE_VALUE) {
@ -268,14 +271,19 @@ static rktio_fd_t *finish_unix_fd_creation(rktio_t *rktio, int fd, int modes, rk
}
#endif
rktio_fd_t *rktio_open(rktio_t *rktio, const char *filename, int modes)
rktio_fd_t *rktio_open_with_create_permissions(rktio_t *rktio, const char *filename, int modes, int perm_bits)
{
if (modes & RKTIO_OPEN_WRITE)
return open_write(rktio, filename, modes);
return open_write(rktio, filename, modes, perm_bits);
else
return open_read(rktio, filename, modes);
}
rktio_fd_t *rktio_open(rktio_t *rktio, const char *filename, int modes)
{
return rktio_open_with_create_permissions(rktio, filename, modes, RKTIO_DEFAULT_PERM_BITS);
}
/*========================================================================*/
/* File positions */
/*========================================================================*/
@ -435,6 +443,7 @@ typedef struct open_in_thread_t {
pthread_cond_t ready_cond; /* wait until helper thread is ready (including cleanup) */
char *filename;
int flags;
int perm_bits;
int done;
int fd;
int errval;
@ -500,7 +509,7 @@ static void *do_open_in_thread(void *_data)
canceled before `open` returns, but not both (otherwise there
could be a space leak) */
do {
fd = open(data->filename, data->flags, 0666);
fd = open(data->filename, data->flags, data->perm_bits);
} while ((fd == -1) && (errno == EINTR));
pthread_setcanceltype(PTHREAD_CANCEL_DISABLE, NULL);
@ -519,7 +528,7 @@ static void *do_open_in_thread(void *_data)
return NULL;
}
static rktio_fd_t *open_via_thread(rktio_t *rktio, const char *filename, int modes, int flags)
static rktio_fd_t *open_via_thread(rktio_t *rktio, const char *filename, int modes, int flags, int perm_bits)
{
open_in_thread_t *data;
@ -529,6 +538,7 @@ static rktio_fd_t *open_via_thread(rktio_t *rktio, const char *filename, int mod
data->filename = strdup(filename);
data->flags = flags;
data->perm_bits = perm_bits;
pthread_mutex_init(&data->lock, NULL);
pthread_cond_init(&data->ready_cond, NULL);

2
racket/src/version/racket_version.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 8
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x