From 185b0820b83b2021b4223c443effdd35be0adc2a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Dec 2020 19:19:03 -0500 Subject: * lisp/emacs-lisp/bytecomp.el: Allow a nil destination file (byte-compile--default-dest-file): New function, extracted from byte-compile-dest-file. (byte-compile-dest-file): Use it. (byte-compile-dest-file-function): Give it a non-nil default value. (byte-recompile-file, byte-compile-file): Handle a nil return value from `byte-compile-dest-file`. * lisp/progmodes/elisp-mode.el (elisp-flymake--batch-compile-for-flymake): Tell the compiler not to write the result, instead of writing it to a dummy temp file. --- lisp/emacs-lisp/bytecomp.el | 119 +++++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 58 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0acd5276977..51accc08654 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)" ;; Eg is_elc in Fload. :type 'regexp) -(defcustom byte-compile-dest-file-function nil +(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file "Function for the function `byte-compile-dest-file' to call. It should take one argument, the name of an Emacs Lisp source file name, and return the name of the compiled file. @@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension \".el\"), replaces the matching part (and anything after it) with \".elc\"; otherwise adds \".elc\"." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc"))))) -) + (funcall (or byte-compile-dest-file-function + #'byte-compile--default-dest-file) + filename))) + +(defun byte-compile--default-dest-file (filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") @@ -1809,24 +1811,23 @@ If compilation is needed, this functions returns the result of (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults (filename (expand-file-name filename))) - (if (if (file-exists-p dest) - ;; File was already compiled - ;; Compile if forced to, or filename newer - (or force - (file-newer-than-file-p filename dest)) - (and arg - (or (eq 0 arg) - (y-or-n-p (concat "Compile " - filename "? "))))) - (progn - (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." filename)) - (byte-compile-file filename) - (when load - (load (if (file-exists-p dest) dest filename)))) + (prog1 + (if (if (and dest (file-exists-p dest)) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or force + (file-newer-than-file-p filename dest)) + (and arg + (or (eq 0 arg) + (y-or-n-p (concat "Compile " + filename "? "))))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." filename)) + (byte-compile-file filename)) + 'no-byte-compile) (when load - (load (if (file-exists-p dest) dest filename))) - 'no-byte-compile))) + (load (if (and dest (file-exists-p dest)) dest filename)))))) (defun byte-compile--load-dynvars (file) (and file (not (equal file "")) @@ -1936,7 +1937,7 @@ See also `emacs-lisp-byte-compile-and-load'." ;; (message "%s not compiled because of `no-byte-compile: %s'" ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) - (when (file-exists-p target-file) + (when (and target-file (file-exists-p target-file)) (message "%s deleted because of `no-byte-compile: %s'" (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) @@ -1960,36 +1961,38 @@ See also `emacs-lisp-byte-compile-and-load'." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) - ;; We must disable any code conversion here. - (progn - (let* ((coding-system-for-write 'no-conversion) - ;; Write to a tempfile so that if another Emacs - ;; process is trying to load target-file (eg in a - ;; parallel bootstrap), it does not risk getting a - ;; half-finished file. (Bug#4196) - (tempfile - (make-temp-file (expand-file-name target-file))) - (default-modes (default-file-modes)) - (temp-modes (logand default-modes #o600)) - (desired-modes (logand default-modes #o666)) - (kill-emacs-hook - (cons (lambda () (ignore-errors - (delete-file tempfile))) - kill-emacs-hook))) - (unless (= temp-modes desired-modes) - (set-file-modes tempfile desired-modes 'nofollow)) - (write-region (point-min) (point-max) tempfile nil 1) - ;; This has the intentional side effect that any - ;; hard-links to target-file continue to - ;; point to the old file (this makes it possible - ;; for installed files to share disk space with - ;; the build tree, without causing problems when - ;; emacs-lisp files in the build tree are - ;; recompiled). Previously this was accomplished by - ;; deleting target-file before writing it. - (rename-file tempfile target-file t)) - (or noninteractive (message "Wrote %s" target-file))) + (cond + ((null target-file) nil) ;We only wanted the warnings! + ((file-writable-p 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 + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile + (make-temp-file (expand-file-name target-file))) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes #o666)) + (kill-emacs-hook + (cons (lambda () (ignore-errors + (delete-file tempfile))) + kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes 'nofollow)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t)) + (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))) (signal (if exists 'file-error 'file-missing) @@ -1997,7 +2000,7 @@ See also `emacs-lisp-byte-compile-and-load'." (if exists "Cannot overwrite file" "Directory not writable or nonexistent") - target-file)))) + target-file))))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) -- cgit v1.2.3 From fe50a8b9ba79b4ac14a3a352d8bf84eaee4f2122 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 13 Dec 2020 17:13:50 +0100 Subject: 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. --- lisp/emacs-lisp/bytecomp.el | 14 ++++++- test/lisp/emacs-lisp/bytecomp-tests.el | 69 ++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/bytecomp.el') 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: -- cgit v1.2.3