guix/gnu/packages/patches/racket-backport-8.7-pkg-strip.patch

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