commit 1956d98cabd957360317b72be52a9624801a54ef (HEAD, refs/remotes/origin/master) Author: Stephen Gildea Date: Mon Jun 14 23:16:37 2021 -0700 mh-junk need not support SpamAssassin 2.20 from 2003 * lisp/mh-e/mh-junk.el (mh-spamassassin-*list): Remove support for SpamAssassin 2.20. (SpamAssassin 3.0 was released in 2004.) This change updates both the flags for sa-learn and the comments about how the current version works. This change reverts part of a change made in 2003 that added support for what was even then an "old version of spamassassin." diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index e50bf8df50..95a9bb464a 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -175,7 +175,7 @@ classified as spam (see the option `mh-junk-program')." SpamAssassin is one of the more popular spam filtering programs. Get it from your local distribution or from the SpamAssassin web -site at URL `http://spamassassin.org/'. +site at URL `https://spamassassin.apache.org/'. To use SpamAssassin, add the following recipes to \".procmailrc\": @@ -196,7 +196,7 @@ To use SpamAssassin, add the following recipes to * ^X-Spam-Status: Yes spam/. -If you don't use \"spamc\", use \"spamassassin -P -a\". +If you don't use \"spamc\", use \"spamassassin\". Note that one of the recipes above throws away messages with a score greater than or equal to 10. Here's how you can determine a @@ -243,16 +243,7 @@ in the \"blacklist_from\" entries from the last blank line in information can be used so that you can replace multiple \"blacklist_from\" entries with a single wildcard entry such as: - blacklist_from *@*amazingoffersdirect2u.com - -In versions of SpamAssassin (2.50 and on) that support a Bayesian -classifier, \\[mh-junk-blacklist] uses the program \"sa-learn\" -to recategorize the message as spam. Neither MH-E, nor -SpamAssassin, rebuilds the database after adding words, so you -will need to run \"sa-learn --rebuild\" periodically. This can be -done by adding the following to your crontab: - - 0 * * * * sa-learn --rebuild > /dev/null 2>&1" + blacklist_from *@*amazingoffersdirect2u.com" (unless mh-spamassassin-executable (error "Unable to find the spamassassin executable")) (let ((current-folder mh-current-folder) @@ -264,13 +255,13 @@ done by adding the following to your crontab: ;; (this happens if mh-junk-background is t). (with-current-buffer mh-log-buffer (call-process mh-spamassassin-executable msg-file mh-junk-background nil - ;;"--report" "--remove-from-whitelist" - "-r" "-R") ; spamassassin V2.20 + ;; -R removes from allow-list + "--report" "-R") (when mh-sa-learn-executable (message "Recategorizing message %d as spam..." msg) (mh-truncate-log-buffer) (call-process mh-sa-learn-executable msg-file mh-junk-background nil - "--single" "--spam" "--local" "--no-rebuild"))) + "--spam" "--local" "--no-sync"))) (message "Blacklisting sender of message %d..." msg) (with-current-buffer (get-buffer-create mh-temp-buffer) (erase-buffer) @@ -304,8 +295,7 @@ See `mh-spamassassin-blacklist' for more information." (erase-buffer) (message "Removing spamassassin markup from message %d..." msg) (call-process mh-spamassassin-executable msg-file t nil - ;; "--remove-markup" - "-d") ; spamassassin V2.20 + "--remove-markup") (if show-buffer (kill-buffer show-buffer)) (write-file msg-file) @@ -316,7 +306,7 @@ See `mh-spamassassin-blacklist' for more information." ;; (this happens if mh-junk-background is t). (with-current-buffer mh-log-buffer (call-process mh-sa-learn-executable msg-file mh-junk-background nil - "--single" "--ham" "--local" "--no-rebuild"))) + "--ham" "--local" "--no-sync"))) (message "Whitelisting sender of message %d..." msg) (setq from (car (mh-funcall-if-exists commit 794ec934a76d0647a72b7be32e20dc5b95e5ec11 Author: Lars Ingebrigtsen Date: Mon Jun 14 15:58:01 2021 +0200 Remove unused variable from sgml-mode test * test/lisp/textmodes/sgml-mode-tests.el (sgml-test-brackets): Remove unused variable. diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index 39d44e8f68..b4c0186aac 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el @@ -206,7 +206,7 @@ The point is set to the beginning of the buffer." (ert-deftest sgml-test-brackets () "Test fontification of apostrophe preceded by paired-bracket character." - (let (brackets results) + (let (brackets) (map-char-table (lambda (key value) (setq brackets (cons (list commit 00f1a4be719cab4f1a3591ab3321ff34c86af86b Author: Lars Ingebrigtsen Date: Mon Jun 14 15:32:03 2021 +0200 Get fractional seconds in iso8601 parsing right * lisp/calendar/iso8601.el (iso8601-parse-time): Get fractional times (with leading zeroes in the fraction part) right (bug#49017). Fix based on a patch by "J.P." . diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el index 44c4811984..f22f060e20 100644 --- a/lisp/calendar/iso8601.el +++ b/lisp/calendar/iso8601.el @@ -231,17 +231,22 @@ See `decode-time' for the meaning of FORM." (string-to-number (match-string 2 time)))) (second (and (match-string 3 time) (string-to-number (match-string 3 time)))) - (fraction (and (not (zerop (length (match-string 4 time)))) - (string-to-number (match-string 4 time))))) + (frac-string (match-string 4 time)) + fraction fraction-precision) + (when frac-string + ;; Remove trailing zeroes. + (setq frac-string (replace-regexp-in-string "0+\\'" "" frac-string)) + (when (length> frac-string 0) + (setq fraction (string-to-number frac-string) + fraction-precision (length frac-string)))) (when (and fraction (eq form t)) (cond ;; Sub-second time. (second - (let ((digits (1+ (truncate (log fraction 10))))) - (setq second (cons (+ (* second (expt 10 digits)) - fraction) - (expt 10 digits))))) + (setq second (cons (+ (* second (expt 10 fraction-precision)) + fraction) + (expt 10 fraction-precision)))) ;; Fractional minute. (minute (setq second (iso8601--decimalize fraction 60))) diff --git a/test/lisp/calendar/iso8601-tests.el b/test/lisp/calendar/iso8601-tests.el index 618e5b1238..c4d038ab68 100644 --- a/test/lisp/calendar/iso8601-tests.el +++ b/test/lisp/calendar/iso8601-tests.el @@ -183,7 +183,15 @@ (should (equal (iso8601-parse-time "15:27:35.123" t) '((35123 . 1000) 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15:27:35.123456789" t) - '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil)))) + '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil))) + (should (equal (iso8601-parse-time "15:27:35.012345678" t) + '((35012345678 . 1000000000) 27 15 nil nil nil nil -1 nil))) + (should (equal (iso8601-parse-time "15:27:35.00001" t) + '((3500001 . 100000) 27 15 nil nil nil nil -1 nil))) + (should (equal (iso8601-parse-time "15:27:35.0000100" t) + '((3500001 . 100000) 27 15 nil nil nil nil -1 nil))) + (should (equal (iso8601-parse-time "15:27:35.0" t) + '(35 27 15 nil nil nil nil -1 nil)))) (ert-deftest standard-test-time-of-day-beginning-of-day () (should (equal (iso8601-parse-time "000000") commit 663fb3b774887d3d15a6791c3f35af56daa3c676 Author: Andrea Corallo Date: Mon Jun 14 14:37:14 2021 +0200 * Do not produce .elc temporary file when unnecessary (bug#48978) * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Produce .elc temporary files only when non native compiling or when native compiling but `byte+native-compile' is non nil. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 909a1b4412..5ed6bfeddc 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2067,16 +2067,17 @@ See also `emacs-lisp-byte-compile-and-load'." (insert "\n") ; aaah, unix. (cond ((null target-file) nil) ;We only wanted the warnings! - ((or byte-native-compiling - (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 - ;; Need to expand in case TARGET-FILE doesn't - ;; include a directory (Bug#45287). - (expand-file-name target-file))))) + ((and (or (null byte-native-compiling) + (and byte-native-compiling byte+native-compile)) + (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 + ;; Need to expand in case TARGET-FILE doesn't + ;; include a directory (Bug#45287). + (expand-file-name 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 @@ -2105,11 +2106,9 @@ See also `emacs-lisp-byte-compile-and-load'." ;; recompiled). Previously this was accomplished by ;; deleting target-file before writing it. (if byte-native-compiling - (if byte+native-compile - ;; Defer elc final renaming. - (setf byte-to-native-output-file - (cons tempfile target-file)) - (delete-file tempfile)) + ;; Defer elc final renaming. + (setf byte-to-native-output-file + (cons tempfile target-file)) (rename-file tempfile target-file t))) (or noninteractive byte-native-compiling commit 8f2f91f7acf5792f0dc38f8045dc0d3ffe2e4593 Author: Stephen Berman Date: Mon Jun 14 14:57:57 2021 +0200 Fix problem in HTML with bracketed characters * lisp/textmodes/sgml-mode.el (sgml-tag-syntax-table): Use bracket syntax for all Unicode bracket characters (bug#43941). diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index d5930e82df..fda00ec367 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -190,8 +190,19 @@ This takes effect when first loading the `sgml-mode' library.") "Syntax table used in SGML mode. See also `sgml-specials'.") (defconst sgml-tag-syntax-table - (let ((table (sgml-make-syntax-table sgml-specials))) - (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) + (let ((table (sgml-make-syntax-table sgml-specials)) + brackets) + (map-char-table + (lambda (key value) + (setq brackets (cons (list + (if (consp key) + (list (car key) (cdr key)) + key) + value) + brackets))) + (unicode-property-table-internal 'paired-bracket)) + (setq brackets (delete-dups (flatten-tree brackets))) + (dolist (char (append brackets (list ?$ ?% ?& ?* ?+ ?/))) (modify-syntax-entry char "." table)) (unless (memq ?' sgml-specials) ;; Avoid that skipping a tag backwards skips any "'" prefixing it. diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index 697c96c78e..39d44e8f68 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el @@ -204,5 +204,32 @@ The point is set to the beginning of the buffer." (should (= 1 (- (car (syntax-ppss (1- (point-max)))) (car (syntax-ppss (point-max)))))))) +(ert-deftest sgml-test-brackets () + "Test fontification of apostrophe preceded by paired-bracket character." + (let (brackets results) + (map-char-table + (lambda (key value) + (setq brackets (cons (list + (if (consp key) + (list (car key) (cdr key)) + key) + value) + brackets))) + (unicode-property-table-internal 'paired-bracket)) + (setq brackets (delete-dups (flatten-tree brackets))) + (setq brackets (append brackets (list ?$ ?% ?& ?* ?+ ?/))) + (with-temp-buffer + (while brackets + (let ((char (string (pop brackets)))) + (insert (concat "

" char "'s

\n")))) + (html-mode) + (font-lock-ensure (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (next-single-char-property-change (point) 'face)) + (let ((val (get-text-property (point) 'face))) + (when val + (should-not (eq val 'font-lock-string-face)))))))) + (provide 'sgml-mode-tests) ;;; sgml-mode-tests.el ends here commit 31d40cab780a5a65e9bfbff590390a94921d6ee1 Author: Andrea Corallo Date: Mon Jun 14 14:17:33 2021 +0200 ;* lisp/emacs-lisp/bytecomp.el (byte-native-compiling): Typo fix. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3d3a285a0d..909a1b4412 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -603,7 +603,7 @@ Each element is (INDEX . VALUE)") form lexical) (defvar byte-native-compiling nil - "Non nil while native compiling.") + "Non-nil while native compiling.") (defvar byte-native-qualities nil "To spill default qualities from the compiled file.") (defvar byte+native-compile nil commit 9389742eb61083b8ee789b95c4ed5683aeaf287c Author: Andrea Corallo Date: Mon Jun 14 14:17:04 2021 +0200 * lisp/emacs-lisp/bytecomp.el (byte+native-compile): Update docstring. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 96a0da924f..3d3a285a0d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -607,11 +607,7 @@ Each element is (INDEX . VALUE)") (defvar byte-native-qualities nil "To spill default qualities from the compiled file.") (defvar byte+native-compile nil - "Non nil while compiling for bootstrap." - ;; During bootstrap we produce both the .eln and the .elc together. - ;; Because the make target is the later this has to be produced as - ;; last to be resilient against build interruptions. -) + "Non-nil while producing at the same time byte and native code.") (defvar byte-to-native-lambdas-h nil "Hash byte-code -> byte-to-native-lambda.") (defvar byte-to-native-top-level-forms nil commit 6536112bdce592eed9f3d71022aafbe6be44da45 Author: Michael Albinus Date: Mon Jun 14 11:25:13 2021 +0200 Handle sensitive auto-save or backup remote files (Bug#45245) * doc/misc/tramp.texi (Auto-save and Backup): Describe tramp-allow-unsafe-temporary-files. (Ad-hoc multi-hops): Use proper format. * etc/NEWS: Mention confirmation for writing sensitive auto-save or backup remote files to the local temporary directory.. * lisp/net/tramp-cache.el (tramp-dump-connection-properties): Strengthen test. * lisp/net/tramp.el (tramp-allow-unsafe-temporary-files): New defcustom. (tramp-handle-find-backup-file-name) (tramp-handle-make-auto-save-file-name): Don't expose sensible auto-save or backup files on local temporary directory. (Bug#45245) * test/lisp/net/tramp-tests.el (tramp--test-always): New defalias. (tramp-test10-write-region, tramp-test21-file-links) (tramp--test--deftest-direct-async-process): Use it. (tramp-test37-make-auto-save-file-name) (tramp-test38-find-backup-file-name): Extend tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e5a0bb9a8b..6ef9459077 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1261,7 +1261,7 @@ uses @file{@trampfn{mtp,,}} as the default name. As the name indicates, the method @option{nextcloud} allows you to access OwnCloud or NextCloud hosted files and directories. Like the @option{gdrive} method, your credentials must be populated in your -@command{Online Accounts} application outside Emacs. The method +@command{Online Accounts} application outside Emacs. The method supports port numbers. @item @option{sftp} @@ -2842,6 +2842,13 @@ auto-saved files to the same directory as the original file. Alternatively, set the user option @code{tramp-auto-save-directory} to direct all auto saves to that location. +@vindex tramp-allow-unsafe-temporary-files +Per default, @value{tramp} asks for confirmation if a +@samp{root}-owned backup or auto-save remote file has to be written to +your local temporary directory. If you want to suppress this +confirmation question, set user option +@code{tramp-allow-unsafe-temporary-files} to @code{t}. + @node Keeping files encrypted @section Protect remote files by encryption @@ -3309,12 +3316,12 @@ For ad-hoc definitions to be saved automatically in Ad-hoc proxies can take patterns @code{%h} or @code{%u} like in @code{tramp-default-proxies-alist}. The following file name expands -to user @code{root} on host @code{remotehost}, starting with an -@option{ssh} session on host @code{remotehost}: +to user @samp{root} on host @samp{remotehost}, starting with an +@option{ssh} session on host @samp{remotehost}: @samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}. On the other hand, if a trailing hop does not specify a host name, -the host name of the previous hop is reused. Therefore, the following +the host name of the previous hop is reused. Therefore, the following file name is equivalent to the previous example: @samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}. @@ -5294,7 +5301,7 @@ attributes cache in its process sentinel with this code: @end lisp Since @value{tramp} traverses subdirectories starting with the -root-directory, it is most likely sufficient to make the +root directory, it is most likely sufficient to make the @code{default-directory} of the process buffer as the root directory. diff --git a/etc/NEWS b/etc/NEWS index 4fe95ddc26..367cd5972a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -605,7 +605,7 @@ These options include 'windmove-default-keybindings', ** Windows +++ -*** New option 'delete-window-choose-selected'. +*** New user option 'delete-window-choose-selected'. This allows to choose a frame's selected window after deleting the previously selected one. @@ -1403,6 +1403,11 @@ When non-nil, this user option instructs Tramp to mirror the debug buffer to a file under the "/tmp/" directory. This is useful, if (in rare cases) Tramp blocks Emacs, and we need further debug information. ++++ +*** Writing sensitive auto-save or backup files to the local temporary +directory must be confirmed. In order to suppress this confirmation, +set user option 'tramp-allow-unsafe-temporary-files' to t. + ** Tempo --- diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index fdde7fbe44..a41620ab9f 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -70,7 +70,8 @@ ;; process key retrieved by `tramp-get-process' (the main connection ;; process). Other processes could reuse these properties, avoiding ;; recomputation when a new asynchronous process is created by -;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el). +;; `make-process'. Examples are "remote-path", +;; "unsafe-temporary-file" or "device" (tramp-adb.el). ;;; Code: @@ -470,11 +471,11 @@ used to cache connection properties of the local machine." ;; don't save either, because all other properties might ;; depend on the login name, and we want to give the ;; possibility to use another login name later on. Key - ;; "started" exists for the "ftp" method only, which must be + ;; "started" exists for the "ftp" method only, which must not ;; be kept persistent. (maphash (lambda (key value) - (if (and (tramp-file-name-p key) value + (if (and (tramp-file-name-p key) (hash-table-p value) (not (string-equal (tramp-file-name-method key) tramp-archive-method)) (not (tramp-file-name-localname key)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 29ed944b8b..b613ad3f8e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5296,8 +5296,7 @@ Nonexistent directories are removed from spec." ;; cache the result for the session only. Otherwise, the ;; result is cached persistently. (if (memq 'tramp-own-remote-path tramp-remote-path) - (tramp-get-process vec) - vec) + (tramp-get-process vec) vec) "remote-path" (let* ((remote-path (copy-tree tramp-remote-path)) (elt1 (memq 'tramp-default-remote-path remote-path)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 838464e88b..5284981961 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3627,6 +3627,11 @@ User is always nil." (and (file-directory-p (file-name-directory filename)) (file-writable-p (file-name-directory filename))))))) +(defcustom tramp-allow-unsafe-temporary-files nil + "Whether root-owned auto-save or backup files can be written to \"/tmp\"." + :version "28.1" + :type 'boolean) + (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil @@ -3642,8 +3647,25 @@ User is always nil." (tramp-make-tramp-file-name v (cdr x)) (cdr x)))) tramp-backup-directory-alist) - backup-directory-alist))) - (tramp-run-real-handler #'find-backup-file-name (list filename))))) + backup-directory-alist)) + (uid (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer))) + result) + (prog1 ;; Run plain `find-backup-file-name'. + (setq result + (tramp-run-real-handler + #'find-backup-file-name (list filename))) + ;; Protect against security hole. + (when (and (natnump uid) (zerop uid) + (file-in-directory-p (car result) temporary-file-directory) + (not tramp-allow-unsafe-temporary-files) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Backup file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -5225,37 +5247,52 @@ Return the local name of the temporary file." "Like `make-auto-save-file-name' for Tramp files. Returns a file name in `tramp-auto-save-directory' for autosaving this file, if that variable is non-nil." - (when (stringp tramp-auto-save-directory) - (setq tramp-auto-save-directory - (expand-file-name tramp-auto-save-directory))) - ;; Create directory. - (unless (or (null tramp-auto-save-directory) - (file-exists-p tramp-auto-save-directory)) - (make-directory tramp-auto-save-directory t)) - - (let ((system-type - (if (and (stringp tramp-auto-save-directory) - (tramp-tramp-file-p tramp-auto-save-directory)) - 'not-windows - system-type)) - (auto-save-file-name-transforms - (if (null tramp-auto-save-directory) - auto-save-file-name-transforms)) - (buffer-file-name - (if (null tramp-auto-save-directory) - buffer-file-name - (expand-file-name - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - (tramp-compat-file-name-unquote (buffer-file-name))) - tramp-auto-save-directory)))) - ;; Run plain `make-auto-save-file-name'. - (tramp-run-real-handler #'make-auto-save-file-name nil))) + (with-parsed-tramp-file-name buffer-file-name nil + (when (stringp tramp-auto-save-directory) + (setq tramp-auto-save-directory + (expand-file-name tramp-auto-save-directory))) + ;; Create directory. + (unless (or (null tramp-auto-save-directory) + (file-exists-p tramp-auto-save-directory)) + (make-directory tramp-auto-save-directory t)) + + (let ((system-type + (if (and (stringp tramp-auto-save-directory) + (tramp-tramp-file-p tramp-auto-save-directory)) + 'not-windows + system-type)) + (auto-save-file-name-transforms + (if (null tramp-auto-save-directory) + auto-save-file-name-transforms)) + (uid (tramp-compat-file-attribute-user-id + (file-attributes buffer-file-name 'integer))) + (buffer-file-name + (if (null tramp-auto-save-directory) + buffer-file-name + (expand-file-name + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-compat-file-name-unquote (buffer-file-name))) + tramp-auto-save-directory))) + result) + (prog1 ;; Run plain `make-auto-save-file-name'. + (setq result (tramp-run-real-handler #'make-auto-save-file-name nil)) + ;; Protect against security hole. + (when (and (natnump uid) (zerop uid) + (file-in-directory-p result temporary-file-directory) + (not tramp-allow-unsafe-temporary-files) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Autosave file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe autosave file name")))))) (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 5e4626ab41..37cd701161 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -229,6 +229,16 @@ is greater than 10. "%s %f sec" ,message (float-time (time-subtract (current-time) start)))))) +;; `always' is introduced with Emacs 28.1. +(defalias 'tramp--test-always + (if (fboundp 'always) + #'always + (lambda (&rest _arguments) + "Do nothing and return t. +This function accepts any number of ARGUMENTS, but ignores them. +Also see `ignore'." + t))) + (ert-deftest tramp-test00-availability () "Test availability of Tramp functions." :expected-result (if (tramp--test-enabled) :passed :failed) @@ -2454,9 +2464,9 @@ This checks also `file-name-as-directory', `file-name-directory', tramp--test-messages)))))))) ;; Do not overwrite if excluded. - (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t)) + (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) ;; Ange-FTP. - ((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + ((symbol-function 'yes-or-no-p) #'tramp--test-always)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) ;; `mustbenew' is passed to Tramp since Emacs 26.1. (when (tramp--test-emacs26-p) @@ -3671,7 +3681,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (make-symbolic-link tmp-name1 tmp-name2 0) :type 'file-already-exists))) - (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) (make-symbolic-link tmp-name1 tmp-name2 0) (should (string-equal @@ -3747,7 +3757,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (add-name-to-file tmp-name1 tmp-name2 0) :type 'file-already-exists)) - (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) (add-name-to-file tmp-name1 tmp-name2 0) (should (file-regular-p tmp-name2))) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) @@ -4545,7 +4555,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." If UNSTABLE is non-nil, the test is tagged as `:unstable'." (declare (indent 1)) ;; `make-process' supports file name handlers since Emacs 27. - (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t))))) + (when (let ((file-name-handler-alist '(("" . #'tramp--test-always)))) (ignore-errors (make-process :file-handler t))) `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) () ,docstring @@ -4561,7 +4571,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; `file-truename' does it by side-effect. Suppress ;; `tramp--test-enabled', in order to keep the connection. ;; Suppress "Process ... finished" messages. - (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t)) + (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) ((symbol-function #'internal-default-process-sentinel) #'ignore)) (file-truename tramp-test-temporary-file-directory) @@ -5554,11 +5564,38 @@ Use direct async.") ("]" . "_r")) (tramp-compat-file-name-unquote tmp-name1))) tmp-name2))) - (should (file-directory-p tmp-name2)))))) + (should (file-directory-p tmp-name2))))) + + ;; Create temporary file. This shall check for sensible + ;; files, owned by root. + (let ((tramp-auto-save-directory temporary-file-directory) + tramp-allow-unsafe-temporary-files) + (write-region "foo" nil tmp-name1) + (when (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1)) + tramp-unknown-id-integer)) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (let ((tramp-allow-unsafe-temporary-files t)) + (should (stringp (make-auto-save-file-name)))) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) + (should-error + (make-auto-save-file-name) + :type 'file-error)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) + #'tramp--test-always)) + (should (stringp (make-auto-save-file-name)))))))) ;; Cleanup. (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-directory tmp-name2 'recursive)))))) + (ignore-errors (delete-directory tmp-name2 'recursive)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) (ert-deftest tramp-test38-find-backup-file-name () "Check `find-backup-file-name'." @@ -5672,7 +5709,37 @@ Use direct async.") (should (file-directory-p tmp-name2)))) ;; Cleanup. - (ignore-errors (delete-directory tmp-name2 'recursive)))))) + (ignore-errors (delete-directory tmp-name2 'recursive))) + + (unwind-protect + ;; Create temporary file. This shall check for sensible + ;; files, owned by root. + (let ((backup-directory-alist `(("." . ,temporary-file-directory))) + tramp-allow-unsafe-temporary-files + tramp-backup-directory-alist) + (write-region "foo" nil tmp-name1) + (when (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1)) + tramp-unknown-id-integer)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (let ((tramp-allow-unsafe-temporary-files t)) + (should (stringp (car (find-backup-file-name tmp-name1))))) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) + (should-error + (find-backup-file-name tmp-name1) + :type 'file-error)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) + #'tramp--test-always)) + (should (stringp (car (find-backup-file-name tmp-name1))))))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test39-make-nearby-temp-file ()