Commit 6647e051 authored by Michael Albinus's avatar Michael Albinus

Implement connection-local variables

* doc/lispref/variables.texi (Connection Local Variables): New section.

* etc/NEWS: Mention connection-local variables.

* lisp/files-x.el (enable-connection-local-variables)
(connection-local-variables-alist, connection-local-class-alist)
(connection-local-criteria-alist): New defvars.
(connection-local-get-classes)
(connection-local-get-class-variables): New defsubst.
(connection-local-set-classes)
(connection-local-set-class-variables)
(hack-connection-local-variables)
(hack-connection-local-variables-apply): New defuns.
(with-connection-local-classes): New defmacro.

* lisp/net/tramp.el (tramp-set-connection-local-variables): New defun.

* lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* lisp/net/lisp/net/tramp-sh.el (tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Use it.

* test/lisp/files-x-tests.el: New file.
parent db436133
......@@ -38,6 +38,7 @@ representing the variable.
* Buffer-Local Variables:: Variable values in effect only in one buffer.
* File Local Variables:: Handling local variable lists in files.
* Directory Local Variables:: Local variables common to all files in a directory.
* Connection Local Variables:: Local variables common for remote connections.
* Variable Aliases:: Variables that are aliases for other variables.
* Variables with Restricted Values:: Non-constant variables whose value can
@emph{not} be an arbitrary Lisp object.
......@@ -1862,6 +1863,170 @@ may be useful for modes that want to ignore directory-locals while
still respecting file-local variables (@pxref{File Local Variables}).
@end defvar
@node Connection Local Variables
@section Connection Local Variables
@cindex connection local variables
Connection-local variables provide a general mechanism for
different variable settings in buffers with a remote default
directory. They are bound and set depending on the remote connection
a buffer is dedicated to. Per default, they are set in all process
buffers for a remote connection, but they could be applied also in
other buffers with a remote directory.
@defun connection-local-set-class-variables class variables
This function defines a set of variable settings for the named
@var{class}, which is a symbol. You can later assign the class to one
or more remote connections, and Emacs will apply those variable
settings to all process buffers for those connections. The list in
@var{variables} is an alist of the form @code{(@var{name}
. @var{value})}. Example:
@example
@group
(connection-local-set-class-variables
'remote-bash
'((shell-file-name . "/bin/bash")
(shell-command-switch . "-c")
(shell-interactive-switch . "-i")
(shell-login-switch . "-l")))
@end group
@group
(connection-local-set-class-variables
'remote-ksh
'((shell-file-name . "/bin/ksh")
(shell-command-switch . "-c")
(shell-interactive-switch . "-i")
(shell-login-switch . "-l")))
@end group
@group
(connection-local-set-class-variables
'remote-null-device
'((null-device "/dev/null")))
@end group
@end example
@end defun
@defvar connection-local-class-alist
This alist holds the class symbols and the associated variable
settings. It is updated by @code{connection-local-set-class-variables}.
@end defvar
@defun connection-local-set-classes criteria &rest classes
This function assigns @var{classes}, which are symbols, to all remote
connections identified by @var{criteria}. @var{criteria} is either a
regular expression identifying a remote server, or a function with one
argument @var{identification}, which must return non-nil when a remote
server shall apply @var{classes} variables, or @code{nil}.
If @var{criteria} is a regexp, is must match the result of
@code{(file-remote-p default-directory)} of a buffer in order to apply
the variables setting. Example:
@example
@group
(connection-local-set-classes
"^/ssh:" 'remote-bash 'remote-null-device)
@end group
@group
(connection-local-set-classes
"^/sudo:" 'remote-ksh 'remote-null-device)
@end group
@end example
If @var{criteria} is nil, it applies for all remote connections.
Therefore, the example above would be equivalent to
@example
(connection-local-set-classes "^/ssh:" 'remote-bash)
(connection-local-set-classes "^/sudo:" 'remote-ksh)
(connection-local-set-classes nil 'remote-null-device)
@end example
If @var{criteria} is a lambda function it must accept one parameter,
the identification. The example above could be rewritten as
@example
@group
(connection-local-set-classes
(lambda (identification)
(string-equal (file-remote-p identification 'method) "ssh"))
'remote-bash)
@end group
@group
(connection-local-set-classes
(lambda (identification)
(string-equal (file-remote-p identification 'method) "sudo"))
'remote-ksh)
@end group
@group
(connection-local-set-classes
(lambda (identification) t)
'remote-null-device)
@end group
@end example
Thereafter, all the variable settings specified for @var{classes}
will be applied to any buffer with a matching remote directory, when
activated by @code{hack-connection-local-variables-apply}. Any class
of @var{classes} must have been already defined by
@code{connection-local-set-class-variables}.
@end defun
@defvar connection-local-criteria-alist
This alist contains remote server identifications and their assigned
class names. The function @code{connection-local-set-classes} updates
this list.
@end defvar
@defun hack-connection-local-variables
This function collects applicable connection-local variables in
@code{connection-local-variables-alist} that is local to the buffer,
without applying them. Whether a connection-local variable is
applicable is specified by the remote identifier of a buffer,
evaluated by @code{(file-remote-p default-directory)}.
@end defun
@defun hack-connection-local-variables-apply
This function looks for connection-local variables, and immediately
applies them in the current buffer. It is called per default for
every process-buffer related to a remote connection. For other remote
buffers, it could be called by any mode.
@end defun
@defmac with-connection-local-classes classes &rest body
All connection-local variables, which are specified by a class in
@var{CLASSES}, are applied. An implicit binding of the classes to the
remote connection is enabled.
After that, @var{BODY} is executed, and the connection-local variables
are unwound. Example:
@example
@group
(connection-local-set-class-variables
'remote-perl
'((perl-command-name . "/usr/local/bin/perl")
(perl-command-switch . "-e %s")))
@end group
@group
(with-connection-local-classes '(remote-perl)
do something useful)
@end group
@end example
@end defmac
@defvar enable-connection-local-variables
If @code{nil}, connection-local variables are ignored. This variable
shall be changed temporarily only in special modes.
@end defvar
@node Variable Aliases
@section Variable Aliases
@cindex variable aliases
......
......@@ -223,6 +223,11 @@ These local variables will thus not vanish on setting a major mode.
** A second dir-local file (.dir-locals-2.el) is now accepted.
See the variable 'dir-locals-file-2' for more information.
+++
** Connection-local variables can be used to specify local variables
with a value depending on the connected remote server. For details, see
(info "(elisp)Connection Local Variables")
---
** International domain names (IDNA) are now encoded via the new
puny.el library, so that one can visit web sites with non-ASCII URLs.
......
......@@ -542,6 +542,145 @@ from the MODE alist ignoring the input argument VALUE."
(dolist (elt dir-local-variables-alist)
(add-file-local-variable-prop-line (car elt) (cdr elt))))
;;; connection-local variables.
;;;###autoload
(defvar enable-connection-local-variables t
"Non-nil means enable use of connection-local variables.")
(defvar connection-local-variables-alist nil
"Alist of connection-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a connection-local variable (a symbol) and VALUE is its value.
The actual value in the buffer may differ from VALUE, if it is
changed by the user.")
(make-variable-buffer-local 'connection-local-variables-alist)
(setq ignored-local-variables
(cons 'connection-local-variables-alist ignored-local-variables))
(defvar connection-local-class-alist '()
"Alist mapping connection-local variable classes (symbols) to variable lists.
Each element in this list has the form (CLASS VARIABLES).
CLASS is the name of a variable class (a symbol).
VARIABLES is a list that declares connection-local variables for
CLASS. An element in VARIABLES is an alist whose elements are of
the form (VAR . VALUE).")
(defvar connection-local-criteria-alist '()
"Alist mapping criteria to connection-local variable classes (symbols).
Each element in this list has the form (CRITERIA CLASSES).
CRITERIA is either a regular expression identifying a remote
server, or a function with one argument IDENTIFICATION, which
returns non-nil when a remote server shall apply CLASS'es
variables. If CRITERIA is nil, it always applies.
CLASSES is a list of variable classes (symbols).")
(defsubst connection-local-get-classes (criteria &optional identification)
"Return the connection-local classes list for CRITERIA.
CRITERIA is either a regular expression identifying a remote
server, or a function with one argument IDENTIFICATION, which
returns non-nil when a remote server shall apply CLASS'es
variables. If CRITERIA is nil, it always applies.
If IDENTIFICATION is non-nil, CRITERIA must be nil, or match
IDENTIFICATION accordingly."
(and (cond ((null identification))
((not (stringp identification))
(error "Wrong identification `%s'" identification))
((null criteria))
((stringp criteria) (string-match criteria identification))
((functionp criteria) (funcall criteria identification))
(t "Wrong criteria `%s'" criteria))
(cdr (assoc criteria connection-local-criteria-alist))))
;;;###autoload
(defun connection-local-set-classes (criteria &rest classes)
"Add CLASSES for remote servers.
CRITERIA is either a regular expression identifying a remote
server, or a function with one argument IDENTIFICATION, which
returns non-nil when a remote server shall apply CLASS'es
variables. If CRITERIA is nil, it always applies.
CLASSES are the names of a variable class (a symbol).
When a connection to a remote server is opened and CRITERIA
matches to that server, the connection-local variables from CLASSES
are applied to the corresponding process buffer. The variables
for a class are defined using `connection-local-set-class-variables'."
(unless (or (null criteria) (stringp criteria) (functionp criteria))
(error "Wrong criteria `%s'" criteria))
(dolist (class classes)
(unless (assq class connection-local-class-alist)
(error "No such class `%s'" (symbol-name class))))
(let ((slot (assoc criteria connection-local-criteria-alist)))
(if slot
(setcdr slot (delete-dups (append (cdr slot) classes)))
(setq connection-local-criteria-alist
(cons (cons criteria (delete-dups classes))
connection-local-criteria-alist)))))
(defsubst connection-local-get-class-variables (class)
"Return the connection-local variable list for CLASS."
(cdr (assq class connection-local-class-alist)))
;;;###autoload
(defun connection-local-set-class-variables (class variables)
"Map the symbol CLASS to a list of variable settings.
VARIABLES is a list that declares connection-local variables for
the class. An element in VARIABLES is an alist whose elements
are of the form (VAR . VALUE).
When a connection to a remote server is opened, the server's
classes are found. A server may be assigned a class using
`connection-local-set-class'. Then variables are set in the
server's process buffer according to the VARIABLES list of the
class. The list is processed in order."
(setf (alist-get class connection-local-class-alist) variables))
(defun hack-connection-local-variables ()
"Read per-connection local variables for the current buffer.
Store the connection-local variables in `connection-local-variables-alist'.
This does nothing if `enable-connection-local-variables' is nil."
(let ((identification (file-remote-p default-directory)))
(when (and enable-connection-local-variables identification)
;; Loop over criteria.
(dolist (criteria (mapcar 'car connection-local-criteria-alist))
;; Filter classes which map identification.
(dolist (class (connection-local-get-classes criteria identification))
;; Loop over variables.
(dolist (variable (connection-local-get-class-variables class))
(unless (assq (car variable) connection-local-variables-alist)
(push variable connection-local-variables-alist))))))))
;;;###autoload
(defun hack-connection-local-variables-apply ()
"Apply connection-local variables identified by `default-directory'.
Other local variables, like file-local and dir-local variables,
will not be changed."
(hack-connection-local-variables)
(let ((file-local-variables-alist
(copy-tree connection-local-variables-alist)))
(hack-local-variables-apply)))
;;;###autoload
(defmacro with-connection-local-classes (classes &rest body)
"Apply connection-local variables according to CLASSES in current buffer.
Execute BODY, and unwind connection local variables."
(declare (indent 1) (debug t))
`(let ((enable-connection-local-variables t)
(old-buffer-local-variables (buffer-local-variables))
connection-local-variables-alist connection-local-criteria-alist)
(apply 'connection-local-set-classes "" ,classes)
(hack-connection-local-variables-apply)
(unwind-protect
(progn ,@body)
;; Cleanup.
(dolist (variable connection-local-variables-alist)
(let ((elt (assq (car variable) old-buffer-local-variables)))
(if elt
(set (make-local-variable (car elt)) (cdr elt))
(kill-local-variable (car variable))))))))
(provide 'files-x)
......
......@@ -1243,6 +1243,9 @@ connection if a previous connection has died for some reason."
(read (current-buffer)))
":" 'omit))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
......
......@@ -1723,6 +1723,9 @@ connection if a previous connection has died for some reason."
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
(tramp-error vec 'file-error "FUSE mount denied"))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
;; Mark it as connected.
(tramp-set-connection-property
(tramp-get-connection-process vec) "connected" t))))
......
......@@ -333,5 +333,7 @@ password in password cache. This is done for the first try only."
;; * Provide descriptive Commentary.
;;
;; * Enable it for several gateway processes in parallel.
;;
;; * Use `url-https-proxy-connect' as of Emacs 26.
;;; tramp-gw.el ends here
......@@ -518,6 +518,7 @@ The string is used in `tramp-methods'.")
;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
;;;###tramp-autoload
(defcustom tramp-remote-path
'(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
......@@ -4918,6 +4919,9 @@ connection if a previous connection has died for some reason."
(setq options ""
target-alist (cdr target-alist)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec)
......
......@@ -1916,6 +1916,9 @@ If ARGUMENT is non-nil, use it as argument for
(tramp-set-connection-property p "smb-share" share)
(tramp-set-connection-property p "chunksize" 1)
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
;; Mark it as connected.
(tramp-set-connection-property p "connected" t))
......
......@@ -1338,6 +1338,15 @@ In case a second asynchronous communication has been started, it is different
from the default one."
(get-process (tramp-get-connection-name vec)))
(defun tramp-set-connection-local-variables (vec)
"Set connection-local variables in the connection buffer used for VEC.
If connection-local variables are not supported by this Emacs
version, the function does nothing."
;; `tramp-get-connection-buffer' sets proper `default-directory'."
(with-current-buffer (tramp-get-connection-buffer vec)
;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
(tramp-compat-funcall 'hack-connection-local-variables-apply)))
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
;; We must use `tramp-file-name-real-host', because for gateway
......@@ -4325,13 +4334,6 @@ Only works for Bourne-like shells."
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;;
;; * Implement a general server-local-variable mechanism, as there are
;; probably other variables that need different values for different
;; servers too. The user could then configure a variable (such as
;; tramp-server-local-variable-alist) to define any such variables
;; that they need to, which would then be let bound as appropriate
;; in tramp functions. (Jason Rumney)
;;
;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
;;
;; * I was wondering if it would be possible to use tramp even if I'm
......
;;; files-x-tests.el --- tests for files-x.el.
;; Copyright (C) 2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; 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. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'files-x)
(defvar files-x-test--criteria1 "my-user@my-remote-host")
(defvar files-x-test--criteria2
(lambda (identification)
(string-match "another-user@my-remote-host" identification)))
(defvar files-x-test--criteria3 nil)
(defvar files-x-test--variables1
'((remote-shell-file-name . "/bin/bash")
(remote-shell-command-switch . "-c")
(remote-shell-interactive-switch . "-i")
(remote-shell-login-switch . "-l")))
(defvar files-x-test--variables2
'((remote-shell-file-name . "/bin/ksh")))
(defvar files-x-test--variables3
'((remote-null-device . "/dev/null")))
(defvar files-x-test--variables4
'((remote-null-device . "null")))
(ert-deftest files-x-test-connection-local-set-class-variables ()
"Test setting connection-local class variables."
;; Declare (CLASS VARIABLES) objects.
(let (connection-local-class-alist connection-local-criteria-alist)
(connection-local-set-class-variables 'remote-bash files-x-test--variables1)
(should
(equal
(connection-local-get-class-variables 'remote-bash)
files-x-test--variables1))
(connection-local-set-class-variables 'remote-ksh files-x-test--variables2)
(should
(equal
(connection-local-get-class-variables 'remote-ksh)
files-x-test--variables2))
(connection-local-set-class-variables
'remote-nullfile files-x-test--variables3)
(should
(equal
(connection-local-get-class-variables 'remote-nullfile)
files-x-test--variables3))
;; A redefinition overwrites existing values.
(connection-local-set-class-variables
'remote-nullfile files-x-test--variables4)
(should
(equal
(connection-local-get-class-variables 'remote-nullfile)
files-x-test--variables4))))
(ert-deftest files-x-test-connection-local-set-classes ()
"Test setting connection-local classes."
;; Declare (CRITERIA CLASSES) objects.
(let (connection-local-class-alist connection-local-criteria-alist)
(connection-local-set-class-variables 'remote-bash files-x-test--variables1)
(connection-local-set-class-variables 'remote-ksh files-x-test--variables2)
(connection-local-set-class-variables
'remote-nullfile files-x-test--variables3)
(connection-local-set-classes
files-x-test--criteria1 'remote-bash 'remote-ksh)
(should
(equal
(connection-local-get-classes files-x-test--criteria1)
'(remote-bash remote-ksh)))
(connection-local-set-classes files-x-test--criteria2 'remote-ksh)
(should
(equal
(connection-local-get-classes files-x-test--criteria2)
'(remote-ksh)))
;; A further call adds classes.
(connection-local-set-classes files-x-test--criteria2 'remote-nullfile)
(should
(equal
(connection-local-get-classes files-x-test--criteria2)
'(remote-ksh remote-nullfile)))
;; Adding existing classes doesn't matter.
(connection-local-set-classes
files-x-test--criteria2 'remote-bash 'remote-nullfile)
(should
(equal
(connection-local-get-classes files-x-test--criteria2)
'(remote-ksh remote-nullfile remote-bash)))
;; An empty variable list is accepted (but makes no sense).
(connection-local-set-classes files-x-test--criteria3)
(should-not (connection-local-get-classes files-x-test--criteria3))
;; Using a nil criteria also works. Duplicate classes are trashed.
(connection-local-set-classes
files-x-test--criteria3 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash)
(should
(equal
(connection-local-get-classes files-x-test--criteria3)
'(remote-bash remote-ksh)))
;; A criteria other than nil, regexp or lambda function is wrong.
(should-error (connection-local-set-classes 'dummy))))
(ert-deftest files-x-test-hack-connection-local-variables-apply ()
"Test setting connection-local variables."
(let (connection-local-class-alist connection-local-criteria-alist)
(connection-local-set-class-variables 'remote-bash files-x-test--variables1)
(connection-local-set-class-variables 'remote-ksh files-x-test--variables2)
(connection-local-set-class-variables
'remote-nullfile files-x-test--variables3)
(connection-local-set-classes
files-x-test--criteria1 'remote-bash 'remote-ksh)
(connection-local-set-classes
files-x-test--criteria2 'remote-ksh 'remote-nullfile)
;; Apply the variables.
(with-temp-buffer
(let ((enable-connection-local-variables t)
(default-directory "/sudo:my-user@my-remote-host:"))
(should-not connection-local-variables-alist)
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))
(hack-connection-local-variables-apply)
;; All connection-local variables are set. They apply in
;; reverse order in `connection-local-variables-alist'. The
;; settings from `remote-ksh' are not contained, because they
;; declare same variables as in `remote-bash'.
(should
(equal connection-local-variables-alist
(nreverse (copy-tree files-x-test--variables1))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
;; The proper variable value is set.
(should
(string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))))
;; The second test case.
(with-temp-buffer
(let ((enable-connection-local-variables t)
(default-directory "/ssh:another-user@my-remote-host:"))
(should-not connection-local-variables-alist)
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))
(hack-connection-local-variables-apply)
;; All connection-local variables are set. They apply in
;; reverse order in `connection-local-variables-alist'.
(should
(equal connection-local-variables-alist
(append
(nreverse (copy-tree files-x-test--variables3))
(nreverse (copy-tree files-x-test--variables2)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
;; The proper variable value is set.
(should
(string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))))
;; The third test case. Both `files-x-test--criteria1' and
;; `files-x-test--criteria3' apply, but there are no double
;; entries.
(connection-local-set-classes
files-x-test--criteria3 'remote-bash 'remote-ksh)
(with-temp-buffer
(let ((enable-connection-local-variables t)
(default-directory "/sudo:my-user@my-remote-host:"))
(should-not connection-local-variables-alist)
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))
(hack-connection-local-variables-apply)
;; All connection-local variables are set. They apply in
;; reverse order in `connection-local-variables-alist'. The
;; settings from `remote-ksh' are not contained, because they
;; declare same variables as in `remote-bash'.
(should
(equal connection-local-variables-alist
(nreverse (copy-tree files-x-test--variables1))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
;; The proper variable value is set.
(should
(string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))))
;; When `enable-connection-local-variables' is nil, nothing happens.
(with-temp-buffer
(let ((enable-connection-local-variables nil)
(default-directory "/ssh:another-user@my-remote-host:"))
(should-not connection-local-variables-alist)
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))
(hack-connection-local-variables-apply)
(should-not connection-local-variables-alist)
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))))))
(ert-deftest files-x-test-with-connection-local-classes ()
"Test setting connection-local variables."
(let (connection-local-class-alist connection-local-criteria-alist)
(connection-local-set-class-variables 'remote-bash files-x-test--variables1)