summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/mailcap.el6
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-compat.el33
-rw-r--r--lisp/net/tramp-sh.el28
-rw-r--r--lisp/net/tramp-smb.el10
-rw-r--r--lisp/net/tramp.el33
6 files changed, 63 insertions, 49 deletions
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index ed35c220ec5..86587466ef5 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -165,9 +165,13 @@ is consulted."
(type . "application/zip")
("copiousoutput"))
("pdf"
+ (viewer . pdf-view-mode)
+ (type . "application/pdf")
+ (test . window-system))
+ ("pdf"
(viewer . doc-view-mode)
(type . "application/pdf")
- (test . (eq window-system 'x)))
+ (test . window-system))
("pdf"
(viewer . "gv -safer %s")
(type . "application/pdf")
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c22869d2cc2..760d020f672 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Remote newname.
(when (and (file-directory-p newname)
- (directory-name-p newname))
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name
(file-name-nondirectory filename) newname)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 5d9a1fd1967..214ad040a17 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,8 +23,9 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 26. This
-;; package provides compatibility functions for Emacs 24 and Emacs 25.
+;; Tramp's main Emacs version for development is Emacs 27. This
+;; package provides compatibility functions for Emacs 24, Emacs 25 and
+;; Emacs 26.
;;; Code:
@@ -104,6 +105,10 @@ Add the extension of F, if existing."
'tramp-error vec-or-proc
(if (fboundp 'user-error) 'user-error 'error) format args))
+;; `default-toplevel-value' has been declared in Emacs 24.4.
+(unless (fboundp 'default-toplevel-value)
+ (defalias 'default-toplevel-value 'symbol-value))
+
;; `file-attribute-*' are introduced in Emacs 25.1.
(if (fboundp 'file-attribute-type)
@@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer."
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes)))
-;; `default-toplevel-value' has been declared in Emacs 24.4.
-(unless (fboundp 'default-toplevel-value)
- (defalias 'default-toplevel-value 'symbol-value))
-
;; `format-message' is new in Emacs 25.1.
(unless (fboundp 'format-message)
(defalias 'format-message 'format))
+;; `directory-name-p' is new in Emacs 25.1.
+(if (fboundp 'directory-name-p)
+ (defalias 'tramp-compat-directory-name-p 'directory-name-p)
+ (defsubst tramp-compat-directory-name-p (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\))))))
+
;; `file-missing' is introduced in Emacs 26.1.
(defconst tramp-file-missing
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
@@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted."
((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax)))
-;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
-(eval-after-load 'tramp
- '(unless
- (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
- (tramp-compat-funcall
- (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
-
(provide 'tramp-compat)
;;; TODO:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7df5aa3b7b0..a744a53ca42 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -613,7 +613,7 @@ use Cwd \"realpath\";
sub myrealpath {
my ($file) = @_;
- return realpath($file) if -e $file;
+ return realpath($file) if (-e $file || -l $file);
}
sub recursive {
@@ -1139,12 +1139,7 @@ component is used as the target of the symlink."
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (setq result (buffer-substring (point-min) (point-at-eol))))
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename)))
+ (setq result (buffer-substring (point-min) (point-at-eol)))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
@@ -1198,16 +1193,6 @@ component is used as the target of the symlink."
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
- ;; If the symlink was absolute, we'll get a
- ;; string like "/user@host:/some/target";
- ;; extract the "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host"
- symlink-target))
- (setq symlink-target localname))
(setq steps
(append
(split-string symlink-target "/" 'omit) steps)))
@@ -1226,6 +1211,13 @@ component is used as the target of the symlink."
"/"))
(when (string= "" result)
(setq result "/")))))
+
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (or quoted (file-remote-p result))
@@ -1985,7 +1977,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
- (not (directory-name-p newname)))
+ (not (tramp-compat-directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 49695666707..35aa8110946 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -415,7 +415,7 @@ pass to the OPERATION."
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
(when (and (file-directory-p newname)
- (not (directory-name-p newname)))
+ (not (tramp-compat-directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(cond
;; We must use a local temporary directory.
@@ -535,7 +535,7 @@ pass to the OPERATION."
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
+ (when t1 (delete-directory tmpdir 'recursive))))
;; Handle KEEP-DATE argument.
(when keep-date
@@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Remote newname.
(when (and (file-directory-p newname)
- (directory-name-p newname))
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name (file-name-nondirectory filename) newname)))
@@ -1583,6 +1583,10 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
"Read entries which match DIRECTORY.
Either the shares are listed, or the `dir' command is executed.
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
+ ;; If CIFS capabilities are enabled, symlinks are not listed
+ ;; by `dir'. This is a consequence of
+ ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
+ ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 45776078be3..3573eeb7d49 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3169,7 +3169,7 @@ User is always nil."
(defun tramp-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- (let ((result filename)
+ (let ((result (expand-file-name filename))
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
@@ -3180,7 +3180,7 @@ User is always nil."
symlink-target)
(format
"%s%s"
- (with-parsed-tramp-file-name (expand-file-name result) v1
+ (with-parsed-tramp-file-name result v1
(with-tramp-file-property v1 v1-localname "file-truename"
(while (and (setq symlink-target (file-symlink-p result))
(< numchase numchase-limit))
@@ -3850,7 +3850,7 @@ Erase echoed commands if exists."
(min (+ (point-min) tramp-echo-mark-marker-length)
(point-max))))))
;; No echo to be handled, now we can look for the regexp.
- ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; Sometimes, lines are much too long, and we run into a "Stack
;; overflow in regexp matcher". For example, //DIRED// lines of
;; directory listings with some thousand files. Therefore, we
;; look from the end.
@@ -4547,16 +4547,23 @@ Only works for Bourne-like shells."
(t process)))
pid)
;; If it's a Tramp process, send the INT signal remotely.
- (when (and (processp proc) (process-live-p proc)
- (setq pid (process-get proc 'remote-pid)))
- (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
- ;; This is for tramp-sh.el. Other backends do not support this (yet).
- (tramp-compat-funcall
- 'tramp-send-command
- (tramp-get-connection-property proc "vector" nil)
- (format "kill -2 %d" pid))
- ;; Report success.
- proc)))
+ (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
+ (if (not (process-live-p proc))
+ (tramp-error proc 'error "Process %s is not active" proc)
+ (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (tramp-compat-funcall
+ 'tramp-send-command
+ (tramp-get-connection-property proc "vector" nil)
+ (format "kill -2 %d" pid))
+ ;; Wait, until the process has disappeared.
+ (with-timeout
+ (1 (tramp-error proc 'error "Process %s did not interrupt" proc))
+ (while (process-live-p proc)
+ ;; We cannot run `tramp-accept-process-output', it blocks timers.
+ (accept-process-output proc 0.1)))
+ ;; Report success.
+ proc))))
;; `interrupt-process-functions' exists since Emacs 26.1.
(when (boundp 'interrupt-process-functions)
View Lorry Controller Status