* lisp/net/tramp-compat.el (tramp-file-name-handler): Don't declare.
* lisp/net/tramp.el (tramp-skeleton-file-truename)
(tramp-skeleton-handle-make-symbolic-link): New defmacros.
(tramp-handle-file-truename):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
(tramp-sh-handle-file-truename):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-truename)
(tramp-sudoedit-handle-make-symbolic-link): Use them.
* lisp/net/tramp.el (tramp-call-process, tramp-call-process-region):
Let-bind `temporary-file-directory'.
* test/lisp/net/tramp-tests.el (tramp-action-yesno):
Suppress run in tests.
(tramp-test21-file-links, tramp-test29-start-file-process)
(tramp-test30-make-process, tramp-test42-utf8): Adapt tests.
(require 'subr-x)
(declare-function tramp-error "tramp")
-(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
(defun tramp-sh-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name (expand-file-name linkname) nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target))))
- ;; There could be a cyclic link.
- (tramp-flush-file-properties
- v (expand-file-name target (tramp-file-local-name default-directory))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
-
- (let ((ln (tramp-get-remote-ln v))
- (cwd (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless ln
- (tramp-error
- v 'file-error
- (concat "Making a symbolic link. "
- "ln(1) does not exist on the remote host.")))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Right, they are on the same host, regardless of user,
- ;; method, etc. We now make the link on the remote machine.
- ;; This will occur as the user that TARGET belongs to.
- (and (tramp-send-command-and-check
- v (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- v (format
- "%s -sf %s %s" ln
- (tramp-shell-quote-argument target)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file names
- ;; could start with "-".
- ;; `tramp-shell-quote-argument' does not handle this,
- ;; we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory localname))))))))))
+ "Like `make-symbolic-link' for Tramp files."
+ (let ((v (tramp-dissect-file-name (expand-file-name linkname))))
+ (unless (tramp-get-remote-ln v)
+ (tramp-error
+ v 'file-error
+ (concat "Making a symbolic link. "
+ "ln(1) does not exist on the remote host."))))
+
+ (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists
+ (and (tramp-send-command-and-check
+ v (format
+ "cd %s"
+ (tramp-shell-quote-argument (file-name-directory localname))))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" (tramp-get-remote-ln v)
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use relative
+ ;; file names.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let ((result
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (tramp-send-command-and-check
- v (format "%s --canonicalize-missing %s"
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (buffer-substring (point-min) (line-end-position))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec")
- (tramp-get-connection-property v "perl-cwd-realpath"))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (tramp-send-command-and-read
- v (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname))))
-
- ;; Do it yourself.
- (t (tramp-file-local-name
- (tramp-handle-file-truename filename))))))
-
- ;; 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 (file-remote-p result)
- (setq result (file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
+ (tramp-skeleton-file-truename filename
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where available.
+ ((tramp-get-remote-readlink v)
+ (tramp-send-command-and-check
+ v (format "%s --canonicalize-missing %s"
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (line-end-position))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec")
+ (tramp-get-connection-property v "perl-cwd-realpath"))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname))))
+
+ ;; Do it yourself.
+ (t (tramp-file-local-name
+ (tramp-handle-file-truename filename))))))
;; Basic functions.
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
(defun tramp-smb-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files."
+ (let ((v (tramp-dissect-file-name (expand-file-name linkname))))
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported")))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (tramp-smb-send-command
- v (format "symlink %s %s"
- (tramp-smb-shell-quote-argument target)
- (tramp-smb-shell-quote-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (tramp-get-connection-buffer v))))))
+ (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists
+ (unless (tramp-smb-send-command
+ v (format "symlink %s %s"
+ (tramp-smb-shell-quote-argument target)
+ (tramp-smb-shell-quote-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (tramp-get-connection-buffer v)))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let (result)
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (setq result (tramp-sudoedit-send-command-string
- v "readlink" "--canonicalize-missing" localname))
- ;; 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 (file-remote-p result)
- (setq result (file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
+ (tramp-skeleton-file-truename filename
+ (tramp-sudoedit-send-command-string
+ v "readlink" "--canonicalize-missing" localname)))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(defun tramp-sudoedit-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name (expand-file-name linkname) nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
- (tramp-sudoedit-send-command
- v "ln" "-sf"
- (file-name-unquote target)
- (file-name-unquote localname)))))
+ "Like `make-symbolic-link' for Tramp files."
+ (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists
+ (tramp-sudoedit-send-command
+ v "ln" "-sf"
+ (file-name-unquote target)
+ (file-name-unquote localname))))
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
;; Trigger the `file-missing' error.
(signal 'error nil)))))
+(defmacro tramp-skeleton-file-truename (filename &rest body)
+ "Skeleton for `tramp-*-handle-file-truename'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug (form body)))
+ ;; Preserve trailing "/".
+ `(funcall
+ (if (directory-name-p ,filename) #'file-name-as-directory #'identity)
+ ;; Quote properly.
+ (funcall
+ (if (file-name-quoted-p ,filename) #'file-name-quote #'identity)
+ (with-parsed-tramp-file-name
+ (file-name-unquote (expand-file-name ,filename)) nil
+ (tramp-make-tramp-file-name
+ v
+ (with-tramp-file-property v localname "file-truename"
+ (let (result)
+ (setq result (progn ,@body))
+ ;; 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 (file-remote-p result)
+ (setq result (file-name-quote result 'top)))
+ result)))))))
+
(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body)
"Skeleton for `tramp-*-handle-make-directory'.
BODY is the backend specific code."
,@body
nil))))
+(defmacro tramp-skeleton-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists &rest body)
+ "Skeleton for `tramp-*-handle-make-symbolic-link'.
+BODY is the backend specific code.
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink if it is located
+on the same host. Otherwise, TARGET is quoted."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p ,target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name ,target)))
+ (setq ,target (tramp-file-local-name (expand-file-name ,target))))
+ ;; There could be a cyclic link.
+ (tramp-flush-file-properties
+ v (expand-file-name ,target (tramp-file-local-name default-directory))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p ,target)
+ (make-symbolic-link
+ (file-name-quote ,target 'top) ,linkname ,ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p ,linkname)
+ ;; What to do?
+ (if (or (null ,ok-if-already-exists) ; not allowed to exist
+ (and (numberp ,ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file ,linkname)))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ ,@body)))
+
(defmacro tramp-skeleton-set-file-modes-times-uid-gid
(filename &rest body)
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
(defun tramp-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (let ((result (file-name-unquote (expand-file-name filename)))
+ (tramp-skeleton-file-truename filename
+ (let ((result (directory-file-name localname))
(numchase 0)
;; Don't make the following value larger than necessary.
;; People expect an error message in a timely fashion when
;; Unquoting could enable encryption.
tramp-crypt-enabled
symlink-target)
- (with-parsed-tramp-file-name result v1
- ;; We cache only the localname.
- (tramp-make-tramp-file-name
- v1
- (with-tramp-file-property v1 v1-localname "file-truename"
- (while (and (setq symlink-target (file-symlink-p result))
- (< numchase numchase-limit))
- (setq numchase (1+ numchase)
- result
- (with-parsed-tramp-file-name (expand-file-name result) v2
- (tramp-make-tramp-file-name
- v2
- (if (stringp symlink-target)
- (if (file-remote-p symlink-target)
- (file-name-quote symlink-target 'top)
- (tramp-drop-volume-letter
- (expand-file-name
- symlink-target
- (file-name-directory v2-localname))))
- v2-localname))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v1 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit)))
- (tramp-file-local-name (directory-file-name result)))))))))
+ (while (and (setq symlink-target
+ (file-symlink-p (tramp-make-tramp-file-name v result)))
+ (< numchase numchase-limit))
+ (setq numchase (1+ numchase)
+ result
+ (if (file-remote-p symlink-target)
+ (file-name-quote symlink-target 'top)
+ (tramp-drop-volume-letter
+ (expand-file-name
+ symlink-target (file-name-directory result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit)))
+ (directory-file-name result))))
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory)
+ (temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment))
(destination (if (eq destination t) (current-buffer) destination))
(vec (or vec (car tramp-current-connection)))
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory)
+ (temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment))
(buffer (if (eq buffer t) (current-buffer) buffer))
result)
;; Suppress nasty messages.
(fset #'shell-command-sentinel #'ignore)
;; We do not want to be interrupted.
+ (fset #'tramp-action-yesno
+ (lambda (_proc vec)
+ (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t))
(eval-after-load 'tramp-gvfs
'(fset 'tramp-gvfs-handler-askquestion
(lambda (_message _choices) '(t nil 0)))))
(should (file-symlink-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
+ (should
+ (string-equal
+ (file-truename tmp-name1)
+ (file-truename tmp-name2)))
(if (tramp--test-smb-p)
;; The symlink command of "smbclient" detects the
;; cycle already.
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-error)
(make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
+ (should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
(should-error
(file-truename tmp-name1)
+ :type 'file-error)
+ (should-error
+ (file-truename tmp-name2)
:type 'file-error))))
;; Cleanup.
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
- (if (and (memq process-connection-type '(nil pipe))
- (not (tramp--test-macos-p)))
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
- (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
+ ;; On macOS, there is always newline conversion.
+ ;; "telnet" converts \r to <CR><NUL> if `crlf'
+ ;; flag is FALSE. See telnet(1) man page.
+ (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
(buffer-string))))
;; Cleanup.
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
- (if (and (memq (or connection-type process-connection-type)
- '(nil pipe))
- (not (tramp--test-macos-p)))
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
- (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
+ ;; On macOS, there is always newline conversion.
+ ;; "telnet" converts \r to <CR><NUL> if `crlf'
+ ;; flag is FALSE. See telnet(1) man page.
+ (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
(buffer-string))))
;; Cleanup.
;; Use all available language specific snippets.
(lambda (x)
(and
+ ;; The "Oriya" and "Odia" languages use some problematic
+ ;; composition characters.
+ (not (member (car x) '("Oriya" "Odia")))
(stringp (setq x (eval (get-language-info (car x) 'sample-text) t)))
;; Filter out strings which use unencodable characters.
(not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
projects / emacs.git / commitdiff