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
|
From 1b7e15c23baf1fda44b1d0752902ddea11419fc5 Mon Sep 17 00:00:00 2001
From: Philip McGrath <philip@philipmcgrath.com>
Date: Fri, 7 Oct 2022 02:15:13 -0400
Subject: [PATCH] pkg/strip: handle read-only input
A package directory supplied to the functions from `pkg/strip` might
have had all of its write permission bits unset. Since `copy-file`
preserves the permissions of the source file, we may end up with a
read-only file that we want to overwrite (e.g. an `info.rkt` file).
Explicitly setting `user-write-bit` before writing avoids this problem.
Conservatively, we only set the permissions when actually needed,
and we restore the original permissions when we are done.
(cherry picked from commit 8c647c8cc9b66112198fcf9bea27fc0e3737162f)
---
racket/collects/pkg/strip.rkt | 35 +++++++++++++++++++++++++++++------
1 file changed, 29 insertions(+), 6 deletions(-)
diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt
index 0ff58cea02..5899dbc6e6 100644
--- a/racket/collects/pkg/strip.rkt
+++ b/racket/collects/pkg/strip.rkt
@@ -306,9 +306,8 @@
#t
new-mod*-subs))))
(unless (eq? mod new-mod)
- (call-with-output-file*
+ (call-with-output-file/writable
new-p
- #:exists 'truncate/replace
(lambda (out) (write new-mod out)))))
(define (fixup-local-redirect-reference p js-path #:user [user-js-path js-path])
@@ -340,9 +339,8 @@
(string->bytes/utf-8 user-js-path)
(subbytes s (+ delta end2)))]
[else s]))))
- (call-with-output-file*
+ (call-with-output-file/writable
p
- #:exists 'truncate/replace
(lambda (out) (write-bytes new-bstr out)))))
;; Used in binary[-lib] mode:
@@ -383,9 +381,8 @@
(convert-mod info-lib defns)]))
(unless (equal? new-content content)
;; write updated:
- (call-with-output-file*
+ (call-with-output-file/writable
new-p
- #:exists 'truncate
(lambda (out)
(write new-content out)
(newline out)))
@@ -503,3 +500,29 @@
which
dir)
(current-continuation-marks)))))
+
+(define (call-with-output-file/writable pth proc)
+ ;; In case `pth` was copied from a file without the user-write-bit set,
+ ;; explicitly make it writable while we overwrite it.
+ (define (run)
+ (call-with-output-file* pth
+ #:exists 'truncate/replace
+ proc))
+ (cond
+ [(file-exists? pth)
+ (define old-mode
+ (file-or-directory-permissions pth 'bits))
+ (define new-mode
+ (if (eq? (system-type) 'windows)
+ (bitwise-ior old-mode user-write-bit group-write-bit other-write-bit)
+ (bitwise-ior old-mode user-write-bit)))
+ (if (= old-mode new-mode)
+ (run)
+ (dynamic-wind
+ (λ ()
+ (file-or-directory-permissions pth new-mode))
+ run
+ (λ ()
+ (file-or-directory-permissions pth old-mode))))]
+ [else
+ (run)]))
base-commit: 7e4f6e2362d4a08affbbae3c7ee4b98e325274c6
--
2.38.0
|
