commit 8a6521260dc650b4b713ea8bc71348cbe730f6e4 (HEAD, refs/remotes/origin/master) Author: Marco Wahl Date: Fri Apr 27 13:50:08 2018 +0200 Fix next-page for dired (Bug#31061) * lisp/textmodes/page-ext.el (next-page): Don't go back any pages if COUNT is 0. For negative COUNT, end with point just after the last delimiter. Co-authored-by: Noam Postavsky diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index fbdae5892a..92fce4d364 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -304,19 +304,21 @@ With arg (prefix if interactive), move that many pages." (or count (setq count 1)) (widen) ;; Cannot use forward-page because of problems at page boundaries. - (while (and (> count 0) (not (eobp))) - (if (re-search-forward page-delimiter nil t) - nil - (goto-char (point-max))) - (setq count (1- count))) - ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries. - ;; The first page boundary we reach is the top of the current page, - ;; which doesn't count. - (while (and (< count 1) (not (bobp))) - (if (re-search-backward page-delimiter nil t) - (goto-char (match-beginning 0)) - (goto-char (point-min))) - (setq count (1+ count))) + (if (>= count 0) + (while (and (> count 0) (not (eobp))) + (if (re-search-forward page-delimiter nil t) + nil + (goto-char (point-max))) + (setq count (1- count))) + ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries. + ;; The first page boundary we reach is the top of the current page, + ;; which doesn't count. + (while (and (< count 1) (not (bobp))) + (if (re-search-backward page-delimiter nil t) + (when (= count 0) + (goto-char (match-end 0))) + (goto-char (point-min))) + (setq count (1+ count)))) (narrow-to-page) (goto-char (point-min)) (recenter 0)) commit 74ff5ade8002a1a2cc8956607310e5466f2ed596 Author: Basil L. Contovounesios Date: Mon Apr 30 00:58:32 2018 +0100 Minor simple.el simplifications (Bug#31211) * lisp/simple.el (kill-append, push-mark, pop-mark): Simplify conditionals and surrounding code. diff --git a/lisp/simple.el b/lisp/simple.el index 9fde9a5c90..a0a6898e17 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4423,20 +4423,20 @@ If `interprogram-cut-function' is non-nil, call it with the resulting kill. If `kill-append-merge-undo' is non-nil, remove the last undo boundary in the current buffer." - (let* ((cur (car kill-ring))) + (let ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) - (or (= (length cur) 0) - (equal nil (get-text-property 0 'yank-handler cur)))) - (when (and kill-append-merge-undo (not buffer-read-only)) - (let ((prev buffer-undo-list) - (next (cdr buffer-undo-list))) - ;; find the next undo boundary - (while (car next) - (pop next) - (pop prev)) - ;; remove this undo boundary - (when prev - (setcdr prev (cdr next))))))) + (or (string= cur "") + (null (get-text-property 0 'yank-handler cur))))) + (when (and kill-append-merge-undo (not buffer-read-only)) + (let ((prev buffer-undo-list) + (next (cdr buffer-undo-list))) + ;; Find the next undo boundary. + (while (car next) + (pop next) + (pop prev)) + ;; Remove this undo boundary. + (when prev + (setcdr prev (cdr next)))))) (defcustom yank-pop-change-selection nil "Whether rotating the kill ring changes the window system selection. @@ -5713,19 +5713,17 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information. In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." - (unless (null (mark t)) + (when (mark t) (let ((old (nth mark-ring-max mark-ring)) (history-delete-duplicates nil)) (add-to-history 'mark-ring (copy-marker (mark-marker)) mark-ring-max t) (when old (set-marker old nil)))) (set-marker (mark-marker) (or location (point)) (current-buffer)) - ;; Now push the mark on the global mark ring. - (if (and global-mark-ring - (eq (marker-buffer (car global-mark-ring)) (current-buffer))) - ;; The last global mark pushed was in this same buffer. - ;; Don't push another one. - nil + ;; Don't push the mark on the global mark ring if the last global + ;; mark pushed was in this same buffer. + (unless (and global-mark-ring + (eq (marker-buffer (car global-mark-ring)) (current-buffer))) (let ((old (nth global-mark-ring-max global-mark-ring)) (history-delete-duplicates nil)) (add-to-history @@ -5743,10 +5741,10 @@ In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." Does not set point. Does nothing if mark ring is empty." (when mark-ring (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) - (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) - (move-marker (car mark-ring) nil) - (if (null (mark t)) (ding)) - (setq mark-ring (cdr mark-ring))) + (set-marker (mark-marker) (car mark-ring)) + (set-marker (car mark-ring) nil) + (unless (mark t) (ding)) + (pop mark-ring)) (deactivate-mark)) (define-obsolete-function-alias commit f2c74543edc7e8d07655b459ba8898eec9b6d4e8 Author: Basil L. Contovounesios Date: Sun Apr 29 15:37:45 2018 +0100 Fix off-by-one history pruning (bug#31211) * lisp/subr.el (add-to-history): Clarify docstring. Protect against negative history-length and unnecessary variable modification, as per read_minibuf. * lisp/ido.el (ido-record-command): * lisp/international/mule-cmds.el (deactivate-input-method): (set-language-environment-input-method): * lisp/isearch.el (isearch-done): * lisp/minibuffer.el (read-file-name-default): * lisp/net/eww.el (eww-save-history): * lisp/simple.el (edit-and-eval-command, repeat-complex-command): (command-execute, kill-new, push-mark): * src/callint.c (Fcall_interactively): * src/minibuf.c (read_minibuf): Delegate to add-to-history. * test/lisp/simple-tests.el (command-execute-prune-command-history): * test/src/callint-tests.el (call-interactively-prune-command-history): New tests. diff --git a/lisp/ido.el b/lisp/ido.el index 7ff3d6820b..705e7dd630 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1793,11 +1793,8 @@ is enabled then some keybindings are changed in the keymap." (defun ido-record-command (command arg) "Add (COMMAND ARG) to `command-history' if `ido-record-commands' is non-nil." - (if ido-record-commands ; FIXME: use `when' instead of `if'? - (let ((cmd (list command arg))) - (if (or (not command-history) ; FIXME: ditto - (not (equal cmd (car command-history)))) - (setq command-history (cons cmd command-history)))))) + (when ido-record-commands + (add-to-history 'command-history (list command arg)))) (defun ido-make-prompt (item prompt) ;; Make the prompt for ido-read-internal diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 6c49b8fa6a..c0b329bbae 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1464,12 +1464,7 @@ If INPUT-METHOD is nil, deactivate any current input method." (defun deactivate-input-method () "Turn off the current input method." (when current-input-method - (if input-method-history - (unless (string= current-input-method (car input-method-history)) - (setq input-method-history - (cons current-input-method - (delete current-input-method input-method-history)))) - (setq input-method-history (list current-input-method))) + (add-to-history 'input-method-history current-input-method) (unwind-protect (progn (setq input-method-function nil @@ -2022,10 +2017,8 @@ See `set-language-info-alist' for use in programs." (let ((input-method (get-language-info language-name 'input-method))) (when input-method (setq default-input-method input-method) - (if input-method-history - (setq input-method-history - (cons input-method - (delete input-method input-method-history))))))) + (when input-method-history + (add-to-history 'input-method-history input-method))))) (defun set-language-environment-nonascii-translation (language-name) "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME." diff --git a/lisp/isearch.el b/lisp/isearch.el index 5cbb4c941a..feadf10e8b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1049,13 +1049,12 @@ For a failing search, NOPUSH is t. For going to the minibuffer to edit the search string, NOPUSH is t and EDIT is t." - (if isearch-resume-in-command-history - (let ((command `(isearch-resume ,isearch-string ,isearch-regexp - ,isearch-regexp-function ,isearch-forward - ,isearch-message - ',isearch-case-fold-search))) - (unless (equal (car command-history) command) - (setq command-history (cons command command-history))))) + (when isearch-resume-in-command-history + (add-to-history 'command-history + `(isearch-resume ,isearch-string ,isearch-regexp + ,isearch-regexp-function ,isearch-forward + ,isearch-message + ',isearch-case-fold-search))) (remove-hook 'pre-command-hook 'isearch-pre-command-hook) (remove-hook 'post-command-hook 'isearch-post-command-hook) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index f1cbdc0cc3..a7e6a8761f 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2722,17 +2722,9 @@ See `read-file-name' for the meaning of the arguments." (if (string= val1 (cadr file-name-history)) (pop file-name-history) (setcar file-name-history val1))) - (if add-to-history - ;; Add the value to the history--but not if it matches - ;; the last value already there. - (let ((val1 (minibuffer-maybe-quote-filename val))) - (unless (and (consp file-name-history) - (equal (car file-name-history) val1)) - (setq file-name-history - (cons val1 - (if history-delete-duplicates - (delete val1 file-name-history) - file-name-history))))))) + (when add-to-history + (add-to-history 'file-name-history + (minibuffer-maybe-quote-filename val)))) val)))) (defun internal-complete-buffer-except (&optional buffer) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e74f661ac7..97fdabd72b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1813,13 +1813,9 @@ If CHARSET is nil then use UTF-8." (defun eww-save-history () (plist-put eww-data :point (point)) (plist-put eww-data :text (buffer-string)) - (push eww-data eww-history) - (setq eww-data (list :title "")) - ;; Don't let the history grow infinitely. We store quite a lot of - ;; data per page. - (when-let* ((tail (and eww-history-limit - (nthcdr eww-history-limit eww-history)))) - (setcdr tail nil))) + (let ((history-delete-duplicates nil)) + (add-to-history 'eww-history eww-data eww-history-limit t)) + (setq eww-data (list :title ""))) (defvar eww-current-buffer) diff --git a/lisp/simple.el b/lisp/simple.el index 5446159d31..9fde9a5c90 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1646,13 +1646,10 @@ the minibuffer, then read and evaluate the result." 'command-history) ;; If command was added to command-history as a string, ;; get rid of that. We want only evaluable expressions there. - (if (stringp (car command-history)) - (setq command-history (cdr command-history))))))) + (when (stringp (car command-history)) + (pop command-history)))))) - ;; If command to be redone does not match front of history, - ;; add it to the history. - (or (equal command (car command-history)) - (setq command-history (cons command command-history))) + (add-to-history 'command-history command) (eval command))) (defun repeat-complex-command (arg) @@ -1682,13 +1679,10 @@ to get different commands to edit and resubmit." ;; If command was added to command-history as a ;; string, get rid of that. We want only ;; evaluable expressions there. - (if (stringp (car command-history)) - (setq command-history (cdr command-history)))))) + (when (stringp (car command-history)) + (pop command-history))))) - ;; If command to be redone does not match front of history, - ;; add it to the history. - (or (equal newcmd (car command-history)) - (setq command-history (cons newcmd command-history))) + (add-to-history 'command-history newcmd) (apply #'funcall-interactively (car newcmd) (mapcar (lambda (e) (eval e t)) (cdr newcmd)))) @@ -1905,11 +1899,8 @@ a special event, so ignore the prefix argument and don't clear it." ;; If requested, place the macro in the command history. For ;; other sorts of commands, call-interactively takes care of this. (when record-flag - (push `(execute-kbd-macro ,final ,prefixarg) command-history) - ;; Don't keep command history around forever. - (when (and (numberp history-length) (> history-length 0)) - (let ((cell (nthcdr history-length command-history))) - (if (consp cell) (setcdr cell nil))))) + (add-to-history + 'command-history `(execute-kbd-macro ,final ,prefixarg) nil t)) (execute-kbd-macro final prefixarg)) (t ;; Pass `cmd' rather than `final', for the backtrace's sake. @@ -4408,9 +4399,8 @@ argument should still be a \"useful\" string for such uses." (equal-including-properties string (car kill-ring))) (if (and replace kill-ring) (setcar kill-ring string) - (push string kill-ring) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))) + (let ((history-delete-duplicates nil)) + (add-to-history 'kill-ring string kill-ring-max t)))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string))) @@ -5724,10 +5714,11 @@ purposes. See the documentation of `set-mark' for more information. In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." (unless (null (mark t)) - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (when (> (length mark-ring) mark-ring-max) - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) + (let ((old (nth mark-ring-max mark-ring)) + (history-delete-duplicates nil)) + (add-to-history 'mark-ring (copy-marker (mark-marker)) mark-ring-max t) + (when old + (set-marker old nil)))) (set-marker (mark-marker) (or location (point)) (current-buffer)) ;; Now push the mark on the global mark ring. (if (and global-mark-ring @@ -5735,10 +5726,12 @@ In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." ;; The last global mark pushed was in this same buffer. ;; Don't push another one. nil - (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) - (when (> (length global-mark-ring) global-mark-ring-max) - (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) - (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))) + (let ((old (nth global-mark-ring-max global-mark-ring)) + (history-delete-duplicates nil)) + (add-to-history + 'global-mark-ring (copy-marker (mark-marker)) global-mark-ring-max t) + (when old + (set-marker old nil)))) (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) diff --git a/lisp/subr.el b/lisp/subr.el index 9f6cade0f7..35e220a10e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1798,7 +1798,7 @@ variable. The possible values of maximum length have the same meaning as the values of `history-length'. Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even -if it is empty or a duplicate." +if it is empty or duplicates the most recent entry in the history." (unless maxelt (setq maxelt (or (get history-var 'history-length) history-length))) @@ -1814,12 +1814,12 @@ if it is empty or a duplicate." (setq history (delete newelt history))) (setq history (cons newelt history)) (when (integerp maxelt) - (if (= 0 maxelt) + (if (>= 0 maxelt) (setq history nil) (setq tail (nthcdr (1- maxelt) history)) (when (consp tail) - (setcdr tail nil))))) - (set history-var history))) + (setcdr tail nil)))) + (set history-var history)))) ;;;; Mode hooks. diff --git a/src/callint.c b/src/callint.c index 08a8bba464..fd44494cfe 100644 --- a/src/callint.c +++ b/src/callint.c @@ -262,7 +262,7 @@ to the function `interactive' at the top level of the function body. See `interactive'. Optional second arg RECORD-FLAG non-nil -means unconditionally put this command in the command-history. +means unconditionally put this command in the variable `command-history'. Otherwise, this is done only if an arg is read using the minibuffer. Optional third arg KEYS, if given, specifies the sequence of events to @@ -328,18 +328,8 @@ invoke it. If KEYS is omitted or nil, the return value of and turn them into things we can eval. */ Lisp_Object values = quotify_args (Fcopy_sequence (specs)); fix_command (input, values); - Lisp_Object this_cmd = Fcons (function, values); - if (history_delete_duplicates) - Vcommand_history = Fdelete (this_cmd, Vcommand_history); - Vcommand_history = Fcons (this_cmd, Vcommand_history); - - /* Don't keep command history around forever. */ - if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) - { - Lisp_Object teml = Fnthcdr (Vhistory_length, Vcommand_history); - if (CONSP (teml)) - XSETCDR (teml, Qnil); - } + call4 (intern ("add-to-history"), intern ("command-history"), + Fcons (function, values), Qnil, Qt); } Vthis_command = save_this_command; @@ -768,15 +758,8 @@ invoke it. If KEYS is omitted or nil, the return value of visargs[i] = (varies[i] > 0 ? list1 (intern (callint_argfuns[varies[i]])) : quotify_arg (args[i])); - Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1), - Vcommand_history); - /* Don't keep command history around forever. */ - if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) - { - Lisp_Object teml = Fnthcdr (Vhistory_length, Vcommand_history); - if (CONSP (teml)) - XSETCDR (teml, Qnil); - } + call4 (intern ("add-to-history"), intern ("command-history"), + Flist (nargs - 1, visargs + 1), Qnil, Qt); } /* If we used a marker to hold point, mark, or an end of the region, diff --git a/src/minibuf.c b/src/minibuf.c index c41958d85f..e18c99bef2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -702,44 +702,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, histstring = Qnil; /* Add the value to the appropriate history list, if any. */ - if (!NILP (Vhistory_add_new_input) - && SYMBOLP (Vminibuffer_history_variable) - && !NILP (histstring)) - { - /* If the caller wanted to save the value read on a history list, - then do so if the value is not already the front of the list. */ - - /* The value of the history variable must be a cons or nil. Other - values are unacceptable. We silently ignore these values. */ - - if (NILP (histval) - || (CONSP (histval) - /* Don't duplicate the most recent entry in the history. */ - && (NILP (Fequal (histstring, Fcar (histval)))))) - { - Lisp_Object length; - - if (history_delete_duplicates) Fdelete (histstring, histval); - histval = Fcons (histstring, histval); - Fset (Vminibuffer_history_variable, histval); - - /* Truncate if requested. */ - length = Fget (Vminibuffer_history_variable, Qhistory_length); - if (NILP (length)) length = Vhistory_length; - if (INTEGERP (length)) - { - if (XINT (length) <= 0) - Fset (Vminibuffer_history_variable, Qnil); - else - { - Lisp_Object temp; - - temp = Fnthcdr (Fsub1 (length), histval); - if (CONSP (temp)) Fsetcdr (temp, Qnil); - } - } - } - } + if (! (NILP (Vhistory_add_new_input) || NILP (histstring))) + call2 (intern ("add-to-history"), Vminibuffer_history_variable, histstring); /* If Lisp form desired instead of string, parse it. */ if (expflag) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 64b341bd46..7a10df2058 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -448,6 +448,17 @@ See Bug#21722." (call-interactively #'eval-expression) (should (equal (current-message) "66 (#o102, #x42, ?B)")))))) +(ert-deftest command-execute-prune-command-history () + "Check that Bug#31211 is fixed." + (let ((history-length 1) + (command-history ())) + (dotimes (_ (1+ history-length)) + (command-execute "" t)) + (should (= (length command-history) history-length)))) + + +;;; `line-number-at-pos' + (ert-deftest line-number-at-pos-in-widen-buffer () (let ((target-line 3)) (with-temp-buffer diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el index 9a812223ad..feee9b692b 100644 --- a/test/src/callint-tests.el +++ b/test/src/callint-tests.el @@ -43,4 +43,12 @@ (list a b)))) '("a" "b")))) +(ert-deftest call-interactively-prune-command-history () + "Check that Bug#31211 is fixed." + (let ((history-length 1) + (command-history ())) + (dotimes (_ (1+ history-length)) + (call-interactively #'ignore t)) + (should (= (length command-history) history-length)))) + ;;; callint-tests.el ends here commit 05e9477ab5d5dba1b960415d60b9957caa90da48 Author: Glenn Morris Date: Wed May 2 15:39:30 2018 -0400 * lisp/textmodes/ispell.el (ispell-use-framepop-p): Doc fix. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 18bf2630e5..1dc3965086 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -326,11 +326,13 @@ The function must take one string argument and return a string." :type 'function :group 'ispell) +;; FIXME framepop.el last updated c 2003 (?), +;; probably something else replaces it these days. (defcustom ispell-use-framepop-p nil "When non-nil ispell uses framepop to display choices in a dedicated frame. You can set this variable to dynamically use framepop if you are in a window system by evaluating the following on startup to set this variable: - (and window-system (condition-case () (require \\='framepop) (error nil)))" + (and (display-graphic-p) (require \\='framepop nil t))" :type 'boolean :group 'ispell) commit 9de7e321b63bf38afef5e3f0e786dd4a046d407a Author: Glenn Morris Date: Wed May 2 15:29:53 2018 -0400 ; * lisp/auth-source.el (auth-sources): Fix a comment. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index df3622a412..8b54c8118d 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -242,7 +242,7 @@ for details. It's best to customize this with `\\[customize-variable]' because the choices can get pretty complex." :group 'auth-source - :version "26.1" ;; No Gnus + :version "26.1" ; neither new nor changed default :type `(repeat :tag "Authentication Sources" (choice (string :tag "Just a file") commit a5246dc02b0572a611ac2169fa16962fc89926b9 Author: Michael Albinus Date: Wed May 2 18:12:48 2018 +0200 Adapt Tramp for auth-source * lisp/net/tramp.el (tramp-read-passwd): auth-source could return cascaded functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5dda18f3a3..e14a515b8b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4472,8 +4472,8 @@ Invokes `password-read' if available, `read-passwd' else." (unwind-protect (with-parsed-tramp-file-name key nil - (setq tramp-password-save-function nil) - (setq user + (setq tramp-password-save-function nil + user (or user (tramp-get-connection-property key "login-as" nil))) (prog1 (or @@ -4501,18 +4501,21 @@ Invokes `password-read' if available, `read-passwd' else." :create t)) tramp-password-save-function (plist-get auth-info :save-function) - auth-passwd (plist-get auth-info :secret) - auth-passwd (if (functionp auth-passwd) - (funcall auth-passwd) - auth-passwd)))) + auth-passwd (plist-get auth-info :secret))) + (while (functionp auth-passwd) + (setq auth-passwd (funcall auth-passwd))) + auth-passwd) ;; Try the password cache. - (let ((password (password-read pw-prompt key))) - (setq tramp-password-save-function - (lambda () (password-cache-add key password))) - password) - ;; Else, get the password interactively. + (progn + (setq auth-passwd (password-read pw-prompt key) + tramp-password-save-function + (lambda () (password-cache-add key auth-passwd))) + auth-passwd) + + ;; Else, get the password interactively w/o cache. (read-passwd pw-prompt)) + (tramp-set-connection-property v "first-password-request" nil))) ;; Reenable the timers. commit 8ae7c424c409aa31fa52304752ba62d4b5a9a4d0 Author: Michael Albinus Date: Wed May 2 12:31:51 2018 +0200 Fix some edge cases of tramp-smb * lisp/net/tramp-smb.el (tramp-smb-errors): Add "NT_STATUS_REVISION_MISMATCH". (tramp-smb-handle-delete-directory): Check, that the directory has been removed indeed. (tramp-smb-get-localname): Add further checks on filename syntax. * lisp/net/tramp.el (tramp-localname-regexp): Do not allow linefeeds. * test/lisp/net/tramp-tests.el (tramp-smb-get-localname): Declare. (auth-source-save-behavior): Set it to nil. (tramp-test01-file-name-syntax): Extend, checking for linefeeds. (tramp-test03-file-name-host-rules, tramp--test-utf8): Refine tests. (tramp-test03-file-name-method-rules): New test. (tramp--test-ignore-add-name-to-file-error): New defmacro. (tramp-test21-file-links): Use it. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0e7386bf02..a4d0d53bf7 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -123,6 +123,7 @@ call, letting the SMB client use the default one." "ERRnoaccess" "ERRnomem" "ERRnosuchshare" + ;; See /usr/include/samba-4.0/core/ntstatus.h. ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), @@ -154,6 +155,7 @@ call, letting the SMB client use the default one." "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" "NT_STATUS_PASSWORD_MUST_CHANGE" "NT_STATUS_RESOURCE_NAME_NOT_FOUND" + "NT_STATUS_REVISION_MISMATCH" "NT_STATUS_SHARING_VIOLATION" "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" "NT_STATUS_UNSUCCESSFUL" @@ -643,7 +645,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (search-forward-regexp tramp-smb-errors nil t) (tramp-error - v 'file-error "%s `%s'" (match-string 0) directory)))))) + v 'file-error "%s `%s'" (match-string 0) directory))) + + ;; "rmdir" does not report an error. So we check ourselves. + (when (file-exists-p directory) + (tramp-error + v 'file-error "`%s' not removed." directory))))) (defun tramp-smb-handle-delete-file (filename &optional _trash) "Like `delete-file' for Tramp files." @@ -1621,6 +1628,13 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname) (setq localname (replace-match "$" nil nil localname 1))) + ;; A period followed by a space, or trailing periods and spaces, + ;; are not supported. + (when (string-match "\\. \\|\\.$\\| $" localname) + (tramp-error + vec 'file-error + "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) + localname))) ;; Share names of a host are cached. It is very unlikely that the diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c394f28a56..5dda18f3a3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -917,7 +917,7 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between host names and localnames. Derived from `tramp-postfix-host-format'.") -(defconst tramp-localname-regexp ".*$" +(defconst tramp-localname-regexp "[^\n\r]*\\'" "Regexp matching localnames.") (defconst tramp-unknown-id-string "UNKNOWN" diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3ca401b2fa..1843be7186 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -52,8 +52,10 @@ (declare-function tramp-find-executable "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") -(declare-function tramp-get-remote-stat "tramp-sh") (declare-function tramp-get-remote-perl "tramp-sh") +(declare-function tramp-get-remote-stat "tramp-sh") +(declare-function tramp-method-out-of-band-p "tramp-sh") +(declare-function tramp-smb-get-localname "tramp-smb") (defvar auto-save-file-name-transforms) (defvar tramp-copy-size-limit) (defvar tramp-persistency-file-name) @@ -91,7 +93,8 @@ (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") -(setq password-cache-expiry nil +(setq auth-source-save-behavior nil + password-cache-expiry nil tramp-verbose 0 tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil @@ -248,6 +251,9 @@ handled properly. BODY shall not contain a timeout." ;; No strings. (should-not (tramp-tramp-file-p nil)) (should-not (tramp-tramp-file-p 'symbol)) + ;; No newline or linefeed. + (should-not (tramp-tramp-file-p "/method::file\nname")) + (should-not (tramp-tramp-file-p "/method::file\rname")) ;; Ange-ftp syntax. (should-not (tramp-tramp-file-p "/host:")) (should-not (tramp-tramp-file-p "/user@host:")) @@ -1733,18 +1739,36 @@ handled properly. BODY shall not contain a timeout." ;; Host names must match rules in case the command template of a ;; method doesn't use them. (dolist (m '("su" "sg" "sudo" "doas" "ksu")) - ;; Single hop. The host name must match `tramp-local-host-regexp'. - (should-error - (find-file (format "/%s:foo:" m)) - :type 'user-error) - ;; Multi hop. The host name must match the previous hop. - (should-error - (find-file - (format - "%s|%s:foo:" - (substring (file-remote-p tramp-test-temporary-file-directory) nil -1) - m)) - :type 'user-error))) + (let (tramp-default-proxies-alist) + ;; Single hop. The host name must match `tramp-local-host-regexp'. + (should-error + (find-file (format "/%s:foo:" m)) + :type 'user-error) + ;; Multi hop. The host name must match the previous hop. + (should-error + (find-file + (format + "%s|%s:foo:" + (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1) + m)) + :type + (if (tramp-method-out-of-band-p + (tramp-dissect-file-name tramp-test-temporary-file-directory) 0) + 'file-error 'user-error))))) + +(ert-deftest tramp-test03-file-name-method-rules () + "Check file name rules for some methods." + (skip-unless (tramp--test-enabled)) + + ;; Samba does not support file names with periods followed by + ;; spaces, and trailing periods or spaces. + (when (tramp-smb-file-name-p tramp-test-temporary-file-directory) + (dolist (file '("foo." "foo. bar" "foo ")) + (should-error + (tramp-smb-get-localname + (tramp-dissect-file-name + (expand-file-name file tramp-test-temporary-file-directory))) + :type 'file-error)))) (ert-deftest tramp-test04-substitute-in-file-name () "Check `substitute-in-file-name'." @@ -2888,11 +2912,23 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) +;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error. +(defmacro tramp--test-ignore-add-name-to-file-error (&rest body) + "Run BODY, ignoring \"error with add-name-to-file\" file error." + (declare (indent defun) (debug t)) + `(condition-case err + (progn ,@body) + ((error quit debug) + (unless (and (eq (car err) 'file-error) + (string-match "^error with add-name-to-file" + (error-message-string err))) + (signal (car err) (cdr err)))))) + (ert-deftest tramp-test21-file-links () "Check `file-symlink-p'. This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) - ;; The semantics has changed heavily in Emacs 26.1. We cannot test + ;; The semantics have changed heavily in Emacs 26.1. We cannot test ;; older Emacsen, therefore. (skip-unless (tramp--test-emacs26-p)) @@ -2990,37 +3026,39 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Check `add-name-to-file'. (unwind-protect (when (tramp--test-expensive-test) - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (add-name-to-file tmp-name1 tmp-name2) - (should (file-regular-p tmp-name2)) - (should-error + (tramp--test-ignore-add-name-to-file-error + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) - :type 'file-already-exists) - ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) - (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))) + (should (file-regular-p tmp-name2)) + (should-error + (add-name-to-file tmp-name1 tmp-name2) + :type 'file-already-exists) + ;; A number means interactive case. + (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (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))) (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) - (should-not (file-symlink-p tmp-name2)) - (should (file-regular-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error - (add-name-to-file tmp-name1 tmp-name3) - :type 'file-error) - ;; Check directory as newname. - (make-directory tmp-name4) - (should-error - (add-name-to-file tmp-name1 tmp-name4) - :type 'file-already-exists) - (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) - (should - (file-regular-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))) + (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) + (should-not (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error + (add-name-to-file tmp-name1 tmp-name3) + :type 'file-error) + ;; Check directory as newname. + (make-directory tmp-name4) + (should-error + (add-name-to-file tmp-name1 tmp-name4) + :type 'file-already-exists) + (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) + (should + (file-regular-p + (expand-file-name + (file-name-nondirectory tmp-name1) tmp-name4))))) ;; Cleanup. (ignore-errors @@ -4669,9 +4707,11 @@ Use the `ls' command." (setq x (eval (cdr (assoc 'sample-text x)))) (unless (or (null x) (unencodable-char-position - nil nil file-name-coding-system nil x) + 0 nil file-name-coding-system nil x) (string-match "TaiViet" x)) - (replace-regexp-in-string "[\n/]" "" x))) + ;; ?\n and ?/ shouldn't be part of any file name. ?\t, + ;; ?. and ?? do not work for "smb" method. + (replace-regexp-in-string "[\t\n/.?]" "" x))) language-info-alist)) (list