unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
blob 703b6e8e825dcbff11f62cdbd13e5d11dd985ade 3148 bytes (raw)
name: gnu/packages/patches/racket-backport-8.7-pkg-strip.patch 	 # note: path name is non-authoritative(*)

 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


debug log:

solving 703b6e8e82 ...
found 703b6e8e82 in https://git.savannah.gnu.org/cgit/guix.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).