Commit 00d6fd04 authored by Michael Albinus's avatar Michael Albinus
Browse files

* files.el (file-remote-p): Introduce optional parameter CONNECTED.

* net/tramp.el:
* net/tramp-ftp.el:
* net/tramp-smb.el:
* net/tramp-uu.el:
* net/trampver.el: Migrate to Tramp 2.1.

* net/tramp-cache.el:
* net/tramp-fish.el:
* net/tramp-gw.el: New Tramp packages.

* net/tramp-util.el:
* net/tramp-vc.el: Removed.

* net/ange-ftp.el: Add ange-ftp property to 'start-file-process
(ange-ftp-file-remote-p): Handle optional parameter CONNECTED.

* net/rcompile.el (remote-compile): Handle Tramp 2.1 arguments.

* progmodes/compile.el (compilation-start): Redefine
`start-process' temporarily when `default-directory' is remote.
Remove case of synchronous compilation, this won't happen ever.
(compilation-setup): Make local variable `comint-file-name-prefix'
for remote compilation.
parent eaaa2b09
2007-07-08 Michael Albinus <michael.albinus@gmx.de>
* files.el (file-remote-p): Introduce optional parameter CONNECTED.
* net/tramp.el:
* net/tramp-ftp.el:
* net/tramp-smb.el:
* net/tramp-uu.el:
* net/trampver.el: Migrate to Tramp 2.1.
* net/tramp-cache.el:
* net/tramp-fish.el:
* net/tramp-gw.el: New Tramp packages.
* net/tramp-util.el:
* net/tramp-vc.el: Removed.
* net/ange-ftp.el: Add ange-ftp property to 'start-file-process
(ange-ftp-file-remote-p): Handle optional parameter CONNECTED.
* net/rcompile.el (remote-compile): Handle Tramp 2.1 arguments.
* progmodes/compile.el (compilation-start): Redefine
`start-process' temporarily when `default-directory' is remote.
Remove case of synchronous compilation, this won't happen ever.
(compilation-setup): Make local variable `comint-file-name-prefix'
for remote compilation.
2007-07-08 Martin Rudalics <rudalics@gmx.at>
* novice.el (disabled-command-function): Fit window to buffer to
......
......@@ -727,17 +727,23 @@ This is an interface to the function `load'."
(cons load-path (get-load-suffixes)))))
(load library))
(defun file-remote-p (file)
(defun file-remote-p (file &optional connected)
"Test whether FILE specifies a location on a remote system.
Return an identification of the system if the location is indeed
remote. The identification of the system may comprise a method
to access the system and its hostname, amongst other things.
For example, the filename \"/user@host:/foo\" specifies a location
on the system \"/user@host:\"."
on the system \"/user@host:\".
If CONNECTED is non-nil, the function returns an identification only
if FILE is located on a remote system, and a connection is established
to that remote system.
`file-remote-p' will never open a connection on its own."
(let ((handler (find-file-name-handler file 'file-remote-p)))
(if handler
(funcall handler 'file-remote-p file)
(funcall handler 'file-remote-p file connected)
nil)))
(defun file-local-copy (file)
......
......@@ -4132,8 +4132,15 @@ directory, so that Emacs will know its current contents."
(format "Getting %s" fn1))
tmp1))))
(defun ange-ftp-file-remote-p (file)
(ange-ftp-replace-name-component file ""))
(defun ange-ftp-file-remote-p (file &optional connected)
(and (or (not connected)
(let* ((parsed (ange-ftp-ftp-name file))
(host (nth 0 parsed))
(user (nth 1 parsed))
(proc (get-process (ange-ftp-ftp-process-buffer host user))))
(and proc (processp proc)
(memq (process-status proc) '(run open)))))
(ange-ftp-replace-name-component file "")))
(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
(if (ange-ftp-ftp-name file)
......@@ -4360,7 +4367,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; This returns nil for any file name as argument.
(put 'vc-registered 'ange-ftp 'null)
;; We can handle process-file in a restricted way (just for chown).
;; Nothing possible for start-file-process.
(put 'process-file 'ange-ftp 'ange-ftp-process-file)
(put 'start-file-process 'ange-ftp 'ignore)
(put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
;;; Define ways of getting at unmodified Emacs primitives,
......
......@@ -188,8 +188,7 @@ See \\[compile]."
(when (featurep 'tramp)
(set (make-local-variable 'comint-file-name-prefix)
(funcall (symbol-function 'tramp-make-tramp-file-name)
nil ;; multi-method. To be removed with Tramp 2.1.
nil
nil ;; method.
remote-compile-user
remote-compile-host
""))))))
......
;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
;;; tramp-cache.el --- file information caching for Tramp
;; Copyright (C) 2000, 2005, 2006, 2007 by Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;; An implementation of information caching for remote files.
;; Each connection, identified by a vector [method user host
;; localname] or by a process, has a unique cache. We distinguish 3
;; kind of caches, depending on the key:
;;
;; - localname is NIL. This are reusable properties. Examples:
;; "remote-shell" identifies the POSIX shell to be called on the
;; remote host, or "perl" is the command to be called on the remote
;; host, when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
;; - localname is a string. This are temporary properties, which are
;; related to the file localname is referring to. Examples:
;; "file-exists-p" is t or nile, depending on the file existence, or
;; "file-attributes" caches the result of the function
;; `file-attributes'.
;;
;; - The key is a process. This are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
;;; Code:
;; Pacify byte-compiler.
(eval-when-compile
(require 'cl)
(autoload 'tramp-message "tramp")
(autoload 'tramp-tramp-file-p "tramp")
;; We cannot autoload macro `with-parsed-tramp-file-name', it
;; results in problems of byte-compiled code.
(autoload 'tramp-dissect-file-name "tramp")
(autoload 'tramp-file-name-method "tramp")
(autoload 'tramp-file-name-user "tramp")
(autoload 'tramp-file-name-host "tramp")
(autoload 'tramp-file-name-localname "tramp")
(autoload 'time-stamp-string "time-stamp"))
;;; -- Cache --
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
(defcustom tramp-persistency-file-name
(cond
;; GNU Emacs.
((and (boundp 'user-emacs-directory)
(stringp (symbol-value 'user-emacs-directory))
(file-directory-p (symbol-value 'user-emacs-directory)))
(expand-file-name "tramp" (symbol-value 'user-emacs-directory)))
((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
"~/.emacs.d/tramp")
;; XEmacs.
((and (boundp 'user-init-directory)
(stringp (symbol-value 'user-init-directory))
(file-directory-p (symbol-value 'user-init-directory)))
(expand-file-name "tramp" (symbol-value 'user-init-directory)))
((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
"~/.xemacs/tramp")
;; For users without `~/.emacs.d/' or `~/.xemacs/'.
(t "~/.tramp"))
"File which keeps connection history for Tramp connections."
:group 'tramp
:type 'file)
(defun tramp-get-file-property (vec file property default)
"Get the PROPERTY of FILE from the cache context of VEC.
Returns DEFAULT if not set."
;; Unify localname.
(setq vec (copy-sequence vec))
(aset vec 3 (directory-file-name file))
(let* ((hash (or (gethash vec tramp-cache-data)
(puthash vec (make-hash-table :test 'equal)
tramp-cache-data)))
(value (if (hash-table-p hash)
(gethash property hash default)
default)))
(tramp-message vec 8 "%s %s %s" file property value)
value))
(defun tramp-set-file-property (vec file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
Returns VALUE."
;; Unify localname.
(setq vec (copy-sequence vec))
(aset vec 3 (directory-file-name file))
(let ((hash (or (gethash vec tramp-cache-data)
(puthash vec (make-hash-table :test 'equal)
tramp-cache-data))))
(puthash property value hash)
(tramp-message vec 8 "%s %s %s" file property value)
value))
(defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC."
;; Unify localname.
(setq vec (copy-sequence vec))
(aset vec 3 (directory-file-name file))
(tramp-message vec 8 "%s" file)
(remhash vec tramp-cache-data))
(defun tramp-flush-directory-property (vec directory)
"Remove all properties of DIRECTORY in the cache context of VEC.
Remove also properties of all files in subdirectories."
(let ((directory (directory-file-name directory)))
(tramp-message vec 8 "%s" directory)
(maphash
'(lambda (key value)
(when (and (stringp key)
(string-match directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
tramp-cache-data)))
(defun tramp-cache-print (table)
"Prints hash table TABLE."
(when (hash-table-p table)
(let (result tmp)
(maphash
'(lambda (key value)
(setq tmp (format
"(%s %s)"
(if (processp key)
(prin1-to-string (prin1-to-string key))
(prin1-to-string key))
(if (hash-table-p value)
(tramp-cache-print value)
(if (bufferp value)
(prin1-to-string (prin1-to-string value))
(prin1-to-string value))))
result (if result (concat result " " tmp) tmp)))
table)
result)))
;; Reverting or killing a buffer should also flush file properties.
;; They could have been changed outside Tramp.
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from buffer-file-name."
(let ((bfn (buffer-file-name)))
(when (and (stringp bfn) (tramp-tramp-file-p bfn))
(let* ((v (tramp-dissect-file-name bfn))
(localname (tramp-file-name-localname v)))
(tramp-flush-file-property v localname)))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
(add-hook 'tramp-cache-unload-hook
'(lambda ()
(remove-hook 'before-revert-hook
'tramp-flush-file-function)
(remove-hook 'kill-buffer-hook
'tramp-flush-file-function)))
;;; -- Properties --
(defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a vector.
If the value is not set for the connection, returns DEFAULT."
;; Unify key by removing localname from vector. Work with a copy in
;; order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
(let* ((hash (gethash key tramp-cache-data))
(value (if (hash-table-p hash)
(gethash property hash default)
default)))
(tramp-message key 7 "%s %s" property value)
value))
(defun tramp-set-connection-property (key property value)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a vector.
PROPERTY is set persistent when KEY is a vector."
;; Unify key by removing localname from vector. Work with a copy in
;; order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
(let ((hash (or (gethash key tramp-cache-data)
(puthash key (make-hash-table :test 'equal)
tramp-cache-data))))
(puthash property value hash)
;; This function is called also during initialization of
;; tramp-cache.el. `tramp-message is not defined yet at this
;; time, so we ignore the corresponding error.
(condition-case nil
(tramp-message key 7 "%s %s" property value)
(error nil))
value))
(defun tramp-flush-connection-property (key event)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a
vector. EVENT is not used, it is just applied because this
function is intended to run also as process sentinel."
;; Unify key by removing localname from vector. Work with a copy in
;; order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
; (tramp-message key 7 "%s" event)
(remhash key tramp-cache-data))
(defun tramp-dump-connection-properties ()
"Writes persistent connection properties into file
`tramp-persistency-file-name'."
;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
(condition-case nil
(when (and (hash-table-p tramp-cache-data)
(not (zerop (hash-table-count tramp-cache-data)))
(stringp tramp-persistency-file-name))
(let ((cache (copy-hash-table tramp-cache-data)))
;; Remove temporary data.
(maphash
'(lambda (key value)
(if (and (vectorp key) (not (tramp-file-name-localname key)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value))
(remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
(insert
";; -*- emacs-lisp -*-"
;; `time-stamp-string' might not exist in all (X)Emacs flavors.
(condition-case nil
(progn
(format
" <%s %s>\n"
(time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
tramp-persistency-file-name))
(error "\n"))
";; Tramp connection history. Don't change this file.\n"
";; You can delete it, forcing Tramp to reapply the checks.\n\n"
(with-output-to-string
(pp (read (format "(%s)" (tramp-cache-print cache))))))
(write-region
(point-min) (point-max) tramp-persistency-file-name))))
(error nil)))
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
(add-hook 'tramp-cache-unload-hook
'(lambda ()
(remove-hook 'kill-emacs-hook
'tramp-dump-connection-properties)))
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection
history."
(let (res)
(maphash
'(lambda (key value)
(if (and (vectorp key)
(string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname key)))
(push (list (tramp-file-name-user key)
(tramp-file-name-host key))
res)))
tramp-cache-data)
res))
;; Read persistent connection history. Applied with
;; `load-in-progress', because it shall be evaluated only once.
(when load-in-progress
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
(let ((list (read (current-buffer)))
element key item)
(while (setq element (pop list))
(setq key (pop element))
(while (setq item (pop element))
(tramp-set-connection-property key (pop item) (car item))))))
(file-error
;; Most likely because the file doesn't exist yet. No message.
(clrhash tramp-cache-data))
(error
;; File is corrupted.
(message "%s" (error-message-string err))
(clrhash tramp-cache-data))))
(provide 'tramp-cache)
;;; tramp-cache.el ends here
This diff is collapsed.
......@@ -10,8 +10,8 @@
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
......@@ -19,9 +19,8 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; along with GNU Emacs; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Commentary:
......@@ -110,10 +109,13 @@ present for backward compatibility."
(list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
;; Add completion function for FTP method.
(unless (memq system-type '(windows-nt))
(tramp-set-completion-function
(tramp-set-completion-function
tramp-ftp-method
'((tramp-parse-netrc "~/.netrc"))))
'((tramp-parse-netrc "~/.netrc")))
;; If there is URL syntax, `substitute-in-file-name' needs special
;; handling.
(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name)
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
......@@ -152,13 +154,7 @@ pass to the OPERATION."
(defun tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
(let ((v (tramp-dissect-file-name filename)))
(string=
(tramp-find-method
(tramp-file-name-multi-method v)
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-file-name-host v))
tramp-ftp-method)))
(string= (tramp-file-name-method v) tramp-ftp-method)))
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
......@@ -172,8 +168,6 @@ pass to the OPERATION."
;; pretended in `tramp-file-name-handler' otherwise.
;; Furthermore, there are no backup files on FTP hosts.
;; Worth further investigations.
;; * Map /multi:ssh:out@gate:ftp:kai@real.host:/path/to.file
;; on Ange-FTP gateways.
;;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff
;;; tramp-ftp.el ends here
;;; -*- coding: iso-8859-1; -*-
;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways
;; Copyright (C) 2007 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Access functions for HTTP tunnels and SOCKS gateways from Tramp.
;; SOCKS functionality is implemented by socks.el from the w3 package.
;; HTTP tunnels are partly implemented in socks.el and url-http.el;
;; both implementations are not complete. Therefore, it is
;; implemented in this package.
;;; Code:
(require 'tramp)
;; Pacify byte-compiler
(eval-when-compile
(require 'cl)
(require 'custom))
;; Autoload the socks library. It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
(defvar socks-username (user-login-name))
(defvar socks-server (list "Default server" "socks" 1080 5))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
(when (featurep 'xemacs)
(byte-compiler-options (warnings (- unused-vars)))))
;; Define HTTP tunnel method ...
(defvar tramp-gw-tunnel-method "tunnel"
"*Method to connect HTTP gateways.")
;; ... and port.
(defvar tramp-gw-default-tunnel-port 8080
"*Default port for HTTP gateways.")
;; Define SOCKS method ...
(defvar tramp-gw-socks-method "socks"
"*Method to connect SOCKS servers.")
;; ... and port.
(defvar tramp-gw-default-socks-port 1080
"*Default port for SOCKS servers.")
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
`(,tramp-gw-tunnel-method nil ,(user-login-name)))
(add-to-list 'tramp-default-user-alist
`(,tramp-gw-socks-method nil ,(user-login-name)))
;; Internal file name functions and variables.
(defvar tramp-gw-vector nil
"Keeps the remote host identification. Needed for Tramp messages.")
(defvar tramp-gw-gw-vector nil
"Current gateway identification vector.")
(defvar tramp-gw-gw-proc nil
"Current gateway process.")
;; This variable keeps the listening process, in order to reuse it for
;; new processes.
(defvar tramp-gw-aux-proc nil
"Process listening on local port, as mediation between SSH and the gateway.")
(defun tramp-gw-gw-proc-sentinel (proc event)
"Delete auxiliary process when we are deleted."
(unless (memq (process-status proc) '(run open))
(tramp-message
tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc)
(let* (tramp-verbose
(p (tramp-get-connection-property proc "process" nil)))
(when (processp p) (delete-process p)))))
(defun tramp-gw-aux-proc-sentinel (proc event)
"Activate the different filters for involved gateway and auxiliary processes."
(when (memq (process-status proc) '(run open))
;; A new process has been spawned from `tramp-gw-aux-proc'.
(tramp-message
tramp-gw-vector 4
"Opening auxiliary process `%s', speaking with process `%s'"
proc tramp-gw-gw-proc)
(tramp-set-process-query-on-exit-flag proc nil)
;; We don't want debug messages, because the corresponding debug
;; buffer might be undecided.
(let (tramp-verbose)
(tramp-set-connection-property tramp-gw-gw-proc "process" proc)
(tramp-set-connection-property proc "process" tramp-gw-gw-proc))
;; Set the process-filter functions for both processes.
(set-process-filter proc 'tramp-gw-process-filter)
(set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter)
;; There might be already some output from the gateway process.
(with-current-buffer (process-buffer tramp-gw-gw-proc)
(unless (= (point-min) (point-max))
(let ((s (buffer-string)))
(delete-region (point) (point-max))
(tramp-gw-process-filter tramp-gw-gw-proc s))))))
(defun tramp-gw-process-filter (proc string)
(let (tramp-verbose)
(process-send-string
(tramp-get-connection-property proc "process" nil) string)))
(defun tramp-gw-open-connection (vec gw-vec target-vec)
"Open a remote connection to VEC (see `tramp-file-name' structure).
Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
gateway method. TARGET-VEC identifies where to connect to via
the gateway, it can be different from VEC when there are more
hops to be applied.
It returns a string like \"localhost#port\", which must be used
instead of the host name declared in TARGET-VEC."
;; Remember vectors for property retrieval.
(setq tramp-gw-vector vec
tramp-gw-gw-vector gw-vec)