;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: kai.grossjohann@gmx.net
;; Keywords: comm, processes
;;
;; Notes:
;; -----
-;;
+;;
;; This package only works for Emacs 20 and higher, and for XEmacs 21
;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs
;; 19 is reported to have other problems. For XEmacs 21, you need the
(defgroup tramp nil
"Edit remote files with a combination of rsh and rcp or similar programs."
- :group 'files)
+ :group 'files
+ :version "22.1")
(defcustom tramp-verbose 9
"*Verbosity level for tramp.el. 0 means be silent, 10 is most verbose."
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
- :type '(repeat
+ :type '(repeat
(list (regexp :tag "File regexp")
(string :tag "Backup Dir")
(set :inline t
(tramp-copy-args nil)
(tramp-copy-keep-date-arg "-p")
(tramp-password-end-of-line "xy")) ;see docstring for "xy"
- ("fcp"
+ ("fcp"
(tramp-connection-function tramp-open-connection-rsh)
(tramp-login-program "fsh")
(tramp-copy-program "fcp")
("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n")
("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
- ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
+ ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
("su" tramp-multi-connect-su "su - %u%n")
("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n"))
"*List of connection functions for multi-hop methods.
"sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function
"multi" nil)
- (tramp-set-completion-function
+ (tramp-set-completion-function
"scpx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"sshx" tramp-completion-function-alist-ssh)
:group 'tramp
:type 'regexp)
+(defcustom tramp-operation-not-permitted-regexp
+ (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
+ (regexp-opt '("Operation not permitted") t))
+ "Regular expression matching keep-date problems in (s)cp operations.
+Copying has been performed successfully already, so this message can
+be ignored safely."
+ :group 'tramp
+ :type 'regexp)
+
(defcustom tramp-process-alive-regexp
""
"Regular expression indicating a process has finished.
rm -f /tmp/tramp.$$
}"
"Shell function to implement `uudecode' to standard output.
-Many systems support `uudecode -o -' for this or `uudecode -p', but
-some systems don't, and for them we have this shell function.")
+Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
+for this or `uudecode -p', but some systems don't, and for them
+we have this shell function.")
;; Perl script to implement `file-attributes' in a Lisp `read'able
;; output. If you are hacking on this, note that you get *no* output
;; The device number is returned as "-1", because there will be a virtual
;; device number set in `tramp-handle-file-attributes'
(defconst tramp-perl-file-attributes "\
-\($f, $n) = @ARGV;
-@s = lstat($f);
-if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; }
-elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; }
-else { $l = \"nil\" };
-$u = ($n eq \"nil\") ? $s[4] : getpwuid($s[4]);
-$g = ($n eq \"nil\") ? $s[5] : getgrgid($s[5]);
-printf(\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\",
-$l, $s[3], $u, $g, $s[8] >> 16 & 0xffff, $s[8] & 0xffff,
-$s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff,
-$s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff);"
+@stat = lstat($ARGV[0]);
+if (($stat[2] & 0170000) == 0120000)
+{
+ $type = readlink($ARGV[0]);
+ $type = \"\\\"$type\\\"\";
+}
+elsif (($stat[2] & 0170000) == 040000)
+{
+ $type = \"t\";
+}
+else
+{
+ $type = \"nil\"
+};
+$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
+$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
+printf(
+ \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\",
+ $type,
+ $stat[3],
+ $uid,
+ $gid,
+ $stat[8] >> 16 & 0xffff,
+ $stat[8] & 0xffff,
+ $stat[9] >> 16 & 0xffff,
+ $stat[9] & 0xffff,
+ $stat[10] >> 16 & 0xffff,
+ $stat[10] & 0xffff,
+ $stat[7],
+ $stat[2],
+ $stat[1] >> 16 & 0xffff,
+ $stat[1] & 0xffff
+);"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.")
+(defconst tramp-perl-directory-files-and-attributes "\
+chdir($ARGV[0]);
+opendir(DIR,\".\");
+@list = readdir(DIR);
+closedir(DIR);
+$n = scalar(@list);
+printf(\"(\\n\");
+for($i = 0; $i < $n; $i++)
+{
+ $filename = $list[$i];
+ @stat = lstat($filename);
+ if (($stat[2] & 0170000) == 0120000)
+ {
+ $type = readlink($filename);
+ $type = \"\\\"$type\\\"\";
+ }
+ elsif (($stat[2] & 0170000) == 040000)
+ {
+ $type = \"t\";
+ }
+ else
+ {
+ $type = \"nil\"
+ };
+ $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
+ $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
+ printf(
+ \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\",
+ $filename,
+ $type,
+ $stat[3],
+ $uid,
+ $gid,
+ $stat[8] >> 16 & 0xffff,
+ $stat[8] & 0xffff,
+ $stat[9] >> 16 & 0xffff,
+ $stat[9] & 0xffff,
+ $stat[10] >> 16 & 0xffff,
+ $stat[10] & 0xffff,
+ $stat[7],
+ $stat[2],
+ $stat[1] >> 16 & 0xffff,
+ $stat[1] & 0xffff,
+ $stat[0] >> 16 & 0xffff,
+ $stat[0] & 0xffff);
+}
+printf(\")\\n\");"
+ "Perl script implementing `directory-files-attributes' as Lisp `read'able
+output.")
+
;; ;; These two use uu encoding.
;; (defvar tramp-perl-encode "%s -e'\
;; print qq(begin 644 xxx\n);
my $len = length($pending);
my $chunk = substr($pending, 0, $len & ~3);
+ $pending = substr($pending, $len & ~3 + 1);
# Easy method: translate from chars to (pregenerated) six-bit packets, join,
# split in 8-bit chunks and convert back to char.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-attributes . tramp-handle-file-attributes)
(file-modes . tramp-handle-file-modes)
- (file-directory-files . tramp-handle-file-directory-files)
(directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
(file-name-all-completions . tramp-handle-file-name-all-completions)
(file-name-completion . tramp-handle-file-name-completion)
(add-name-to-file . tramp-handle-add-name-to-file)
(delete-file . tramp-handle-delete-file)
(directory-file-name . tramp-handle-directory-file-name)
(shell-command . tramp-handle-shell-command)
+ (process-file . tramp-handle-process-file)
(insert-directory . tramp-handle-insert-directory)
(expand-file-name . tramp-handle-expand-file-name)
(file-local-copy . tramp-handle-file-local-copy)
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
;; To be activated for debugging containing this macro
-(def-edebug-spec with-parsed-tramp-file-name t)
+;; It works only when VAR is nil. Otherwise, it can be deactivated by
+;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0)
+;; I'm too stupid to write a precise SPEC for it.
+(put 'with-parsed-tramp-file-name 'edebug-form-spec t)
(defmacro tramp-let-maybe (variable value &rest body)
"Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
(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.
l-multi-method l-method l-user l-host
(format "cd %s && %s -sf %s %s"
cwd ln
- filename
+ filename
l-localname)
t)))))
(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
"Like `file-truename' for tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(let* ((steps (tramp-split-string localname "/"))
(localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
(file-name-as-directory localname)))
;; Daniel Pittman <daniel@danann.net>
(defun tramp-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for tramp files."
- (let ((nonnumeric (and id-format (equal id-format 'string)))
- result)
+ (when (file-exists-p filename)
+ ;; file exists, find out stuff
+ (unless id-format (setq id-format 'integer))
(with-parsed-tramp-file-name filename nil
- (when (file-exists-p filename)
- ;; file exists, find out stuff
- (save-excursion
- (if (tramp-get-remote-perl multi-method method user host)
- (setq result
- (tramp-handle-file-attributes-with-perl
- multi-method method user host localname nonnumeric))
- (setq result
- (tramp-handle-file-attributes-with-ls
- multi-method method user host localname nonnumeric)))
- ;; set virtual device number
- (setcar (nthcdr 11 result)
- (tramp-get-device multi-method method user host)))))
- result))
+ (save-excursion
+ (tramp-convert-file-attributes
+ multi-method method user host
+ (if (tramp-get-remote-perl multi-method method user host)
+ (tramp-handle-file-attributes-with-perl multi-method method user host
+ localname id-format)
+ (tramp-handle-file-attributes-with-ls multi-method method user host
+ localname id-format)))))))
(defun tramp-handle-file-attributes-with-ls
- (multi-method method user host localname &optional nonnumeric)
+ (multi-method method user host localname &optional id-format)
"Implement `file-attributes' for tramp files using the ls(1) command."
(let (symlinkp dirp
res-inode res-filemodes res-numlinks
multi-method method user host
(format "%s %s %s"
(tramp-get-ls-command multi-method method user host)
- (if nonnumeric "-ild" "-ildn")
+ (if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname)))
(tramp-wait-for-output)
;; parse `ls -l' output ...
;; ... uid and gid
(setq res-uid (read (current-buffer)))
(setq res-gid (read (current-buffer)))
- (unless nonnumeric
+ (when (eq id-format 'integer)
(unless (numberp res-uid) (setq res-uid -1))
(unless (numberp res-gid) (setq res-gid -1)))
;; ... size
)))
(defun tramp-handle-file-attributes-with-perl
- (multi-method method user host localname &optional nonnumeric)
- "Implement `file-attributes' for tramp files using a Perl script.
-
-The Perl command is sent to the remote machine when the connection
-is initially created and is kept cached by the remote shell."
+ (multi-method method user host localname &optional id-format)
+ "Implement `file-attributes' for tramp files using a Perl script."
(tramp-message-for-buffer multi-method method user host 10
"file attributes with perl: %s"
(tramp-make-tramp-file-name
multi-method method user host localname))
- (tramp-send-command
- multi-method method user host
- (format "tramp_file_attributes %s %s"
- (tramp-shell-quote-argument localname) nonnumeric))
+ (tramp-maybe-send-perl-script multi-method method user host
+ tramp-perl-file-attributes
+ "tramp_file_attributes")
+ (tramp-send-command multi-method method user host
+ (format "tramp_file_attributes %s %s"
+ (tramp-shell-quote-argument localname) id-format))
(tramp-wait-for-output)
- (let ((result (read (current-buffer))))
- (setcar (nthcdr 8 result)
- (tramp-file-mode-from-int (nth 8 result)))
- result))
-
-(defun tramp-get-device (multi-method method user host)
- "Returns the virtual device number.
-If it doesn't exist, generate a new one."
- (let ((string (tramp-make-tramp-file-name multi-method method user host "")))
- (unless (assoc string tramp-devices)
- (add-to-list 'tramp-devices
- (list string (length tramp-devices))))
- (list -1 (nth 1 (assoc string tramp-devices)))))
+ (read (current-buffer)))
(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)))
- (when time-list
- (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))
- (let ((f (buffer-file-name))
- (coding-system-used nil))
- (with-parsed-tramp-file-name f nil
- (let* ((attr (file-attributes f))
- (modtime (nth 5 attr)))
- ;; We use '(0 0) as a don't-know value. See also
- ;; `tramp-handle-file-attributes-with-ls'.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used last-coding-system-used))
- (if (not (equal modtime '(0 0)))
- (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
- (save-excursion
- (tramp-send-command
- multi-method method user host
- (format "%s -ild %s"
- (tramp-get-ls-command multi-method method user host)
- (tramp-shell-quote-argument localname)))
- (tramp-wait-for-output)
- (setq attr (buffer-substring (point)
- (progn (end-of-line) (point)))))
- (setq tramp-buffer-file-attributes attr))
- (when (boundp 'last-coding-system-used)
- (setq last-coding-system-used coding-system-used))
- nil))))
+ (if time-list
+ (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
+ (let ((f (buffer-file-name))
+ (coding-system-used nil))
+ (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))))
+ ;; We use '(0 0) as a don't-know value. See also
+ ;; `tramp-handle-file-attributes-with-ls'.
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used last-coding-system-used))
+ (if (not (equal modtime '(0 0)))
+ (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
+ (save-excursion
+ (tramp-send-command
+ multi-method method user host
+ (format "%s -ild %s"
+ (tramp-get-ls-command multi-method method user host)
+ (tramp-shell-quote-argument localname)))
+ (tramp-wait-for-output)
+ (setq attr (buffer-substring (point)
+ (progn (end-of-line) (point)))))
+ (setq tramp-buffer-file-attributes attr))
+ (when (boundp 'last-coding-system-used)
+ (setq last-coding-system-used coding-system-used))
+ nil)))))
;; CCC continue here
;; 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."
+ "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)))
- (with-parsed-tramp-file-name f nil
- (let* ((attr (file-attributes f))
- (modtime (nth 5 attr)))
- (cond ((and attr (not (equal modtime '(0 0))))
- ;; Why does `file-attributes' return a list (HIGH
- ;; LOW), but `visited-file-modtime' returns a cons
- ;; (HIGH . LOW)?
- (let ((mt (visited-file-modtime)))
- (< (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)))
- (attr
- (save-excursion
- (tramp-send-command
- multi-method method user host
- (format "%s -ild %s"
- (tramp-get-ls-command multi-method method
- user host)
- (tramp-shell-quote-argument localname)))
- (tramp-wait-for-output)
- (setq attr (buffer-substring
- (point) (progn (end-of-line) (point)))))
- (equal tramp-buffer-file-attributes attr))
- ;; If file does not exist, say it is not modified.
- (t nil)))))))
+ ;; There is no file visiting the buffer, or the buffer has no
+ ;; recorded last modification time.
+ (if (or (not (buffer-file-name))
+ (eq (visited-file-modtime) 0))
+ t
+ (let ((f (buffer-file-name)))
+ (with-parsed-tramp-file-name f nil
+ (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
+ (save-excursion
+ (tramp-send-command
+ multi-method method user host
+ (format "%s -ild %s"
+ (tramp-get-ls-command multi-method method user host)
+ (tramp-shell-quote-argument localname)))
+ (tramp-wait-for-output)
+ (setq attr (buffer-substring
+ (point) (progn (end-of-line) (point)))))
+ (equal tramp-buffer-file-attributes attr))
+ ;; 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))))))))))
(defadvice clear-visited-file-modtime (after tramp activate)
"Set `tramp-buffer-file-attributes' back to nil.
(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 fa1) (nth 5 fa2)))
+ (> 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
(push item result)))))))
result)))
+(defun tramp-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for tramp files."
+ (when (tramp-handle-file-exists-p directory)
+ (save-excursion
+ (setq directory (tramp-handle-expand-file-name directory))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-maybe-send-perl-script multi-method method user host
+ tramp-perl-directory-files-and-attributes
+ "tramp_directory_files_and_attributes")
+ (tramp-send-command multi-method method user host
+ (format "tramp_directory_files_and_attributes %s %s"
+ (tramp-shell-quote-argument localname)
+ (or id-format 'integer)))
+ (tramp-wait-for-output)
+ (let* ((root (cons nil (read (current-buffer))))
+ (cell root))
+ (while (cdr cell)
+ (if (and match (not (string-match match (caadr cell))))
+ ;; Remove from list
+ (setcdr cell (cddr cell))
+ ;; Include in list
+ (setq cell (cdr cell))
+ (let ((l (car cell)))
+ (tramp-convert-file-attributes multi-method method user host
+ (cdr l))
+ ;; If FULL, make file name absolute
+ (when full (setcar l (concat directory "/" (car l)))))))
+ (if nosort
+ (cdr root)
+ (sort (cdr root) (lambda (x y) (string< (car x) (car y))))))))))
+
;; This function should return "foo/" for directories and "bar" for
;; files. We use `ls -ad' to get a list of files (including
;; directories), and `find . -type d \! -name . -prune' to get a list
(push (buffer-substring (point)
(tramp-line-end-position))
result))
-
+
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)
;; At least one file a tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
- (let ((modes (file-modes filename)))
- (tramp-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date)
- (set-file-modes newname modes))
+ (tramp-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date)
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date))))
(when keep-date
(when (and (not (null modtime))
(not (equal modtime '(0 0))))
- (tramp-touch newname modtime))
- (set-file-modes newname (file-modes filename))))
+ (tramp-touch newname modtime)))
+ ;; Set the mode.
+ (set-file-modes newname (file-modes filename)))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
(delete-file filename))))
"Unknown operation `%s', must be `copy' or `rename'"
op)))))
(save-excursion
- (tramp-barf-unless-okay
+ (tramp-send-command
multi-method method user host
(format "%s %s %s"
cmd
(tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument localname2))
- nil 'file-error
- "Copying directly failed, see buffer `%s' for details."
- (buffer-name)))))
+ (tramp-shell-quote-argument localname2)))
+ (tramp-wait-for-output)
+ (goto-char (point-min))
+ (unless
+ (or
+ (and (eq op 'copy) keep-date
+ ;; Mask cp -f error.
+ (re-search-forward tramp-operation-not-permitted-regexp nil t))
+ (zerop (tramp-send-command-and-check
+ multi-method method user host nil nil)))
+ (pop-to-buffer (current-buffer))
+ (signal 'file-error
+ (format "Copying directly failed, see buffer `%s' for details."
+ (buffer-name)))))
+ ;; Set the mode.
+ ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
+ ;; where available?
+ (unless (or (eq op 'rename) keep-date)
+ (set-file-modes
+ (tramp-make-tramp-file-name multi-method method user host localname2)
+ (file-modes
+ (tramp-make-tramp-file-name
+ multi-method method user host localname1))))))
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
"Invoke rcp program to copy.
;; Use an asynchronous process. By this, password can be handled.
(save-excursion
+
+ ;; Check for program.
+ (when (and (fboundp 'executable-find)
+ (not (executable-find copy-program)))
+ (error "Cannot find copy program: %s" copy-program))
+
(set-buffer trampbuf)
(setq tramp-current-multi-method multi-method
tramp-current-method method
tramp-actions-copy-out-of-band))
(kill-buffer trampbuf)
(tramp-message
- 5 "Transferring %s to file %s...done" filename newname))
+ 5 "Transferring %s to file %s...done" filename newname)
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (file-modes filename))))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
'file-error
(list "Removing old file name" "no such directory" filename)))
;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
- (tramp-send-command multi-method method user host
+ (tramp-send-command multi-method method user host
(format "rm -r %s" (tramp-shell-quote-argument localname)))
;; Wait for the remote system to return to us...
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output 120)
;; Make sure that it worked...
(and (file-exists-p filename)
- (error "Failed to recusively delete %s" filename))))
-
+ (error "Failed to recursively delete %s" filename))))
+
(defun tramp-handle-dired-call-process (program discard &rest arguments)
"Like `dired-call-process' for tramp files."
(with-parsed-tramp-file-name default-directory nil
(tramp-send-command-and-check multi-method method user host nil)
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)))))
-
+
(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.
(defun tramp-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for tramp files."
- ;; For the moment, we assume that the remote "ls" program does not
- ;; grok "--dired". In the future, we should detect this on
- ;; connection setup.
- (when (string-match "^--dired\\s-+" switches)
- (setq switches (replace-match "" nil t switches)))
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-message-for-buffer
- multi-method method user host 10
- "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
- switches filename (if wildcard "yes" "no")
- (if full-directory-p "yes" "no"))
- (when wildcard
- (setq wildcard (file-name-nondirectory localname))
- (setq localname (file-name-directory localname)))
- (when (listp switches)
- (setq switches (mapconcat 'identity switches " ")))
- (unless full-directory-p
- (setq switches (concat "-d " switches)))
- (when wildcard
- (setq switches (concat switches " " wildcard)))
- (save-excursion
- ;; 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
- multi-method method user host
- (format "%s %s %s"
- (tramp-get-ls-command multi-method method user host)
- switches
- (if wildcard
- localname
- (tramp-shell-quote-argument (concat localname ".")))))
- (tramp-barf-unless-okay
- multi-method method user host
- (format "cd %s" (tramp-shell-quote-argument
- (file-name-directory localname)))
- nil 'file-error
- "Couldn't `cd %s'"
- (tramp-shell-quote-argument (file-name-directory localname)))
- (tramp-send-command
- multi-method method user host
- (format "%s %s %s"
- (tramp-get-ls-command multi-method method user host)
- switches
- (if wildcard
- localname
- (tramp-shell-quote-argument
- (file-name-nondirectory localname))))))
- (sit-for 1) ;needed for rsh but not ssh?
- (tramp-wait-for-output))
- ;; The following let-binding is used by code that's commented
- ;; out. Let's leave the let-binding in for a while to see
- ;; that the commented-out code is really not needed. Commenting-out
- ;; happened on 2003-03-13.
- (let ((old-pos (point)))
- (insert-buffer-substring
- (tramp-get-buffer multi-method method user host))
- ;; On XEmacs, we want to call (exchange-point-and-mark t), but
- ;; that doesn't exist on Emacs, so we use this workaround instead.
- ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
- ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>.
- ;; (let ((zmacs-region-stays t))
- ;; (exchange-point-and-mark))
+ (if (and (boundp 'ls-lisp-use-insert-directory-program)
+ (not ls-lisp-use-insert-directory-program))
+ (tramp-run-real-handler 'insert-directory
+ (list filename switches wildcard full-directory-p))
+ ;; For the moment, we assume that the remote "ls" program does not
+ ;; grok "--dired". In the future, we should detect this on
+ ;; connection setup.
+ (when (string-match "^--dired\\s-+" switches)
+ (setq switches (replace-match "" nil t switches)))
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-message-for-buffer
+ multi-method method user host 10
+ "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
+ switches filename (if wildcard "yes" "no")
+ (if full-directory-p "yes" "no"))
+ (when wildcard
+ (setq wildcard (file-name-nondirectory localname))
+ (setq localname (file-name-directory localname)))
+ (when (listp switches)
+ (setq switches (mapconcat 'identity switches " ")))
+ (unless full-directory-p
+ (setq switches (concat "-d " switches)))
+ (when wildcard
+ (setq switches (concat switches " " wildcard)))
(save-excursion
- (tramp-send-command multi-method method user host "cd")
- (tramp-wait-for-output))
- ;; For the time being, the XEmacs kludge is commented out.
- ;; Please test it on various XEmacs versions to see if it works.
-;; ;; Another XEmacs specialty follows. What's the right way to do
-;; ;; it?
-;; (when (and (featurep 'xemacs)
-;; (eq major-mode 'dired-mode))
-;; (save-excursion
-;; (require 'dired)
-;; (dired-insert-set-properties old-pos (point))))
- )))
+ ;; 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
+ multi-method method user host
+ (format "%s %s %s"
+ (tramp-get-ls-command multi-method method user host)
+ switches
+ (if wildcard
+ localname
+ (tramp-shell-quote-argument (concat localname ".")))))
+ (tramp-barf-unless-okay
+ multi-method method user host
+ (format "cd %s" (tramp-shell-quote-argument
+ (file-name-directory localname)))
+ nil 'file-error
+ "Couldn't `cd %s'"
+ (tramp-shell-quote-argument (file-name-directory localname)))
+ (tramp-send-command
+ multi-method method user host
+ (format "%s %s %s"
+ (tramp-get-ls-command multi-method method user host)
+ switches
+ (if wildcard
+ localname
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname))))))
+ (sit-for 1) ;needed for rsh but not ssh?
+ (tramp-wait-for-output))
+ ;; The following let-binding is used by code that's commented
+ ;; out. Let's leave the let-binding in for a while to see
+ ;; that the commented-out code is really not needed. Commenting-out
+ ;; happened on 2003-03-13.
+ (let ((old-pos (point)))
+ (insert-buffer-substring
+ (tramp-get-buffer multi-method method user host))
+ ;; On XEmacs, we want to call (exchange-point-and-mark t), but
+ ;; that doesn't exist on Emacs, so we use this workaround instead.
+ ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
+ ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>.
+ ;; (let ((zmacs-region-stays t))
+ ;; (exchange-point-and-mark))
+ (save-excursion
+ (tramp-send-command multi-method method user host "cd")
+ (tramp-wait-for-output))
+ ;; For the time being, the XEmacs kludge is commented out.
+ ;; Please test it on various XEmacs versions to see if it works.
+ ;; ;; Another XEmacs specialty follows. What's the right way to do
+ ;; ;; it?
+ ;; (when (and (featurep 'xemacs)
+ ;; (eq major-mode 'dired-mode))
+ ;; (save-excursion
+ ;; (require 'dired)
+ ;; (dired-insert-set-properties old-pos (point))))
+ ))))
;; Continuation of kluge to pacify byte-compiler.
;;(eval-when-compile
This will break if COMMAND prints a newline, followed by the value of
`tramp-end-of-output', followed by another newline."
;; Asynchronous processes are far from being perfect. But it works at least
- ;; for `find-grep-dired' and `find-name-dired' in Emacs 21.4.
+ ;; for `find-grep-dired' and `find-name-dired' in Emacs 22.1.
(if (tramp-tramp-file-p default-directory)
(with-parsed-tramp-file-name default-directory nil
(let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
(tramp-run-real-handler 'shell-command
(list command output-buffer error-buffer))))
+(defun tramp-handle-process-file (program &optional infile buffer display &rest args)
+ "Like `process-file' for Tramp files."
+ (when infile (error "Implementation does not handle input from file"))
+ (when (and (numberp buffer) (zerop buffer))
+ (error "Implementation does not handle immediate return"))
+ (when (consp buffer) (error "Implementation does not handle error files"))
+ (shell-command
+ (mapconcat 'tramp-shell-quote-argument
+ (cons program args)
+ " ")
+ buffer))
+
;; File Editing.
(defsubst tramp-make-temp-file ()
(unless (equal curbuf (current-buffer))
(error "Buffer has changed from `%s' to `%s'"
curbuf (current-buffer)))
- (when (eq visit t)
- (set-visited-file-modtime))
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitely, because filename can be different
+ ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
+ (nth 5 (file-attributes filename))))
;; Make `last-coding-system-used' have the right value.
(when (boundp 'last-coding-system-used)
(setq last-coding-system-used coding-system-used))
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
; COMMAND
((member operation
- (list 'dired-call-process 'shell-command
+ (list 'dired-call-process-command
+ ; Emacs only
+ 'shell
+ ; Post Emacs 21.3 only
+ 'process-file
; XEmacs only
'dired-print-file 'dired-shell-call-process))
default-directory)
(defun tramp-repair-jka-compr ()
"If jka-compr is already loaded, move it to the front of
-`file-name-handler-alist'. On Emacs 21.4 or so this will not be
+`file-name-handler-alist'. On Emacs 22.1 or so this will not be
necessary anymore."
(let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
(when jka
;; `tramp-completion-file-name-regexp-unified' aren't different.
;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
-;; Using `last-input-event' is a little bit risky, because completing a file
+;; Using `last-input-event' is a little bit risky, because completing a file
;; might require loading other files, like "~/.netrc", and for them it
;; shouldn't be decided based on that variable. On the other hand, those files
;; shouldn't have partial tramp file name syntax. Maybe another variable should
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
- (setq result (append result
+ (setq result (append result
(mapcar
(lambda (x)
(tramp-get-completion-user-host
;; [nil nil "x" nil nil]
;; [nil "x" nil nil nil]
-;; "/x:" "/x:y" "/x:y:"
+;; "/x:" "/x:y" "/x:y:"
;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""]
;; "/[x/" "/[x/y"
;; [nil "x" nil "" nil] [nil "x" nil "y" nil]
;;; Internal Functions:
+(defun tramp-maybe-send-perl-script (multi-method method user host script name)
+ "Define in remote shell function NAME implemented as perl SCRIPT.
+Only send the definition if it has not already been done.
+Function may have 0-3 parameters."
+ (let ((remote-perl (tramp-get-remote-perl multi-method method user host)))
+ (unless remote-perl (error "No remote perl"))
+ (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil
+ multi-method method user host)))
+ (unless (memq name perl-scripts)
+ (with-current-buffer (tramp-get-buffer multi-method method user host)
+ (tramp-message 5 (concat "Sending the Perl script `" name "'..."))
+ (tramp-send-string multi-method method user host
+ (concat name
+ " () {\n"
+ remote-perl
+ " -e '"
+ script
+ "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}"))
+ (tramp-wait-for-output)
+ (tramp-set-connection-property "perl-scripts" (cons name perl-scripts)
+ multi-method method user host)
+ (tramp-message 5 (concat "Sending the Perl script `" name "'...done.")))))))
+
(defun tramp-set-auto-save ()
(when (and (buffer-file-name)
(tramp-tramp-file-p (buffer-file-name))
"touch" nil (current-buffer) nil "-t" touch-time file))
(pop-to-buffer (current-buffer))
(error "tramp-touch: touch failed"))))))
-
+
(defun tramp-buffer-name (multi-method method user host)
"A name for the connection buffer for USER at HOST using METHOD."
(if multi-method
(defun tramp-get-buffer (multi-method method user host)
"Get the connection buffer to be used for USER at HOST using METHOD."
- (get-buffer-create (tramp-buffer-name multi-method method user host)))
+ (with-current-buffer
+ (get-buffer-create (tramp-buffer-name multi-method method user host))
+ (setq buffer-undo-list t)
+ (current-buffer)))
(defun tramp-debug-buffer-name (multi-method method user host)
"A name for the debug buffer for USER at HOST using METHOD."
(defun tramp-get-debug-buffer (multi-method method user host)
"Get the debug buffer for USER at HOST using METHOD."
- (get-buffer-create (tramp-debug-buffer-name multi-method method user host)))
+ (with-current-buffer
+ (get-buffer-create
+ (tramp-debug-buffer-name multi-method method user host))
+ (setq buffer-undo-list t)
+ (current-buffer)))
(defun tramp-find-executable (multi-method method user host
progname dirlist ignore-tilde)
(file-exists-p existing)
(not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
-
+
;; CCC test ksh or bash found for tilde expansion?
(defun tramp-find-shell (multi-method method user host)
(tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path)
(tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path)))
-;; ------------------------------------------------------------
-;; -- Functions for establishing connection --
-;; ------------------------------------------------------------
+;; ------------------------------------------------------------
+;; -- Functions for establishing connection --
+;; ------------------------------------------------------------
;; The following functions are actions to be taken when seeing certain
;; prompts from the remote host. See the variable
((or (and (memq (process-status p) '(stop exit))
(not (zerop (process-exit-status p))))
(memq (process-status p) '(signal)))
- (tramp-message 9 "Process has died.")
- (throw 'tramp-action 'process-died))
+ ;; `scp' could have copied correctly, but set modes could have failed.
+ ;; This can be ignored.
+ (goto-char (point-min))
+ (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
+ (progn
+ (tramp-message 10 "'set mode' error ignored.")
+ (tramp-message 9 "Process has finished.")
+ (throw 'tramp-action 'ok))
+ (tramp-message 9 "Process has died.")
+ (throw 'tramp-action 'process-died)))
(t nil)))
;; The following functions are specifically for multi connections.
(when multi-method
(error "Cannot multi-connect using telnet connection method"))
(tramp-pre-connection multi-method method user host)
- (tramp-message 7 "Opening connection for %s@%s using %s..."
+ (tramp-message 7 "Opening connection for %s@%s using %s..."
(or user (user-login-name)) host method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
p multi-method method user host)
(tramp-post-connection multi-method method user host)))))
-
+
(defun tramp-open-connection-rsh (multi-method method user host)
"Open a connection using an rsh METHOD.
This starts the command `rsh HOST -l USER'[*], then waits for a remote
(error "Cannot multi-connect using rsh connection method"))
(tramp-pre-connection multi-method method user host)
(if (and user (not (string= user "")))
- (tramp-message 7 "Opening connection for %s@%s using %s..."
+ (tramp-message 7 "Opening connection for %s@%s using %s..."
user host method)
(tramp-message 7 "Opening connection at %s using %s..." host method))
(let ((process-environment (copy-sequence process-environment))
(> emacs-major-version 20))
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
- (apply #'start-process bufnam buf login-program
+ (apply #'start-process bufnam buf login-program
real-host "-l" user login-args)
- (apply #'start-process bufnam buf login-program
+ (apply #'start-process bufnam buf login-program
real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
tramp-actions-before-shell)
(tramp-open-connection-setup-interactive-shell
p multi-method method user host)
- (tramp-post-connection multi-method method
+ (tramp-post-connection multi-method method
user host)))))
-;; HHH: Not Changed. Multi method. It is not clear to me how this can
+;; HHH: Not Changed. Multi method. It is not clear to me how this can
;; handle not giving a user name in the "file name".
;;
;; This is more difficult than for the single-hop method. In the
(tramp-post-connection multi-method method user host)))))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
-;; of no user name provided. Hack to make it work as it did before:
+;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-telnet (p method user host command)
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
-;; HHH: Changed. Multi method. Don't know how to handle this in the case
-;; of no user name provided. Hack to make it work as it did before:
+;; HHH: Changed. Multi method. Don't know how to handle this in the case
+;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-rlogin (p method user host command)
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
-;; HHH: Changed. Multi method. Don't know how to handle this in the case
-;; of no user name provided. Hack to make it work as it did before:
+;; HHH: Changed. Multi method. Don't know how to handle this in the case
+;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-su (p method user host command)
(tramp-wait-for-output)
;; Find a `perl'.
(erase-buffer)
+ (tramp-set-connection-property "perl-scripts" nil multi-method method user host)
(let ((tramp-remote-perl
(or (tramp-find-executable multi-method method user host
"perl5" tramp-remote-path nil)
(when tramp-remote-perl
(tramp-set-connection-property "perl" tramp-remote-perl
multi-method method user host)
- ;; Set up stat in Perl if we can.
- (when tramp-remote-perl
- (tramp-message 5 "Sending the Perl `file-attributes' implementation.")
- (tramp-send-string
- multi-method method user host
- (concat "tramp_file_attributes () {\n"
- tramp-remote-perl
- " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n"
- "}"))
- (tramp-wait-for-output)
- (unless (tramp-method-out-of-band-p multi-method method user host)
- (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
- (tramp-send-string
- multi-method method user host
- (concat "tramp_encode () {\n"
- (format tramp-perl-encode tramp-remote-perl)
- " 2>/dev/null"
- "\n}"))
- (tramp-wait-for-output)
- (tramp-send-string
- multi-method method user host
- (concat "tramp_encode_with_module () {\n"
- (format tramp-perl-encode-with-module tramp-remote-perl)
- " 2>/dev/null"
- "\n}"))
- (tramp-wait-for-output)
- (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
- (tramp-send-string
- multi-method method user host
- (concat "tramp_decode () {\n"
- (format tramp-perl-decode tramp-remote-perl)
- " 2>/dev/null"
- "\n}"))
- (tramp-wait-for-output)
- (tramp-send-string
- multi-method method user host
- (concat "tramp_decode_with_module () {\n"
- (format tramp-perl-decode-with-module tramp-remote-perl)
- " 2>/dev/null"
- "\n}"))
- (tramp-wait-for-output)))))
+ (unless (tramp-method-out-of-band-p multi-method method user host)
+ (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
+ (tramp-send-string
+ multi-method method user host
+ (concat "tramp_encode () {\n"
+ (format tramp-perl-encode tramp-remote-perl)
+ " 2>/dev/null"
+ "\n}"))
+ (tramp-wait-for-output)
+ (tramp-send-string
+ multi-method method user host
+ (concat "tramp_encode_with_module () {\n"
+ (format tramp-perl-encode-with-module tramp-remote-perl)
+ " 2>/dev/null"
+ "\n}"))
+ (tramp-wait-for-output)
+ (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
+ (tramp-send-string
+ multi-method method user host
+ (concat "tramp_decode () {\n"
+ (format tramp-perl-decode tramp-remote-perl)
+ " 2>/dev/null"
+ "\n}"))
+ (tramp-wait-for-output)
+ (tramp-send-string
+ multi-method method user host
+ (concat "tramp_decode_with_module () {\n"
+ (format tramp-perl-decode-with-module tramp-remote-perl)
+ " 2>/dev/null"
+ "\n}"))
+ (tramp-wait-for-output))))
;; Find ln(1)
(erase-buffer)
(let ((ln (tramp-find-executable multi-method method user host
base64-encode-region base64-decode-region)
("recode data..base64" "recode base64..data"
base64-encode-region base64-decode-region)
+ ("uuencode xxx" "uudecode -o /dev/stdout"
+ tramp-uuencode-region uudecode-decode-region)
("uuencode xxx" "uudecode -o -"
tramp-uuencode-region uudecode-decode-region)
("uuencode xxx" "uudecode -p"
(tramp-barf-if-no-shell-prompt
nil 30
"Couldn't `%s', see buffer `%s'" command (buffer-name)))
-
+
(defun tramp-wait-for-output (&optional timeout)
"Wait for output from remote rsh command."
(let ((proc (get-buffer-process (current-buffer)))
(save-excursion
(goto-char start-point)
(when (looking-at (regexp-quote tramp-last-cmd))
- (delete-region (point) (forward-line 1)))))
+ (delete-region (point) (progn (forward-line 1) (point))))))
;; Add output to debug buffer if appropriate.
(when tramp-debug-buffer
(append-to-buffer
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
+(defun tramp-convert-file-attributes (multi-method method user host attr)
+ "Convert file-attributes ATTR generated by perl script or ls.
+Convert file mode bits to string and set virtual device number.
+Return ATTR."
+ (unless (stringp (nth 8 attr))
+ ;; Convert file mode bits to string.
+ (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device multi-method method user host))
+ attr)
+
+(defun tramp-get-device (multi-method method user host)
+ "Returns the virtual device number.
+If it doesn't exist, generate a new one."
+ (let ((string (tramp-make-tramp-file-name multi-method method user host "")))
+ (unless (assoc string tramp-devices)
+ (add-to-list 'tramp-devices
+ (list string (length tramp-devices))))
+ (list -1 (nth 1 (assoc string tramp-devices)))))
(defun tramp-file-mode-from-int (mode)
"Turn an integer representing a file mode into an ls(1)-like string."
""))
-;; ------------------------------------------------------------
-;; -- TRAMP file names --
-;; ------------------------------------------------------------
+;; ------------------------------------------------------------
+;; -- TRAMP file names --
+;; ------------------------------------------------------------
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
"Return t iff NAME is a tramp file."
(save-match-data
(string-match tramp-file-name-regexp name)))
-
+
;; HHH: Changed. Used to assign the return value of (user-login-name)
;; to the `user' part of the structure if a user name was not
;; provided, now it assigns nil.
If both MULTI-METHOD and METHOD are nil, do a lookup in
`tramp-default-method-alist'."
(or multi-method method (tramp-find-default-method user host)))
-
+
;; HHH: Not Changed. Multi method. Will probably not handle the case where
;; a user name is not provided in the "file name" very well.
(defun tramp-dissect-multi-file-name (name)
(if entry
(second entry)
(symbol-value param))))
-
+
;; Auto saving to a special directory.
(tramp-make-auto-save-file-name (buffer-file-name)))
ad-do-it))
+;; In Emacs < 22.1 and XEmacs < 21.5 autosaved remote files have
+;; permission 666 minus umask. This is a security threat.
+
+(defun tramp-set-auto-save-file-modes ()
+ "Set permissions of autosaved remote files to the original permissions."
+ (let ((bfn (buffer-file-name)))
+ (when (and (stringp bfn)
+ (tramp-tramp-file-p bfn)
+ (stringp buffer-auto-save-file-name)
+ (not (equal bfn buffer-auto-save-file-name))
+ (not (file-exists-p buffer-auto-save-file-name)))
+ (write-region "" nil buffer-auto-save-file-name)
+ (set-file-modes buffer-auto-save-file-name (file-modes bfn)))))
+
+(unless (or (> emacs-major-version 21)
+ (and (featurep 'xemacs)
+ (= emacs-major-version 21)
+ (> emacs-minor-version 4))
+ (and (not (featurep 'xemacs))
+ (= emacs-major-version 21)
+ (or (> emacs-minor-version 3)
+ (and (string-match "^21\\.3\\.\\([0-9]+\\)" emacs-version)
+ (>= (string-to-int (match-string 1 emacs-version)) 50)))))
+ (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))
+
(defun tramp-subst-strs-in-string (alist string)
"Replace all occurrences of the string FROM with TO in STRING.
ALIST is of the form ((FROM . TO) ...)."
process flag)))
-;; ------------------------------------------------------------
-;; -- Kludges section --
-;; ------------------------------------------------------------
+;; ------------------------------------------------------------
+;; -- Kludges section --
+;; ------------------------------------------------------------
;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
;; does not deal well with newline characters. Newline is replaced by
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;; * Add caching for filename completion. (Greg Stark)
-;; Of course, this has issues with usability (stale cache bites)
+;; Of course, this has issues with usability (stale cache bites)
;; -- <daniel@danann.net>
;; * Provide a local cache of old versions of remote files for the rsync
;; transfer method to use. (Greg Stark)
HCoop / bpt / emacs.git / blobdiff