mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-28 16:21:07 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source 
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.
This commit is contained in:
Philipp Stephani 2020-12-13 17:13:50 +01:00
parent 897b8561cd
commit fe50a8b9ba
2 changed files with 82 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/bytecomp.el
View file

@ -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)))

69
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -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: