- (remove-hook 'rfn-eshadow-update-overlay-hook
- 'tramp-rfn-eshadow-update-overlay))))
-
-
-;;; Integration of eshell.el:
-
-(eval-when-compile
- (defvar eshell-path-env))
-
-;; eshell.el keeps the path in `eshell-path-env'. We must change it
-;; when `default-directory' points to another host.
-(defun tramp-eshell-directory-change ()
- "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
- (setq eshell-path-env
- (if (file-remote-p default-directory)
- (with-parsed-tramp-file-name default-directory nil
- (mapconcat
- 'identity
- (tramp-get-remote-path v)
- ":"))
- (getenv "PATH"))))
-
-(eval-after-load "esh-util"
- '(progn
- (tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)
- (add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)))))
-
-
-;;; File Name Handler Functions:
-
-(defun tramp-handle-make-symbolic-link
- (filename linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If LINKNAME is a non-Tramp file, it is used verbatim as the target of
-the symlink. If LINKNAME is a Tramp file, only the localname component is
-used as the target of the symlink.
-
-If LINKNAME is a Tramp file and the localname component is relative, then
-it is expanded first, before the localname component is taken. Note that
-this can give surprising results if the user/host for the source and
-target of the symlink differ."
- (with-parsed-tramp-file-name linkname l
- (let ((ln (tramp-get-remote-ln l))
- (cwd (tramp-run-real-handler
- 'file-name-directory (list l-localname))))
- (unless ln
- (tramp-error
- l 'file-error
- "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? "
- l-localname)))))
- (tramp-error
- l 'file-already-exists "File %s already exists" l-localname)
- (delete-file linkname)))
-
- ;; If FILENAME is a Tramp name, use just the localname component.
- (when (tramp-tramp-file-p filename)
- (setq filename
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name filename)))))
-
- ;; 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 FILENAME belongs to.
- (zerop
- (tramp-send-command-and-check
- l
- (format
- "cd %s && %s -sf %s %s"
- (tramp-shell-quote-argument cwd)
- ln
- (tramp-shell-quote-argument filename)
- (tramp-shell-quote-argument l-localname))
- t)))))
-
-(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
- "Like `load' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name file) nil
- (unless nosuffix
- (cond ((file-exists-p (concat file ".elc"))
- (setq file (concat file ".elc")))
- ((file-exists-p (concat file ".el"))
- (setq file (concat file ".el")))))
- (when must-suffix
- ;; The first condition is always true for absolute file names.
- ;; Included for safety's sake.
- (unless (or (file-name-directory file)
- (string-match "\\.elc?\\'" file))
- (tramp-error
- v 'file-error
- "File `%s' does not include a `.el' or `.elc' suffix" file)))
- (unless noerror
- (when (not (file-exists-p file))
- (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
- (if (not (file-exists-p file))
- nil
- (let ((tramp-message-show-message (not nomessage)))
- (with-progress-reporter v 0 (format "Loading %s" file)
- (let ((local-copy (file-local-copy file)))
- ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
- (unwind-protect
- (load local-copy noerror t t)
- (delete-file local-copy)))))
- t)))
-
-;; Localname manipulation functions that grok Tramp localnames...
-(defun tramp-handle-file-name-as-directory (file)
- "Like `file-name-as-directory' but aware of Tramp files."
- ;; `file-name-as-directory' would be sufficient except localname is
- ;; the empty string.
- (let ((v (tramp-dissect-file-name file t)))
- ;; Run the command on the localname portion only.
- (tramp-make-tramp-file-name
- (tramp-file-name-method v)
- (tramp-file-name-user v)
- (tramp-file-name-host v)
- (tramp-run-real-handler
- 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
-
-(defun tramp-handle-file-name-directory (file)
- "Like `file-name-directory' but aware of Tramp files."
- ;; Everything except the last filename thing is the directory. We
- ;; cannot apply `with-parsed-tramp-file-name', because this expands
- ;; the remote file name parts. This is a problem when we are in
- ;; file name completion.
- (let ((v (tramp-dissect-file-name file t)))
- ;; Run the command on the localname portion only.
- (tramp-make-tramp-file-name
- (tramp-file-name-method v)
- (tramp-file-name-user v)
- (tramp-file-name-host v)
- (tramp-run-real-handler
- 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
-
-(defun tramp-handle-file-name-nondirectory (file)
- "Like `file-name-nondirectory' but aware of Tramp files."
- (with-parsed-tramp-file-name file nil
- (tramp-run-real-handler 'file-name-nondirectory (list localname))))
-
-(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
- "Like `file-truename' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-file-property v localname "file-truename"
- (let ((result nil)) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (setq result
- (tramp-send-command-and-read
- v
- (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec" nil)
- (tramp-get-connection-property v "perl-cwd-realpath" nil))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (setq result
- (tramp-send-command-and-read
- v
- (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname)))))
-
- ;; Do it yourself. We bind `directory-sep-char' here for
- ;; XEmacs on Windows, which would otherwise use backslash.
- (t (let* ((directory-sep-char ?/)
- (steps (tramp-compat-split-string localname "/"))
- (localnamedir (tramp-run-real-handler
- 'file-name-as-directory (list localname)))
- (is-dir (string= localname localnamedir))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong;
- ;; otherwise they might think that Emacs is hung.
- ;; Of course, correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (mapconcat 'identity
- (append '("") (reverse result) (list thisstep))
- "/"))
- (setq symlink-target
- (nth 0 (file-attributes
- (tramp-make-tramp-file-name
- method user host
- (mapconcat 'identity
- (append '("")
- (reverse result)
- (list thisstep))
- "/")))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message v 5 "Follow symlink to %s" symlink-target)
- (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 (tramp-compat-split-string
- symlink-target "/")
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (mapconcat 'identity (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string= "" result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/"))))))
-
- (tramp-message v 4 "True name of `%s' is `%s'" filename result)
- (tramp-make-tramp-file-name method user host result)))))
-
-;; Basic functions.
-
-(defun tramp-handle-file-exists-p (filename)
- "Like `file-exists-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-exists-p"
- (or (not (null (tramp-get-file-property
- v localname "file-attributes-integer" nil)))
- (not (null (tramp-get-file-property
- v localname "file-attributes-string" nil)))
- (zerop (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname))))))))
-
-;; Inodes don't exist for some file systems. Therefore we must
-;; generate virtual ones. Used in `find-buffer-visiting'. The method
-;; applied might be not so efficient (Ange-FTP uses hashes). But
-;; performance isn't the major issue given that file transfer will
-;; take time.
-(defvar tramp-inodes nil
- "Keeps virtual inodes numbers.")
-
-;; Devices must distinguish physical file systems. The device numbers
-;; provided by "lstat" aren't unique, because we operate on different hosts.
-;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
-;; EFS use device number "-1". In order to be different, we use device number
-;; (-1 . x), whereby "x" is unique for a given (method user host).
-(defvar tramp-devices nil
- "Keeps virtual device numbers.")
-
-;; CCC: This should check for an error condition and signal failure
-;; when something goes wrong.
-;; Daniel Pittman <daniel@danann.net>
-(defun tramp-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-file-property v localname (format "file-attributes-%s" id-format)
- (save-excursion
- (tramp-convert-file-attributes
- v
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-file-attributes-with-stat v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-file-attributes-with-perl v localname id-format))
- (t
- (tramp-do-file-attributes-with-ls v localname id-format)))))))))
-
-(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using the ls(1) command."
- (let (symlinkp dirp
- res-inode res-filemodes res-numlinks
- res-uid res-gid res-size res-symlink-target)
- (tramp-message vec 5 "file attributes with ls: %s" localname)
- (tramp-send-command
- vec
- (format "(%s %s || %s -h %s) && %s %s %s"
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command vec)
- (if (eq id-format 'integer) "-ildn" "-ild")
- (tramp-shell-quote-argument localname)))
- ;; parse `ls -l' output ...
- (with-current-buffer (tramp-get-buffer vec)
- (when (> (buffer-size) 0)
- (goto-char (point-min))
- ;; ... inode
- (setq res-inode
- (condition-case err
- (read (current-buffer))
- (invalid-read-syntax
- (when (and (equal (cadr err)
- "Integer constant overflow in reader")
- (string-match
- "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
- (car (cddr err))))
- (let* ((big (read (substring (car (cddr err)) 0
- (match-beginning 1))))
- (small (read (match-string 1 (car (cddr err)))))
- (twiddle (/ small 65536)))
- (cons (+ big twiddle)
- (- small (* twiddle 65536))))))))
- ;; ... file mode flags
- (setq res-filemodes (symbol-name (read (current-buffer))))
- ;; ... number links
- (setq res-numlinks (read (current-buffer)))
- ;; ... uid and gid
- (setq res-uid (read (current-buffer)))
- (setq res-gid (read (current-buffer)))
- (if (eq id-format 'integer)
- (progn
- (unless (numberp res-uid) (setq res-uid -1))
- (unless (numberp res-gid) (setq res-gid -1)))
- (progn
- (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
- (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
- ;; ... size
- (setq res-size (read (current-buffer)))
- ;; From the file modes, figure out other stuff.
- (setq symlinkp (eq ?l (aref res-filemodes 0)))
- (setq dirp (eq ?d (aref res-filemodes 0)))
- ;; if symlink, find out file name pointed to
- (when symlinkp
- (search-forward "-> ")
- (setq res-symlink-target
- (buffer-substring (point) (tramp-compat-line-end-position))))
- ;; return data gathered
- (list
- ;; 0. t for directory, string (name linked to) for symbolic
- ;; link, or nil.
- (or dirp res-symlink-target)
- ;; 1. Number of links to file.
- res-numlinks
- ;; 2. File uid.
- res-uid
- ;; 3. File gid.
- res-gid
- ;; 4. Last access time, as a list of two integers. First
- ;; integer has high-order 16 bits of time, second has low 16
- ;; bits.
- ;; 5. Last modification time, likewise.
- ;; 6. Last status change time, likewise.
- '(0 0) '(0 0) '(0 0) ;CCC how to find out?
- ;; 7. Size in bytes (-1, if number is out of range).
- res-size
- ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
- res-filemodes
- ;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'
- t
- ;; 10. inode number.
- res-inode
- ;; 11. Device number. Will be replaced by a virtual device number.
- -1
- )))))
-
-(defun tramp-do-file-attributes-with-perl
- (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using a Perl script."
- (tramp-message vec 5 "file attributes with perl: %s" localname)
- (tramp-maybe-send-script
- vec tramp-perl-file-attributes "tramp_perl_file_attributes")
- (tramp-send-command-and-read
- vec
- (format "tramp_perl_file_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format)))
-
-(defun tramp-do-file-attributes-with-stat
- (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using stat(1) command."
- (tramp-message vec 5 "file attributes with stat: %s" localname)
- (tramp-send-command-and-read
- vec
- (format
- ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
- ;; parse correctly the sequence "((". Therefore, we add a space.
- "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)"
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\"")
- (tramp-shell-quote-argument localname))))
-
-(defun tramp-handle-set-visited-file-modtime (&optional time-list)
- "Like `set-visited-file-modtime' for Tramp files."
- (unless (buffer-file-name)
- (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
- (buffer-name)))
- (if time-list
- (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
- (let ((f (buffer-file-name))
- coding-system-used)
- (with-parsed-tramp-file-name f nil
- (let* ((attr (file-attributes f))
- ;; '(-1 65535) means file doesn't exists yet.
- (modtime (or (nth 5 attr) '(-1 65535))))
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used (symbol-value 'last-coding-system-used)))
- ;; We use '(0 0) as a don't-know value. See also
- ;; `tramp-do-file-attributes-with-ls'.
- (if (not (equal modtime '(0 0)))
- (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
- (progn
- (tramp-send-command
- v
- (format "%s -ild %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point)
- (progn (end-of-line) (point)))))
- (tramp-set-file-property
- v localname "visited-file-modtime-ild" attr))
- (when (boundp 'last-coding-system-used)
- (set 'last-coding-system-used coding-system-used))
- nil)))))
-
-;; This function makes the same assumption as
-;; `tramp-handle-set-visited-file-modtime'.
-(defun tramp-handle-verify-visited-file-modtime (buf)
- "Like `verify-visited-file-modtime' for Tramp files.
-At the time `verify-visited-file-modtime' calls this function, we
-already know that the buffer is visiting a file and that
-`visited-file-modtime' does not return 0. Do not call this
-function directly, unless those two cases are already taken care
-of."
- (with-current-buffer buf
- (let ((f (buffer-file-name)))
- ;; There is no file visiting the buffer, or the buffer has no
- ;; recorded last modification time, or there is no established
- ;; connection.
- (if (or (not f)
- (eq (visited-file-modtime) 0)
- (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
- t
- (with-parsed-tramp-file-name f nil
- (tramp-flush-file-property v localname)
- (let* ((attr (file-attributes f))
- (modtime (nth 5 attr))
- (mt (visited-file-modtime)))
-
- (cond
- ;; File exists, and has a known modtime.
- ((and attr (not (equal modtime '(0 0))))
- (< (abs (tramp-time-diff
- modtime
- ;; For compatibility, deal with both the old
- ;; (HIGH . LOW) and the new (HIGH LOW) return
- ;; values of `visited-file-modtime'.
- (if (atom (cdr mt))
- (list (car mt) (cdr mt))
- mt)))
- 2))
- ;; Modtime has the don't know value.
- (attr
- (tramp-send-command
- v
- (format "%s -ild %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring
- (point) (progn (end-of-line) (point)))))
- (equal
- attr
- (tramp-get-file-property
- v localname "visited-file-modtime-ild" "")))
- ;; If file does not exist, say it is not modified if and
- ;; only if that agrees with the buffer's record.
- (t (equal mt '(-1 65535))))))))))
-
-(defun tramp-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v localname)
- (unless (zerop (tramp-send-command-and-check
- v
- (format "chmod %s %s"
- (tramp-decimal-to-octal mode)
- (tramp-shell-quote-argument localname))))
- ;; FIXME: extract the proper text from chmod's stderr.
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename))))
-
-(defun tramp-handle-set-file-times (filename &optional time)
- "Like `set-file-times' for Tramp files."
- (zerop
- (if (file-remote-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v localname)
- (let ((time (if (or (null time) (equal time '(0 0)))
- (current-time)
- time))
- ;; With GNU Emacs, `format-time-string' has an optional
- ;; parameter UNIVERSAL. This is preferred, because we
- ;; could handle the case when the remote host is
- ;; located in a different time zone as the local host.
- (utc (not (featurep 'xemacs))))
- (tramp-send-command-and-check
- v (format "%s touch -t %s %s"
- (if utc "TZ=UTC; export TZ;" "")
- (if utc
- (format-time-string "%Y%m%d%H%M.%S" time t)
- (format-time-string "%Y%m%d%H%M.%S" time))
- (tramp-shell-quote-argument localname)))))
-
- ;; We handle also the local part, because in older Emacsen,
- ;; without `set-file-times', this function is an alias for this.
- ;; We are local, so we don't need the UTC settings.
- (tramp-local-call-process
- "touch" nil nil nil "-t"
- (format-time-string "%Y%m%d%H%M.%S" time)
- (tramp-shell-quote-argument filename)))))
-
-(defun tramp-set-file-uid-gid (filename &optional uid gid)
- "Set the ownership for FILENAME.
-If UID and GID are provided, these values are used; otherwise uid
-and gid of the corresponding user is taken. Both parameters must be integers."
- ;; Modern Unices allow chown only for root. So we might need
- ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
- ;; working with su(do)? when it is needed, so it shall succeed in
- ;; the majority of cases.
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (if (file-remote-p filename)
- (with-parsed-tramp-file-name filename nil
- (if (and (zerop (user-uid)) (tramp-local-host-p v))
- ;; If we are root on the local host, we can do it directly.
- (tramp-set-file-uid-gid localname uid gid)
- (let ((uid (or (and (integerp uid) uid)
- (tramp-get-remote-uid v 'integer)))
- (gid (or (and (integerp gid) gid)
- (tramp-get-remote-gid v 'integer))))
- (tramp-send-command
- v (format
- "chown %d:%d %s" uid gid
- (tramp-shell-quote-argument localname))))))
-
- ;; We handle also the local part, because there doesn't exist
- ;; `set-file-uid-gid'. On W32 "chown" might not work.
- (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-local-call-process
- "chown" nil nil nil
- (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
-
-(defun tramp-remote-selinux-p (vec)
- "Check, whether SELINUX is enabled on the remote host."
- (with-connection-property (tramp-get-connection-process vec) "selinux-p"
- (let ((result (tramp-find-executable
- vec "getenforce" (tramp-get-remote-path vec) t t)))
- (and result
- (string-equal
- (tramp-send-command-and-read
- vec (format "echo \\\"`%S`\\\"" result))
- "Enforcing")))))
-
-(defun tramp-handle-file-selinux-context (filename)
- "Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-selinux-context"
- (let ((context '(nil nil nil nil))
- (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
- (when (and (tramp-remote-selinux-p v)
- (zerop (tramp-send-command-and-check
- v (format
- "%s -d -Z %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname)))))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (when (re-search-forward regexp (tramp-compat-line-end-position) t)
- (setq context (list (match-string 1) (match-string 2)
- (match-string 3) (match-string 4))))))
- ;; Return the context.
- context))))
-
-(defun tramp-handle-set-file-selinux-context (filename context)
- "Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (if (and (consp context)
- (tramp-remote-selinux-p v)
- (zerop (tramp-send-command-and-check
- v (format "chcon %s %s %s %s %s"
- (if (stringp (nth 0 context))
- (format "--user=%s" (nth 0 context)) "")
- (if (stringp (nth 1 context))
- (format "--role=%s" (nth 1 context)) "")
- (if (stringp (nth 2 context))
- (format "--type=%s" (nth 2 context)) "")
- (if (stringp (nth 3 context))
- (format "--range=%s" (nth 3 context)) "")
- (tramp-shell-quote-argument localname)))))
- (tramp-set-file-property v localname "file-selinux-context" context)
- (tramp-set-file-property v localname "file-selinux-context" 'undef)))
- ;; We always return nil.
- nil)
-
-;; Simple functions using the `test' command.
-
-(defun tramp-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-executable-p"
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?x)
- (zerop (tramp-run-test "-x" filename))))))
-
-(defun tramp-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-readable-p"
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?r)
- (zerop (tramp-run-test "-r" filename))))))
-
-;; When the remote shell is started, it looks for a shell which groks
-;; tilde expansion. Here, we assume that all shells which grok tilde
-;; expansion will also provide a `test' command which groks `-nt' (for
-;; newer than). If this breaks, tell me about it and I'll try to do
-;; something smarter about it.
-(defun tramp-handle-file-newer-than-file-p (file1 file2)
- "Like `file-newer-than-file-p' for Tramp files."
- (cond ((not (file-exists-p file1))
- nil)
- ((not (file-exists-p file2))
- t)
- ;; We are sure both files exist at this point.
- (t
- (save-excursion
- ;; We try to get the mtime of both files. If they are not
- ;; equal to the "dont-know" value, then we subtract the times
- ;; and obtain the result.
- (let ((fa1 (file-attributes file1))
- (fa2 (file-attributes file2)))
- (if (and (not (equal (nth 5 fa1) '(0 0)))
- (not (equal (nth 5 fa2) '(0 0))))
- (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
- ;; If one of them is the dont-know value, then we can
- ;; still try to run a shell command on the remote host.
- ;; However, this only works if both files are Tramp
- ;; files and both have the same method, same user, same
- ;; host.
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "Files %s and %s must have same method, user, host"
- file1 file2)))
- (with-parsed-tramp-file-name file1 nil
- (zerop (tramp-run-test2
- (tramp-get-test-nt-command v) file1 file2)))))))))
-
-;; Functions implemented using the basic functions above.
-
-(defun tramp-handle-file-modes (filename)
- "Like `file-modes' for Tramp files."
- (let ((truename (or (file-truename filename) filename)))
- (when (file-exists-p truename)
- (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
-
-(defun tramp-default-file-modes (filename)
- "Return file modes of FILENAME as integer.
-If the file modes of FILENAME cannot be determined, return the
-value of `default-file-modes', without execute permissions."
- (or (file-modes filename)
- (logand (default-file-modes) (tramp-octal-to-decimal "0666"))))
-
-(defun tramp-handle-file-directory-p (filename)
- "Like `file-directory-p' for Tramp files."
- ;; Care must be taken that this function returns `t' for symlinks
- ;; pointing to directories. Surely the most obvious implementation
- ;; would be `test -d', but that returns false for such symlinks.
- ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
- ;; I now think he's right. So we could be using `test -d', couldn't
- ;; we?
- ;;
- ;; Alternatives: `cd %s', `test -d %s'
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-directory-p"
- (zerop (tramp-run-test "-d" filename)))))
-
-(defun tramp-handle-file-regular-p (filename)
- "Like `file-regular-p' for Tramp files."
- (and (file-exists-p filename)
- (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
-
-(defun tramp-handle-file-symlink-p (filename)
- "Like `file-symlink-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (let ((x (car (file-attributes filename))))
- (when (stringp x)
- ;; When Tramp is running on VMS, then `file-name-absolute-p'
- ;; might do weird things.
- (if (file-name-absolute-p x)
- (tramp-make-tramp-file-name method user host x)
- x)))))
-
-(defun tramp-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-writable-p"
- (if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?w)
- (zerop (tramp-run-test "-w" filename)))
- ;; If file doesn't exist, check if directory is writable.
- (and (zerop (tramp-run-test
- "-d" (file-name-directory filename)))
- (zerop (tramp-run-test
- "-w" (file-name-directory filename))))))))
-
-(defun tramp-handle-file-ownership-preserved-p (filename)
- "Like `file-ownership-preserved-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-file-property v localname "file-ownership-preserved-p"
- (let ((attributes (file-attributes filename)))
- ;; Return t if the file doesn't exist, since it's true that no
- ;; information would be lost by an (attempted) delete and create.
- (or (null attributes)
- (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
-
-;; Other file name ops.
-
-(defun tramp-handle-directory-file-name (directory)
- "Like `directory-file-name' for Tramp files."
- ;; If localname component of filename is "/", leave it unchanged.
- ;; Otherwise, remove any trailing slash from localname component.
- ;; Method, host, etc, are unchanged. Does it make sense to try
- ;; to avoid parsing the filename?
- (with-parsed-tramp-file-name directory nil
- (if (and (not (zerop (length localname)))
- (eq (aref localname (1- (length localname))) ?/)
- (not (string= localname "/")))
- (substring directory 0 -1)
- directory)))
-
-;; Directory listings.
-
-(defun tramp-handle-directory-files
- (directory &optional full match nosort files-only)
- "Like `directory-files' for Tramp files."
- ;; FILES-ONLY is valid for XEmacs only.
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let ((temp (nreverse (file-name-all-completions "" directory)))
- result item)
-
- (while temp
- (setq item (directory-file-name (pop temp)))
- (when (and (or (null match) (string-match match item))
- (or (null files-only)
- ;; Files only.
- (and (equal files-only t) (file-regular-p item))
- ;; Directories only.
- (file-directory-p item)))
- (push (if full (concat directory item) item)
- result)))
- (if nosort result (sort result 'string<)))))
-
-(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
- "Like `directory-files-and-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (save-excursion
- (mapcar
- (lambda (x)
- (cons (car x)
- (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format)))))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y))))))))
-
-(defun tramp-do-directory-files-and-attributes-with-perl
- (vec localname &optional id-format)
- "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
- (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
- (tramp-maybe-send-script
- vec tramp-perl-directory-files-and-attributes
- "tramp_perl_directory_files_and_attributes")
- (let ((object
- (tramp-send-command-and-read
- vec
- (format "tramp_perl_directory_files_and_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format))))
- (when (stringp object) (tramp-error vec 'file-error object))
- object))
-
-(defun tramp-do-directory-files-and-attributes-with-stat
- (vec localname &optional id-format)
- "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
- (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
- (tramp-send-command-and-read
- vec
- (format
- (concat
- ;; We must care about filenames with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
- ;; but it does not work on all remote systems. Therefore, we
- ;; quote the filenames via sed.
- "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
- "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); "
- "echo \")\"")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command vec)
- (tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\""))))
-
-;; This function should return "foo/" for directories and "bar" for
-;; files.
-(defun tramp-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (unless (save-match-data (string-match "/" filename))
- (with-parsed-tramp-file-name (expand-file-name directory) nil
-
- (all-completions
- filename
- (mapcar
- 'list
- (or
- ;; Try cache first
- (and
- ;; Ignore if expired
- (or (not (integerp tramp-completion-reread-directory-timeout))
- (<= (tramp-time-diff
- (current-time)
- (tramp-get-file-property
- v localname "last-completion" '(0 0 0)))
- tramp-completion-reread-directory-timeout))
-
- ;; Try cache entries for filename, filename with last
- ;; character removed, filename with last two characters
- ;; removed, ..., and finally the empty string - all
- ;; concatenated to the local directory name
-
- ;; This is inefficient for very long filenames, pity
- ;; `reduce' is not available...
- (car
- (apply
- 'append
- (mapcar
- (lambda (x)
- (let ((cache-hit
- (tramp-get-file-property
- v
- (concat localname (substring filename 0 x))
- "file-name-all-completions"
- nil)))
- (when cache-hit (list cache-hit))))
- (tramp-compat-number-sequence (length filename) 0 -1)))))
-
- ;; Cache expired or no matching cache entry found so we need
- ;; to perform a remote operation
- (let (result)
- ;; Get a list of directories and files, including reliably
- ;; tagging the directories with a trailing '/'. Because I
- ;; rock. --daniel@danann.net
-
- ;; Changed to perform `cd' in the same remote op and only
- ;; get entries starting with `filename'. Capture any `cd'
- ;; error messages. Ensure any `cd' and `echo' aliases are
- ;; ignored.
- (tramp-send-command
- v
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (format "tramp_perl_file_name_all_completions %s %s %d"
- (tramp-shell-quote-argument localname)
- (tramp-shell-quote-argument filename)
- (if (symbol-value
- ;; `read-file-name-completion-ignore-case'
- ;; is introduced with Emacs 22.1.
- (if (boundp
- 'read-file-name-completion-ignore-case)
- 'read-file-name-completion-ignore-case
- 'completion-ignore-case))
- 1 0)))
-
- (format (concat
- "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
- ;; `ls' with wildcard might fail with `Argument
- ;; list too long' error in some corner cases; if
- ;; `ls' fails after `cd' succeeded, chances are
- ;; that's the case, so let's retry without
- ;; wildcard. This will return "too many" entries
- ;; but that isn't harmful.
- " || %s -a 2>/dev/null)"
- " | while read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
- " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
- " && \\echo ok) || \\echo fail")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command v)
- ;; When `filename' is empty, just `ls' without
- ;; filename argument is more efficient than `ls *'
- ;; for very large directories and might avoid the
- ;; `Argument list too long' error.
- ;;
- ;; With and only with wildcard, we need to add
- ;; `-d' to prevent `ls' from descending into
- ;; sub-directories.
- (if (zerop (length filename))
- "."
- (concat (tramp-shell-quote-argument filename) "* -d"))
- (tramp-get-ls-command v)
- (tramp-get-test-command v))))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
-
- ;; Check result code, found in last line of output
- (forward-line -1)
- (if (looking-at "^fail$")
- (progn
- ;; Grab error message from line before last line
- ;; (it was put there by `cd 2>&1')
- (forward-line -1)
- (tramp-error
- v 'file-error
- "tramp-handle-file-name-all-completions: %s"
- (buffer-substring
- (point) (tramp-compat-line-end-position))))
- ;; For peace of mind, if buffer doesn't end in `fail'
- ;; then it should end in `ok'. If neither are in the
- ;; buffer something went seriously wrong on the remote
- ;; side.
- (unless (looking-at "^ok$")
- (tramp-error
- v 'file-error
- "\
-tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
- (tramp-shell-quote-argument localname) (buffer-string))))
-
- (while (zerop (forward-line -1))
- (push (buffer-substring
- (point) (tramp-compat-line-end-position))
- result)))
-
- ;; Because the remote op went through OK we know the
- ;; directory we `cd'-ed to exists
- (tramp-set-file-property
- v localname "file-exists-p" t)
-
- ;; Because the remote op went through OK we know every
- ;; file listed by `ls' exists.
- (mapc (lambda (entry)
- (tramp-set-file-property
- v (concat localname entry) "file-exists-p" t))
- result)
-
- (tramp-set-file-property
- v localname "last-completion" (current-time))
-
- ;; Store result in the cache
- (tramp-set-file-property
- v (concat localname filename)
- "file-name-all-completions"
- result))))))))
-
-(defun tramp-handle-file-name-completion
- (filename directory &optional predicate)
- "Like `file-name-completion' for Tramp files."
- (unless (tramp-tramp-file-p directory)
- (error
- "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
- directory))
- (try-completion
- filename
- (mapcar 'list (file-name-all-completions filename directory))
- (when predicate
- (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
-
-;; cp, mv and ln
-
-(defun tramp-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (unless (tramp-equal-remote filename newname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (let ((ln (when v1 (tramp-get-remote-ln v1))))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname)
- (not (numberp ok-if-already-exists))
- (y-or-n-p
- (format
- "File %s already exists; make it a new name anyway? "
- newname)))
- (tramp-error
- v2 'file-error
- "add-name-to-file: file %s already exists" newname))
- (tramp-flush-file-property v2 (file-name-directory v2-localname))
- (tramp-flush-file-property v2 v2-localname)
- (tramp-barf-unless-okay
- v1
- (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))
- "error with add-name-to-file, see buffer `%s' for details"
- (buffer-name))))))
-
-(defun tramp-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
- "Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- (cond
- ;; At least one file a Tramp file?
- ((or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context))
- ;; Compat section.
- (preserve-selinux-context
- (tramp-run-real-handler
- 'copy-file
- (list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)))
- (preserve-uid-gid
- (tramp-run-real-handler
- 'copy-file
- (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
- (t
- (tramp-run-real-handler
- 'copy-file (list filename newname ok-if-already-exists keep-date)))))
-
-(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
- "Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must have
- ;; the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (if (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (if (not (file-directory-p (file-name-directory newname)))
- (make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname keep-date))
- ;; We must do it file-wise.
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))))
-
-(defun tramp-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- ;; Check if both files are local -- invoke normal rename-file.
- ;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-do-copy-or-rename-file
- 'rename filename newname ok-if-already-exists t t)
- (tramp-run-real-handler
- 'rename-file (list filename newname ok-if-already-exists))))
-
-(defun tramp-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
- "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid if both files are on the same host.
-PRESERVE-SELINUX-CONTEXT activates selinux commands.
-
-This function is invoked by `tramp-handle-copy-file' and
-`tramp-handle-rename-file'. It is an error if OP is neither of `copy'
-and `rename'. FILENAME and NEWNAME must be absolute file names."
- (unless (memq op '(copy rename))
- (error "Unknown operation `%s', must be `copy' or `rename'" op))
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (context (and preserve-selinux-context
- (apply 'file-selinux-context (list filename))))
- pr tm)
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))
-
- (with-progress-reporter
- v 0 (format "%s %s to %s"
- (if (eq op 'copy) "Copying" "Renaming")
- filename newname)
-
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((tramp-method-out-of-band-p
- v1 (nth 7 (file-attributes filename)))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go back
- ;; and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which filename handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
- (cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
-
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
-
- ;; Handle `preserve-selinux-context'.
- (when context (apply 'set-file-selinux-context (list newname context)))
-
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-property v1 (file-name-directory localname))
- (tramp-flush-file-property v1 localname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-property v2 (file-name-directory localname))
- (tramp-flush-file-property v2 localname)))))))
-
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
- "Use an Emacs buffer to copy or rename a file.
-First arg OP is either `copy' or `rename' and indicates the operation.
-FILENAME is the source file, NEWNAME the target file.
-KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
- (with-temp-buffer
- ;; We must disable multibyte, because binary data shall not be
- ;; converted.
- (set-buffer-multibyte nil)
- (let ((coding-system-for-read 'binary)
- (jka-compr-inhibit t))
- (insert-file-contents-literally filename))
- ;; We don't want the target file to be compressed, so we let-bind
- ;; `jka-compr-inhibit' to t.
- (let ((coding-system-for-write 'binary)
- (jka-compr-inhibit t))
- (write-region (point-min) (point-max) newname)))
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
- ;; Set the mode.
- (set-file-modes newname (tramp-default-file-modes filename))
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy) (delete-file filename)))
-
-(defun tramp-do-copy-or-rename-file-directly
- (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
- "Invokes `cp' or `mv' on the remote system.
-OP must be one of `copy' or `rename', indicating `cp' or `mv',
-respectively. FILENAME specifies the file to copy or rename,
-NEWNAME is the name of the new file (for copy) or the new name of
-the file (for rename). Both files must reside on the same host.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid from FILENAME."
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (file-times (nth 5 (file-attributes filename)))
- (file-modes (tramp-default-file-modes filename)))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
- ((eq op 'copy) "cp -f")
- ((eq op 'rename) "mv -f")
- (t (tramp-error
- v 'file-error
- "Unknown operation `%s', must be `copy' or `rename'"
- op))))
- (localname1
- (if t1
- (tramp-file-name-handler 'file-remote-p filename 'localname)
- filename))
- (localname2
- (if t2
- (tramp-file-name-handler 'file-remote-p newname 'localname)
- newname))
- (prefix (file-remote-p (if t1 filename newname)))
- cmd-result)
-
- (cond
- ;; Both files are on a remote host, with same user.
- ((and t1 t2)
- (setq cmd-result
- (tramp-send-command-and-check
- v
- (format "%s %s %s" cmd
- (tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument localname2))))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (unless
- (or
- (and keep-date
- ;; Mask cp -f error.
- (re-search-forward
- tramp-operation-not-permitted-regexp nil t))
- (zerop cmd-result))
- (tramp-error-with-buffer
- nil v 'file-error
- "Copying directly failed, see buffer `%s' for details."
- (buffer-name)))))
-
- ;; We are on the local host.
- ((or t1 t2)
- (cond
- ;; We can do it directly.
- ((let (file-name-handler-alist)
- (and (file-readable-p localname1)
- (file-writable-p (file-name-directory localname2))
- (or (file-directory-p localname2)
- (file-writable-p localname2))))
- (if (eq op 'copy)
- (tramp-compat-copy-file
- localname1 localname2 ok-if-already-exists
- keep-date preserve-uid-gid)
- (tramp-run-real-handler
- 'rename-file (list localname1 localname2 ok-if-already-exists))))
-
- ;; We can do it directly with `tramp-send-command'
- ((and (file-readable-p (concat prefix localname1))
- (file-writable-p
- (file-name-directory (concat prefix localname2)))
- (or (file-directory-p (concat prefix localname2))
- (file-writable-p (concat prefix localname2))))
- (tramp-do-copy-or-rename-file-directly
- op (concat prefix localname1) (concat prefix localname2)
- ok-if-already-exists keep-date t)
- ;; We must change the ownership to the local user.
- (tramp-set-file-uid-gid
- (concat prefix localname2)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; We need a temporary file in between.
- (t
- ;; Create the temporary file.
- (let ((tmpfile (tramp-compat-make-temp-file localname1)))
- (unwind-protect
- (progn
- (cond
- (t1
- (or
- (zerop
- (tramp-send-command-and-check
- v (format
- "%s %s %s" cmd
- (tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument tmpfile))))
- (tramp-error-with-buffer
- nil v 'file-error
- "Copying directly failed, see buffer `%s' for details."
- (tramp-get-buffer v)))
- ;; We must change the ownership as remote user.
- ;; Since this does not work reliable, we also
- ;; give read permissions.
- (set-file-modes
- (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
- (tramp-set-file-uid-gid
- (concat prefix tmpfile)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
- (t2
- (if (eq op 'copy)
- (tramp-compat-copy-file
- localname1 tmpfile t
- keep-date preserve-uid-gid)
- (tramp-run-real-handler
- 'rename-file
- (list localname1 tmpfile t)))
- ;; We must change the ownership as local user.
- ;; Since this does not work reliable, we also
- ;; give read permissions.
- (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
- (tramp-set-file-uid-gid
- tmpfile
- (tramp-get-remote-uid v 'integer)
- (tramp-get-remote-gid v 'integer))))
-
- ;; Move the temporary file to its destination.
- (cond
- (t2
- (or
- (zerop
- (tramp-send-command-and-check
- v (format
- "cp -f -p %s %s"
- (tramp-shell-quote-argument tmpfile)
- (tramp-shell-quote-argument localname2))))
- (tramp-error-with-buffer
- nil v 'file-error
- "Copying directly failed, see buffer `%s' for details."
- (tramp-get-buffer v))))
- (t1
- (tramp-run-real-handler
- 'rename-file
- (list tmpfile localname2 ok-if-already-exists)))))
-
- ;; Save exit.
- (condition-case nil
- (delete-file tmpfile)
- (error)))))))))
-
- ;; Set the time and mode. Mask possible errors.
- (condition-case nil
- (when keep-date
- (set-file-times newname file-times)
- (set-file-modes newname file-modes))
- (error)))))
-
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
- "Invoke rcp program to copy.
-The method used must be an out-of-band method."
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- copy-program copy-args copy-env copy-keep-date port spec
- source target)
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (if (and t1 t2)
-
- ;; Both are Tramp files. We shall optimize it, when the
- ;; methods for filename and newname are the same.
- (let* ((dir-flag (file-directory-p filename))
- (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
- (if dir-flag
- (setq tmpfile
- (expand-file-name
- (file-name-nondirectory newname) tmpfile)))
- (unwind-protect
- (progn
- (tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile keep-date)
- (tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname keep-date))
- ;; Save exit.
- (condition-case nil
- (if dir-flag
- (tramp-compat-delete-directory
- (expand-file-name ".." tmpfile) 'recursive)
- (delete-file tmpfile))
- (error))))
-
- ;; Expand hops. Might be necessary for gateway methods.
- (setq v (car (tramp-compute-multi-hops v)))
- (aset v 3 localname)
-
- ;; Check which ones of source and target are Tramp files.
- (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
- target (funcall
- (if (and (file-directory-p filename)
- (string-equal
- (file-name-nondirectory filename)
- (file-name-nondirectory newname)))
- 'file-name-directory
- 'identity)
- (if t2 (tramp-make-copy-program-file-name v) newname)))
-
- ;; Check for port number. Until now, there's no need for handling
- ;; like method, user, host.
- (setq host (tramp-file-name-real-host v)
- port (tramp-file-name-port v)
- port (or (and port (number-to-string port)) ""))
-
- ;; Compose copy command.
- (setq spec (format-spec-make
- ?h host ?u user ?p port
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" "")
- ?k (if keep-date " " ""))
- copy-program (tramp-get-method-parameter
- method 'tramp-copy-program)
- copy-keep-date (tramp-get-method-parameter
- method 'tramp-copy-keep-date)
- copy-args
- (delq
- nil
- (mapcar
- (lambda (x)
- (setq
- x
- ;; " " is indication for keep-date argument.
- (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
- (unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-args)))
- copy-env
- (delq
- nil
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-env))))
-
- ;; Check for program.
- (when (and (fboundp 'executable-find)
- (not (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (executable-find copy-program))))
- (tramp-error
- v 'file-error "Cannot find copy program: %s" copy-program))
-
- ;; Set variables for computing the prompt for reading
- ;; password.
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-host v))
-
- (unwind-protect
- (with-temp-buffer
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if t1 filename newname)))
- (process-environment (copy-sequence process-environment)))
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- (while copy-env
- (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
- (setenv (pop copy-env) (pop copy-env)))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled. The default directory must be local, in
- ;; order to apply the correct `copy-program'. We don't
- ;; set a timeout, because the copying of large files can
- ;; last longer than 60 secs.
- (let ((p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply 'start-process
- (tramp-get-connection-property
- v "process-name" nil)
- (tramp-get-connection-property
- v "process-buffer" nil)
- copy-program
- (append copy-args (list source target))))))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v tramp-actions-copy-out-of-band))))
-
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil))
-
- ;; Handle KEEP-DATE argument.
- (when (and keep-date (not copy-keep-date))
- (set-file-times newname (nth 5 (file-attributes filename))))
-
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (ignore-errors
- (set-file-modes newname (tramp-default-file-modes filename)))))
-
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (if (file-regular-p filename)
- (delete-file filename)
- (tramp-compat-delete-directory filename 'recursive))))))
-
-(defun tramp-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- (tramp-flush-directory-property v (file-name-directory localname))
- (save-excursion
- (tramp-barf-unless-okay
- v
- (format "%s %s"
- (if parents "mkdir -p" "mkdir")
- (tramp-shell-quote-argument localname))
- "Couldn't make directory %s" dir))))
-
-(defun tramp-handle-delete-directory (directory &optional recursive)
- "Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
- (unless (zerop (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (if recursive "rm -rf" "rmdir")
- (tramp-shell-quote-argument localname))))
- (tramp-error v 'file-error "Couldn't delete %s" directory))))
-
-(defun tramp-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless
- (zerop
- (tramp-send-command-and-check
- v (format "%s %s"
- (or (and trash (tramp-get-remote-trash v)) "rm -f")
- (tramp-shell-quote-argument localname))))
- (tramp-error v 'file-error "Couldn't delete %s" filename))))
-
-;; Dired.
-
-;; CCC: This does not seem to be enough. Something dies when
-;; we try and delete two directories under Tramp :/
-(defun tramp-handle-dired-recursive-delete-directory (filename)
- "Recursively delete the directory given.
-This is like `dired-recursive-delete-directory' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; Run a shell command 'rm -r <localname>'
- ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
- (unless (file-exists-p filename)
- (tramp-error v 'file-error "No such directory: %s" filename))
- ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
- (tramp-send-command
- v
- (format "rm -rf %s" (tramp-shell-quote-argument localname))
- ;; Don't read the output, do it explicitely.
- nil t)
- ;; Wait for the remote system to return to us...
- ;; This might take a while, allow it plenty of time.
- (tramp-wait-for-output (tramp-get-connection-process v) 120)
- ;; Make sure that it worked...
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
- (and (file-exists-p filename)
- (tramp-error
- v 'file-error "Failed to recursively delete %s" filename))))
-
-(defun tramp-handle-dired-compress-file (file &rest ok-flag)
- "Like `dired-compress-file' for Tramp files."
- ;; OK-FLAG is valid for XEmacs only, but not implemented.
- ;; Code stolen mainly from dired-aux.el.
- (with-parsed-tramp-file-name file nil
- (tramp-flush-file-property v localname)
- (save-excursion
- (let ((suffixes
- (if (not (featurep 'xemacs))
- ;; Emacs case
- (symbol-value 'dired-compress-file-suffixes)
- ;; XEmacs has `dired-compression-method-alist', which is
- ;; transformed into `dired-compress-file-suffixes' structure.
- (mapcar
- (lambda (x)
- (list (concat (regexp-quote (nth 1 x)) "\\'")
- nil
- (mapconcat 'identity (nth 3 x) " ")))
- (symbol-value 'dired-compression-method-alist))))
- suffix)
- ;; See if any suffix rule matches this file name.
- (while suffixes
- (let (case-fold-search)
- (if (string-match (car (car suffixes)) localname)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
-
- (cond ((file-symlink-p file)
- nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (with-progress-reporter v 0 (format "Uncompressing %s" file)
- (when (zerop
- (tramp-send-command-and-check
- v (concat (nth 2 suffix) " "
- (tramp-shell-quote-argument localname))))
- ;; `dired-remove-file' is not defined in XEmacs.
- (tramp-compat-funcall 'dired-remove-file file)
- (string-match (car suffix) file)
- (concat (substring file 0 (match-beginning 0))))))
- (t
- ;; We don't recognize the file as compressed, so compress it.
- ;; Try gzip.
- (with-progress-reporter v 0 (format "Compressing %s" file)
- (when (zerop
- (tramp-send-command-and-check
- v (concat "gzip -f "
- (tramp-shell-quote-argument localname))))
- ;; `dired-remove-file' is not defined in XEmacs.
- (tramp-compat-funcall 'dired-remove-file file)
- (cond ((file-exists-p (concat file ".gz"))
- (concat file ".gz"))
- ((file-exists-p (concat file ".z"))
- (concat file ".z"))
- (t nil))))))))))
-
-(defun tramp-handle-dired-uncache (dir &optional dir-p)
- "Like `dired-uncache' for Tramp files."
- ;; DIR-P is valid for XEmacs only.
- (with-parsed-tramp-file-name
- (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
- (tramp-flush-file-property v localname)))
-
-;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
-;; not sure at all that this is the right way to do it, but let's hope
-;; it works for now, and wait for a guru to point out the Right Way to
-;; achieve this.
-;;(eval-when-compile
-;; (unless (fboundp 'dired-insert-set-properties)
-;; (fset 'dired-insert-set-properties 'ignore)))
-;; Gerd suggests this:
-(eval-when-compile (require 'dired))
-;; Note that dired is required at run-time, too, when it is needed.
-;; It is only needed on XEmacs for the function
-;; `dired-insert-set-properties'.
-
-(defun tramp-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (if (and (featurep 'ls-lisp)
- (not (symbol-value 'ls-lisp-use-insert-directory-program)))
- (tramp-run-real-handler
- 'insert-directory (list filename switches wildcard full-directory-p))
- (when (stringp switches)
- (setq switches (split-string switches)))
- (when (and (member "--dired" switches)
- (not (tramp-get-ls-command-with-dired v)))
- (setq switches (delete "--dired" switches)))
- (when wildcard
- (setq wildcard (tramp-run-real-handler
- 'file-name-nondirectory (list localname)))
- (setq localname (tramp-run-real-handler
- 'file-name-directory (list localname))))
- (unless full-directory-p
- (setq switches (add-to-list 'switches "-d" 'append)))
- (setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
- (when wildcard
- (setq switches (concat switches " " wildcard)))
- (tramp-message
- v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
- switches filename (if wildcard "yes" "no")
- (if full-directory-p "yes" "no"))
- ;; If `full-directory-p', we just say `ls -l FILENAME'.
- ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
- (if full-directory-p
- (tramp-send-command
- v
- (format "%s %s %s 2>/dev/null"
- (tramp-get-ls-command v)
- switches
- (if wildcard
- localname
- (tramp-shell-quote-argument (concat localname ".")))))
- (tramp-barf-unless-okay
- v
- (format "cd %s" (tramp-shell-quote-argument
- (tramp-run-real-handler
- 'file-name-directory (list localname))))
- "Couldn't `cd %s'"
- (tramp-shell-quote-argument
- (tramp-run-real-handler 'file-name-directory (list localname))))
- (tramp-send-command
- v
- (format "%s %s %s"
- (tramp-get-ls-command v)
- switches
- (if (or wildcard
- (zerop (length
- (tramp-run-real-handler
- 'file-name-nondirectory (list localname)))))
- ""
- (tramp-shell-quote-argument
- (tramp-run-real-handler
- 'file-name-nondirectory (list localname)))))))
- (let ((beg (point)))
- ;; We cannot use `insert-buffer-substring' because the Tramp
- ;; buffer changes its contents before insertion due to calling
- ;; `expand-file' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string)))
-
- ;; Check for "--dired" output.
- (forward-line -2)
- (when (looking-at "//SUBDIRED//")
- (forward-line -1))
- (when (looking-at "//DIRED//\\s-+")
- (let ((databeg (match-end 0))
- (end (tramp-compat-line-end-position)))
- ;; Now read the numeric positions of file names.
- (goto-char databeg)
- (while (< (point) end)
- (let ((start (+ beg (read (current-buffer))))
- (end (+ beg (read (current-buffer)))))
- (if (memq (char-after end) '(?\n ?\ ))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t))))))
- ;; Remove trailing lines.
- (goto-char (tramp-compat-line-beginning-position))
- (while (looking-at "//")
- (forward-line 1)
- (delete-region (match-beginning 0) (point)))
-
- ;; The inserted file could be from somewhere else.
- (when (and (not wildcard) (not full-directory-p))
- (goto-char (point-max))
- (when (file-symlink-p filename)
- (goto-char (search-backward "->" beg 'noerror)))
- (search-backward
- (if (zerop (length (file-name-nondirectory filename)))
- "."
- (file-name-nondirectory filename))
- beg 'noerror)
- (replace-match (file-relative-name filename) t))
-
- (goto-char (point-max))))))