Byte compilation: handle case where the output file is a mountpoint.

See Bug#44631.  While testing for a readonly output directory has
slightly different semantics, in practice they should cover cases
where Emacs is sandboxed and can only write to the destination file,
not its directory.

* lisp/emacs-lisp/bytecomp.el (byte-compile-file): Handle the case
where the output directory is not writable.

* test/lisp/emacs-lisp/bytecomp-tests.el
(bytecomp-tests--not-writable-directory)
(bytecomp-tests--dest-mountpoint): New unit tests.

2 files changed, 82 insertions, 1 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 51accc08654..e23bb9f5e6e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1963,7 +1963,11 @@ See also `emacs-lisp-byte-compile-and-load'."
           (insert "\n")                 ; aaah, unix.
           (cond
            ((null target-file) nil)     ;We only wanted the warnings!
-           ((file-writable-p target-file)
+           ((and (file-writable-p target-file)
+                 ;; We attempt to create a temporary file in the
+                 ;; target directory, so the target directory must be
+                 ;; writable.
+                 (file-writable-p (file-name-directory target-file)))
             ;; We must disable any code conversion here.
             (let* ((coding-system-for-write 'no-conversion)
                    ;; Write to a tempfile so that if another Emacs
@@ -1992,6 +1996,14 @@ See also `emacs-lisp-byte-compile-and-load'."
               ;; deleting target-file before writing it.
               (rename-file tempfile target-file t))
             (or noninteractive (message "Wrote %s" target-file)))
+           ((file-writable-p target-file)
+            ;; In case the target directory isn't writable (see e.g. Bug#44631),
+            ;; try writing to the output file directly.  We must disable any
+            ;; code conversion here.
+            (let ((coding-system-for-write 'no-conversion))
+              (with-file-modes (logand (default-file-modes) #o666)
+                (write-region (point-min) (point-max) target-file nil 1)))
+            (or noninteractive (message "Wrote %s" target-file)))
            (t
             ;; This is just to give a better error message than write-region
             (let ((exists (file-exists-p target-file)))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 8fa4d278f11..c2a3e3ba117 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -947,6 +947,75 @@ literals (Bug#20852)."
    '((suspicious set-buffer))
    "Warning: Use .with-current-buffer. rather than"))
 
+(ert-deftest bytecomp-tests--not-writable-directory ()
+  "Test that byte compilation works if the output directory isn't
+writable (Bug#44631)."
+  (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+    (unwind-protect
+        (let* ((input-file (expand-file-name "test.el" directory))
+               (output-file (expand-file-name "test.elc" directory))
+               (byte-compile-dest-file-function
+                (lambda (_) output-file))
+               (byte-compile-error-on-warn t))
+          (write-region "" nil input-file nil nil nil 'excl)
+          (write-region "" nil output-file nil nil nil 'excl)
+          (set-file-modes input-file #o400)
+          (set-file-modes output-file #o200)
+          (set-file-modes directory #o500)
+          (should (byte-compile-file input-file))
+          (should (file-regular-p output-file))
+          (should (cl-plusp (file-attribute-size
+                             (file-attributes output-file)))))
+      (with-demoted-errors "Error cleaning up directory: %s"
+        (set-file-modes directory #o700)
+        (delete-directory directory :recursive)))))
+
+(ert-deftest bytecomp-tests--dest-mountpoint ()
+  "Test that byte compilation works if the destination file is a
+mountpoint (Bug#44631)."
+  (let ((bwrap (executable-find "bwrap"))
+        (emacs (expand-file-name invocation-name invocation-directory)))
+    (skip-unless bwrap)
+    (skip-unless (file-executable-p bwrap))
+    (skip-unless (not (file-remote-p bwrap)))
+    (skip-unless (file-executable-p emacs))
+    (skip-unless (not (file-remote-p emacs)))
+    (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+      (unwind-protect
+          (let* ((input-file (expand-file-name "test.el" directory))
+                 (output-file (expand-file-name "test.elc" directory))
+                 (unquoted-file (file-name-unquote output-file))
+                 (byte-compile-dest-file-function
+                  (lambda (_) output-file))
+                 (byte-compile-error-on-warn t))
+            (should-not (file-remote-p input-file))
+            (should-not (file-remote-p output-file))
+            (write-region "" nil input-file nil nil nil 'excl)
+            (write-region "" nil output-file nil nil nil 'excl)
+            (set-file-modes input-file #o400)
+            (set-file-modes output-file #o200)
+            (set-file-modes directory #o500)
+            (with-temp-buffer
+              (let ((status (call-process
+                             bwrap nil t nil
+                             "--ro-bind" "/" "/"
+                             "--bind" unquoted-file unquoted-file
+                             emacs "--quick" "--batch" "--load=bytecomp"
+                             (format "--eval=%S"
+                                     `(setq byte-compile-dest-file-function
+                                            (lambda (_) ,output-file)
+                                            byte-compile-error-on-warn t))
+                             "--funcall=batch-byte-compile" input-file)))
+                (unless (eql status 0)
+                  (ert-fail `((status . ,status)
+                              (output . ,(buffer-string)))))))
+            (should (file-regular-p output-file))
+            (should (cl-plusp (file-attribute-size
+                               (file-attributes output-file)))))
+        (with-demoted-errors "Error cleaning up directory: %s"
+          (set-file-modes directory #o700)
+          (delete-directory directory :recursive))))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End: