diff options
author | Joakim Verona <joakim@verona.se> | 2015-01-25 02:11:31 +0100 |
---|---|---|
committer | Joakim Verona <joakim@verona.se> | 2015-01-25 02:11:31 +0100 |
commit | e5087278b9bcab5847ce63d80c0d74c27f50e719 (patch) | |
tree | c9ad8959e81033cb3423a25496ea4c411b212461 | |
parent | bdd672b275034e8c1c65992f2e21dac7cc6eba60 (diff) | |
parent | bce27d884521832a62837b113f4e681974cdaccb (diff) | |
download | emacs-e5087278b9bcab5847ce63d80c0d74c27f50e719.tar.gz |
merge master
-rw-r--r-- | admin/ChangeLog | 6 | ||||
-rw-r--r-- | admin/unidata/Makefile.in | 2 | ||||
-rw-r--r-- | doc/misc/ChangeLog | 9 | ||||
-rw-r--r-- | doc/misc/eudc.texi | 130 | ||||
-rw-r--r-- | lib-src/ChangeLog | 7 | ||||
-rw-r--r-- | lib-src/Makefile.in | 10 | ||||
-rw-r--r-- | lisp/ChangeLog | 95 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 18 | ||||
-rw-r--r-- | lisp/emacs-lisp/find-func.el | 2 | ||||
-rw-r--r-- | lisp/net/eudc-vars.el | 97 | ||||
-rw-r--r-- | lisp/net/eudc.el | 71 | ||||
-rw-r--r-- | lisp/net/eudcb-ldap.el | 29 | ||||
-rw-r--r-- | lisp/net/ldap.el | 136 | ||||
-rw-r--r-- | test/ChangeLog | 10 | ||||
-rw-r--r-- | test/automated/package-test.el | 7 |
15 files changed, 485 insertions, 144 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog index 70d1714f8eb..e692ca0dbfd 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,9 @@ +2015-01-24 Paul Eggert <eggert@cs.ucla.edu> + + Fix a couple of AM_V_GEN bugs + * unidata/Makefile.in (unifiles): Use AM_V_at instead of AM_V_GEN, + since this doesn't generate a file. + 2015-01-15 Eli Zaretskii <eliz@gnu.org> * unidata/uvs.el (uvs-print-table-ivd): Call set-binary-mode on diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 1396f0926f4..6c81d32484a 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -90,7 +90,7 @@ ${unidir}/charprop.el: ${srcdir}/unidata-gen.el \ ## to generate a Makefile fragment explicitly listing the uni- files, ## which this file could include. If no fragment, rebuild everything. unifiles: ${unidir}/charprop.el - $(AM_V_GEN)for f in `sed -n 's/^;; FILE: //p' < $<`; do \ + $(AM_V_at)for f in `sed -n 's/^;; FILE: //p' < $<`; do \ [ -f $(unidir)/$$f ] || exec $(MAKE) PHONY_EXTRAS=$< $<; \ done diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 2baa13cea8c..e75589f92ec 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * eudc.texi (LDAP Configuration): Rename from LDAP Requirements + and provide configuration examples. + 2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> * eieio.texi (Slot Options): Document :protection as unsupported. @@ -28,8 +33,8 @@ 2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net> - * gnus.texi (Gnus Registry Setup): Explain pruning changes. Mention - gnus-registry-prune-factor. Explain sorting changes and + * gnus.texi (Gnus Registry Setup): Explain pruning changes. + Mention gnus-registry-prune-factor. Explain sorting changes and gnus-registry-default-sort-function. Correct file extension. 2014-12-17 Jay Belanger <jay.p.belanger@gmail.com> diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index b5a4e3aae40..9757c82fe7e 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -137,7 +137,7 @@ location, etc@enddots{} More information about LDAP can be found at @url{http://www.openldap.org/}. EUDC requires external support to access LDAP directory servers -(@pxref{LDAP Requirements}) +(@pxref{LDAP Configuration}) @node CCSO PH/QI @@ -213,17 +213,131 @@ email composition buffers (@pxref{Inline Query Expansion}) @end lisp @menu -* LDAP Requirements:: EUDC needs external support for LDAP +* LDAP Configuration:: EUDC needs external support for LDAP @end menu -@node LDAP Requirements -@section LDAP Requirements +@node LDAP Configuration +@section LDAP Configuration -LDAP support is added by means of @file{ldap.el}, which is part of Emacs. -@file{ldap.el} needs an external command line utility named -@file{ldapsearch}, available as part of Open LDAP -(@url{http://www.openldap.org/}). +LDAP support is added by means of @file{ldap.el}, which is part of +Emacs. @file{ldap.el} needs an external command line utility named +@file{ldapsearch}, available as part of OpenLDAP +(@url{http://www.openldap.org/}). The configurations in this section +were tested with OpenLDAP 2.4.23. +The following examples use a base of +@code{ou=people,dc=example,dc=com} and the host name +@code{directory.example.com}, a server that supports LDAP-over-SSL +(the @code{ldaps} protocol, with default port @code{636}) and which +requires authentication by the user @code{emacsuser} with password +@code{s3cr3t}. + +These configurations are meant to be self-contained; that is, each +provides everything required for sensible TAB-completion of email +fields. BBDB lookups are attempted first; if a matching BBDB entry is +found then EUDC will not attempt any LDAP lookups. + +Wildcard LDAP lookups are supported using the @code{*} character. For +example, attempting to TAB-complete the following: + +@example +To: * Smith +@end example + +will return all LDAP entries with surnames that begin with +@code{Smith}. In every LDAP query it makes, EUDC implicitly appends +the wildcard character to the end of the last word. + +@subsection Emacs-only Configuration + +Emacs can pass most required configuration options via the +@file{ldapsearch} command-line. One exception is certificate +configuration for LDAP-over-SSL, which must be specified in +@file{/etc/openldap/ldap.conf}. On systems that provide such +certificates as part of the @code{OpenLDAP} installation, this can be +as simple as one line: + +@example +TLS_CACERTDIR /etc/openldap/certs +@end example + +In @file{.emacs}, these expressions suffice to configure EUDC for +LDAP: + +@lisp +(eval-after-load "message" + '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) +(customize-set-variable 'eudc-server-hotlist + '(("" . bbdb) + ("ldaps://directory.example.com" . ldap))) +(customize-set-variable 'ldap-host-parameters-alist + '(("ldaps://directory.example.com" + base "ou=people,dc=example,dc=com" + binddn "example\\emacsuser" + passwd ldap-password-read))) +@end lisp + +Specifying the function @code{ldap-password-read} for @code{passwd} +will cause Emacs to prompt interactively for the password. The +password will then be validated and cached, unless +@code{password-cache} is nil. You can customize +@code{password-cache-expiry} to control the duration for which the +password is cached. If you want to clear the cache, call +@code{password-reset}. + +@subsection External Configuration + +Your system may already be configured for a default LDAP server. For +example, @file{/etc/openldap/ldap.conf} might contain: + +@example +BASE ou=people,dc=example,dc=com +URI ldaps://directory.example.com +TLS_CACERTDIR /etc/openldap/certs +@end example + +To authenticate, the @dfn{bind distinguished name (binddn)} is +required, in this case, @code{example\emacsuser}, along with the +password. These can be specified in @file{~/.authinfo.gpg} with the +following line: + +@example +machine ldaps://directory.example.com binddn example\emacsuser password s3cr3t +@end example + +Then in the @file{.emacs} init file, these expressions suffice to +configure EUDC for LDAP: + +@lisp +(eval-after-load "message" + '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) +(customize-set-variable 'eudc-server-hotlist + '(("" . bbdb) + ("ldaps://directory.example.com" . ldap))) +(customize-set-variable 'ldap-host-parameters-alist + '(("ldaps://directory.example.com" + auth-source t))) +@end lisp + +For this example where we only care about one server, the server name +can be omitted in @file{~/.authinfo.gpg} and @file{.emacs}, in which +case @file{ldapsearch} defaults to the host name in +@file{/etc/openldap/ldap.conf}. + +The @file{~/.authinfo.gpg} line becomes: + +@example +binddn example\emacsuser password s3cr3t +@end example + +and the @file{.emacs} expressions become: + +@lisp +(eval-after-load "message" + '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) +(customize-set-variable 'eudc-server-hotlist '(("" . bbdb) ("" . ldap))) +(customize-set-variable 'ldap-host-parameters-alist '(("" auth-source t))) +@end lisp @node Usage @chapter Usage diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 6cf82e91508..8d2c95e671c 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,10 @@ +2015-01-24 Paul Eggert <eggert@cs.ucla.edu> + + Fix a couple of AM_V_GEN bugs + * Makefile.in (AM_V_GEN, am__v_GEN_, am__v_GEN_0, am__v_GEN_1) + (AM_V_at, am__v_at_, am__v_at_0, am__v_at_1): + New macros, copied from ../src/Makefile.in. + 2015-01-22 Paul Eggert <eggert@cs.ucla.edu> Check exit statuses in lib-src/Makefile diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 1b329c2f221..d2705e7b5dc 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -58,11 +58,21 @@ am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) am__v_CCLD_0 = @echo " CCLD " $@; am__v_CCLD_1 = +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = + AM_V_RC = $(am__v_RC_@AM_V@) am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@) am__v_RC_0 = @echo " RC " $@; am__v_RC_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = + # ==================== Where To Install Things ==================== # Location to install Emacs.app under GNUstep / Mac OS X. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5cceb19ff1a..d42670f743b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,98 @@ +2015-01-25 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/find-func.el (find-function-regexp): Don't match + `defgroup' (regression from the previous change here). + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-search-internal): Mention binddn in invalid + credentials error message. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-password-read): Validate password before + caching it. + (ldap-search-internal): Handle ldapsearch error conditions. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-password-read): Handle password-cache being nil. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-expand-inline): Always restore former server + and protocol. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-ldap.el: Don't nag the user in case a default base is + provided by the LDAP system configuration file. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-format-query): Preserve the + eudc-inline-query-format ordering of attributes in the returned list. + * net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558): + Append the LDAP wildcard character to the last attribute value. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): + Downcase field names of LDAP results. + (eudc-ldap-cleanup-record-filtering-addresses): Likewise. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-ldapsearch-password-prompt): New defcustom. + (ldap-search-internal): Send password to ldapsearch through a pipe + instead of via the command line. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el: Require password-cache. + (ldap-password-read): New function. + (ldap-search-internal): Call ldap-password-read when it is + configured to be called. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-expansion-overwrites-query): + Change default to nil. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc.el (eudc-expand-inline): Ignore text properties of + string-to-expand. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-inline-expansion-format): Default to a + format that includes first name and surname. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-inline-query-format): Change default to + query email and first name instead of surname. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs. + +2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + * net/eudc-vars.el (eudc-server): Adjust docstring to mention + eudc-server-hotlist. + (eudc-server-hotlist): Move from eudc.el and make defcustom. + * net/eudc.el (eudc-server-hotlist): Move to eudc-vars.el. + (eudc-set-server): Allow setting protocol to nil. + (eudc-expand-inline): Support hotlist-only expansions when server + is not set. + +2015-01-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error. + (cl--generic-build-combined-method): Use it. + 2015-01-22 Paul Eggert <eggert@cs.ucla.edu> Don't downcase system diagnostics' first letters diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index f214faff237..095f1e5d582 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -462,9 +462,12 @@ for all those different tags in the method-cache.") (gethash (cons generic-name mets-by-qual) cl--generic-combined-method-memoization) (cond - ((null mets-by-qual) (lambda (&rest args) - (apply #'cl-no-applicable-method - generic-name args))) + ((null mets-by-qual) + (lambda (&rest args) + (apply #'cl-no-applicable-method generic-name args))) + ((null (alist-get :primary mets-by-qual)) + (lambda (&rest args) + (apply #'cl-no-primary-method generic-name args))) (t (let* ((fun (lambda (&rest args) ;; FIXME: CLOS passes as second arg the "calling method". @@ -475,8 +478,6 @@ for all those different tags in the method-cache.") ;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method ;; table, but the caller wouldn't be able to do much with ;; it anyway. So we pass nil for now. - ;; FIXME: signal `no-primary-method' if there's - ;; no primary. (apply #'cl-no-next-method generic-name nil args))) ;; We use `cdr' to drop the `uses-cnm' annotations. (before @@ -546,6 +547,7 @@ for all those different tags in the method-cache.") (define-error 'cl-no-method "No method for %S") (define-error 'cl-no-next-method "No next method for %S" 'cl-no-method) +(define-error 'cl-no-primary-method "No primary method for %S" 'cl-no-method) (define-error 'cl-no-applicable-method "No applicable method for %S" 'cl-no-method) @@ -559,6 +561,11 @@ for all those different tags in the method-cache.") (cl-defmethod cl-no-applicable-method (generic &rest args) (signal 'cl-no-applicable-method `(,generic ,@args))) +(cl-defgeneric cl-no-primary-method (generic &rest args) + "Function called when a method call finds no primary method.") +(cl-defmethod cl-no-primary-method (generic &rest args) + (signal 'cl-no-primary-method `(,generic ,@args))) + (defun cl-call-next-method (&rest _args) "Function to call the next applicable method. Can only be used from within the lexical body of a primary or around method." @@ -727,6 +734,7 @@ Can only be used from within the lexical body of a primary or around method." ;; (foo 'major-mode toto titi) ;; ;; FIXME: Better would be to do that via dispatch on an "implicit argument". +;; E.g. (cl-defmethod foo (y z &context (major-mode text-mode)) ...) ;; (defvar cl--generic-major-modes (make-hash-table :test #'eq)) ;; diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 6c9c798bc16..7ea13d4637b 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -59,7 +59,7 @@ (concat "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ -foo\\|\\(?:[^icfv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ +foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ menu-bar-make-toggle\\)" find-function-space-re "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)") diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 6bc0337f958..29ddf613376 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -41,14 +41,36 @@ "The name or IP address of the directory server. A port number may be specified by appending a colon and a number to the name of the server. Use `localhost' if the directory -server resides on your computer (BBDB backend)." - :type '(choice (string :tag "Server") (const :tag "None" nil)) - :group 'eudc) +server resides on your computer (BBDB backend). + +To specify multiple servers, customize eudc-server-hotlist +instead." + :type '(choice (string :tag "Server") (const :tag "None" nil))) ;; Known protocols (used in completion) ;; Not to be mistaken with `eudc-supported-protocols' (defvar eudc-known-protocols '(bbdb ph ldap)) +(defcustom eudc-server-hotlist nil + "Directory servers to query. +This is an alist of the form (SERVER . PROTOCOL). SERVER is the +host name or URI of the server, PROTOCOL is a symbol representing +the EUDC backend with which to access the server. + +The BBDB backend ignores SERVER; `localhost' can be used as a +placeholder string." + :tag "Directory Servers to Query" + :type `(repeat (cons :tag "Directory Server" + (string :tag "Server Host Name or URI") + (choice :tag "Protocol" + :menu-tag "Protocol" + ,@(mapcar (lambda (s) + (list 'const + ':tag (symbol-name s) s)) + eudc-known-protocols) + (const :tag "None" nil)))) + :version "25.1") + (defvar eudc-supported-protocols nil "Protocols currently supported by EUDC. This variable is updated when protocol-specific libraries @@ -61,15 +83,13 @@ Supported protocols are specified by `eudc-supported-protocols'." ,@(mapcar (lambda (s) (list 'const ':tag (symbol-name s) s)) eudc-known-protocols) - (const :tag "None" nil)) - :group 'eudc) + (const :tag "None" nil))) (defcustom eudc-strict-return-matches t "Ignore or allow entries not containing all requested return attributes. If non-nil, such entries are ignored." - :type 'boolean - :group 'eudc) + :type 'boolean) (defcustom eudc-default-return-attributes nil "A list of default attributes to extract from directory entries. @@ -82,8 +102,7 @@ server." (repeat :menu-tag "Attribute list" :tag "Attribute name" :value (nil) - (symbol :tag "Attribute name"))) - :group 'eudc) + (symbol :tag "Attribute name")))) (defcustom eudc-multiple-match-handling-method 'select "What to do when multiple entries match an inline expansion query. @@ -102,8 +121,7 @@ Possible values are: (const :menu-tag "Abort Operation" :tag "Abort Operation" abort) (const :menu-tag "Default (Use First)" - :tag "Default (Use First)" nil)) - :group 'eudc) + :tag "Default (Use First)" nil))) (defcustom eudc-duplicate-attribute-handling-method '((email . duplicate)) "A method to handle entries containing duplicate attributes. @@ -130,10 +148,10 @@ different values." (const :menu-tag "List" list) (const :menu-tag "First" first) (const :menu-tag "Concat" concat) - (const :menu-tag "Duplicate" duplicate))))) - :group 'eudc) + (const :menu-tag "Duplicate" duplicate)))))) -(defcustom eudc-inline-query-format '((name) +(defcustom eudc-inline-query-format '((email) + (firstname) (firstname name)) "Format of an inline expansion query. This is a list of FORMATs. A FORMAT is itself a list of one or more @@ -160,14 +178,16 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and (const :menu-tag "Email Address" :tag "Email Address" email) (const :menu-tag "Phone" :tag "Phone" phone) (symbol :menu-tag "Other" :tag "Attribute name")))) - :group 'eudc) + :version "25.1") -(defcustom eudc-expansion-overwrites-query t +;; Default to nil so that the most common use of eudc-expand-inline, +;; where replace is nil, does not affect the kill ring. +(defcustom eudc-expansion-overwrites-query nil "If non-nil, expanding a query overwrites the query string." :type 'boolean - :group 'eudc) + :version "25.1") -(defcustom eudc-inline-expansion-format '("%s" email) +(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email) "A list specifying the format of the expansion of inline queries. This variable controls what `eudc-expand-inline' actually inserts in the buffer. First element is a string passed to `format'. Remaining @@ -185,7 +205,7 @@ are passed as additional arguments to `format'." (const :menu-tag "Phone" :tag "Phone" phone) (symbol :menu-tag "Other") (symbol :tag "Attribute name")))) - :group 'eudc) + :version "25.1") (defcustom eudc-inline-expansion-servers 'server-then-hotlist "Which servers to contact for the expansion of inline queries. @@ -198,8 +218,7 @@ Possible values are: :menu-tag "Servers" (const :menu-tag "Current server" current-server) (const :menu-tag "Servers in the hotlist" hotlist) - (const :menu-tag "Current server then hotlist" server-then-hotlist)) - :group 'eudc) + (const :menu-tag "Current server then hotlist" server-then-hotlist))) (defcustom eudc-max-servers-to-query nil "Maximum number of servers to query for an inline expansion. @@ -213,8 +232,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'." (const :menu-tag "3" 3) (const :menu-tag "4" 4) (const :menu-tag "5" 5) - (integer :menu-tag "Set")) - :group 'eudc) + (integer :menu-tag "Set"))) (defcustom eudc-query-form-attributes '(name firstname email phone) "A list of attributes presented in the query form." @@ -226,8 +244,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'." (const :menu-tag "Surname" :tag "Surname" name) (const :menu-tag "Email Address" :tag "Email Address" email) (const :menu-tag "Phone" :tag "Phone" phone) - (symbol :menu-tag "Other" :tag "Attribute name"))) - :group 'eudc) + (symbol :menu-tag "Other" :tag "Attribute name")))) (defcustom eudc-user-attribute-names-alist '((url . "URL") (callsign . "HAM Call Sign") @@ -257,15 +274,13 @@ at `_' characters and capitalizing the individual words." :tag "User-defined Names of Directory Attributes" :type '(repeat (cons :tag "Field" (symbol :tag "Directory attribute") - (string :tag "User friendly name "))) - :group 'eudc) + (string :tag "User friendly name ")))) (defcustom eudc-use-raw-directory-names nil "If non-nil, use attributes names as defined in the directory. Otherwise, directory query/response forms display the user attribute names defined in `eudc-user-attribute-names-alist'." - :type 'boolean - :group 'eudc) + :type 'boolean) (defcustom eudc-attribute-display-method-alist nil "An alist specifying methods to display attribute values. @@ -277,8 +292,7 @@ attribute values for display." :tag "Attribute Decoding Functions" :type '(repeat (cons :tag "Attribute" (symbol :tag "Name") - (symbol :tag "Display Function"))) - :group 'eudc) + (symbol :tag "Display Function")))) (defcustom eudc-external-viewers '(("ImageMagick" "display" "-") ("ShowAudio" "showaudio")) @@ -295,18 +309,15 @@ arguments that should be passed to the program." (repeat :tag "Arguments" :inline t - (string :tag "Argument")))) - :group 'eudc) + (string :tag "Argument"))))) (defcustom eudc-options-file "~/.eudc-options" "A file where the `servers' hotlist is stored." - :type '(file :Tag "File Name:") - :group 'eudc) + :type '(file :Tag "File Name:")) (defcustom eudc-mode-hook nil "Normal hook run on entry to EUDC mode." - :type '(repeat (sexp :tag "Hook definition")) - :group 'eudc) + :type 'hook) ;;}}} @@ -341,8 +352,7 @@ BBDB fields. SPECs are sexps which are evaluated: :tag "BBDB to PH Field Name Mapping" :type '(repeat (cons :tag "Field Name" (symbol :tag "BBDB Field") - (sexp :tag "Conversion Spec"))) - :group 'eudc-ph) + (sexp :tag "Conversion Spec")))) ;;}}} @@ -376,8 +386,7 @@ BBDB fields. SPECs are sexps which are evaluated: :tag "BBDB to LDAP Attribute Names Mapping" :type '(repeat (cons :tag "Field Name" (symbol :tag "BBDB Field") - (sexp :tag "Conversion Spec"))) - :group 'eudc-ldap) + (sexp :tag "Conversion Spec")))) ;;}}} @@ -391,14 +400,12 @@ BBDB fields. SPECs are sexps which are evaluated: "If non-nil, BBDB address and phone locations are used as attribute names. This has no effect on queries (you can't search for a specific location) but influences the way records are displayed." - :type 'boolean - :group 'eudc-bbdb) + :type 'boolean) (defcustom eudc-bbdb-enable-substring-matches t "If non-nil, authorize substring match in the same way BBDB does. Otherwise records must match queries exactly." - :type 'boolean - :group 'eudc-bbdb) + :type 'boolean) ;;}}} diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 0f2fc0be7bd..4dd80972e3f 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -76,10 +76,6 @@ (defvar mode-popup-menu) -;; List of known servers -;; Alist of (SERVER . PROTOCOL) -(defvar eudc-server-hotlist nil) - ;; List of variables that have server- or protocol-local bindings (defvar eudc-local-vars nil) @@ -688,7 +684,8 @@ server for future sessions." (cons (symbol-name elt) elt)) eudc-known-protocols))))) - (unless (or (member protocol + (unless (or (null protocol) + (member protocol eudc-supported-protocols) (load (concat "eudcb-" (symbol-name protocol)) t)) (error "Unsupported protocol: %s" protocol)) @@ -766,7 +763,6 @@ otherwise a list of symbols is returned." format (cdr format))) ;; If the same attribute appears more than once, merge ;; the corresponding values - (setq query-alist (nreverse query-alist)) (while query-alist (setq key (eudc-caar query-alist) val (eudc-cdar query-alist) @@ -812,19 +808,29 @@ If REPLACE is non-nil, then this expansion replaces the name in the buffer. Multiple servers can be tried with the same query until one finds a match, see `eudc-inline-expansion-servers'" (interactive) - (if (memq eudc-inline-expansion-servers - '(current-server server-then-hotlist)) - (or eudc-server - (call-interactively 'eudc-set-server)) + (cond + ((eq eudc-inline-expansion-servers 'current-server) + (or eudc-server + (call-interactively 'eudc-set-server))) + ((eq eudc-inline-expansion-servers 'server-then-hotlist) + (or eudc-server + ;; Allow server to be nil if hotlist is set. + eudc-server-hotlist + (call-interactively 'eudc-set-server))) + ((eq eudc-inline-expansion-servers 'hotlist) (or eudc-server-hotlist (error "No server in the hotlist"))) + (t + (error "Wrong value for `eudc-inline-expansion-servers': %S" + eudc-inline-expansion-servers))) (let* ((end (point)) (beg (save-excursion (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" (point-at-bol) 'move) (goto-char (match-end 0))) (point))) - (query-words (split-string (buffer-substring beg end) "[ \t]+")) + (query-words (split-string (buffer-substring-no-properties beg end) + "[ \t]+")) query-formats response response-string @@ -840,18 +846,17 @@ see `eudc-inline-expansion-servers'" ((eq eudc-inline-expansion-servers 'hotlist) eudc-server-hotlist) ((eq eudc-inline-expansion-servers 'server-then-hotlist) - (cons (cons eudc-server eudc-protocol) - (delete (cons eudc-server eudc-protocol) servers))) + (if eudc-server + (cons (cons eudc-server eudc-protocol) + (delete (cons eudc-server eudc-protocol) servers)) + eudc-server-hotlist)) ((eq eudc-inline-expansion-servers 'current-server) - (list (cons eudc-server eudc-protocol))) - (t - (error "Wrong value for `eudc-inline-expansion-servers': %S" - eudc-inline-expansion-servers)))) + (list (cons eudc-server eudc-protocol))))) (if (and eudc-max-servers-to-query (> (length servers) eudc-max-servers-to-query)) (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) - (condition-case signal + (unwind-protect (progn (setq response (catch 'found @@ -887,14 +892,15 @@ see `eudc-inline-expansion-servers'" ;; Process response through eudc-inline-expansion-format (while response - (setq response-string (apply 'format - (car eudc-inline-expansion-format) - (mapcar (function - (lambda (field) - (or (cdr (assq field (car response))) - ""))) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format))))) + (setq response-string + (apply 'format + (car eudc-inline-expansion-format) + (mapcar (function + (lambda (field) + (or (cdr (assq field (car response))) + ""))) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format))))) (if (> (length response-string) 0) (setq response-strings (cons response-string response-strings))) @@ -916,15 +922,10 @@ see `eudc-inline-expansion-servers'" (delete-region beg end) (insert (mapconcat 'identity response-strings ", "))) ((eq eudc-multiple-match-handling-method 'abort) - (error "There is more than one match for the query")))) - (or (and (equal eudc-server eudc-former-server) - (equal eudc-protocol eudc-former-protocol)) - (eudc-set-server eudc-former-server eudc-former-protocol t))) - (error - (or (and (equal eudc-server eudc-former-server) - (equal eudc-protocol eudc-former-protocol)) - (eudc-set-server eudc-former-server eudc-former-protocol t)) - (signal (car signal) (cdr signal)))))) + (error "There is more than one match for the query"))))) + (or (and (equal eudc-server eudc-former-server) + (equal eudc-protocol eudc-former-protocol)) + (eudc-set-server eudc-former-server eudc-former-protocol t))))) ;;;###autoload (defun eudc-query-form (&optional get-fields-from-server) diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 4c9b2490ee3..92972c5f99e 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -70,16 +70,17 @@ ("mail" . eudc-display-mail) ("url" . eudc-display-url)) 'ldap) -(eudc-protocol-set 'eudc-switch-to-server-hook - '(eudc-ldap-check-base) - 'ldap) (defun eudc-ldap-cleanup-record-simple (record) "Do some cleanup in a RECORD to make it suitable for EUDC." (mapcar (function (lambda (field) - (cons (intern (car field)) + ;; Some servers return case-sensitive names (e.g. givenName + ;; instead of givenname); downcase the field's name so that it + ;; can be matched against + ;; eudc-ldap-attributes-translation-alist. + (cons (intern (downcase (car field))) (if (cdr (cdr field)) (cdr field) (car (cdr field)))))) @@ -95,7 +96,7 @@ (mapcar (function (lambda (field) - (let ((name (intern (car field))) + (let ((name (intern (downcase (car field)))) (value (cdr field))) (if (memq name '(postaladdress registeredaddress)) (setq value (mapcar 'eudc-filter-$ value))) @@ -170,14 +171,16 @@ attribute names are returned. Default to `person'" (defun eudc-ldap-format-query-as-rfc1558 (query) "Format the EUDC QUERY list as a RFC1558 LDAP search filter." - (format "(&%s)" - (apply 'concat - (mapcar (lambda (item) - (format "(%s=%s)" - (car item) - (eudc-ldap-escape-query-special-chars (cdr item)))) - query)))) - + (let ((formatter (lambda (item &optional wildcard) + (format "(%s=%s)" + (car item) + (concat + (eudc-ldap-escape-query-special-chars + (cdr item)) (if wildcard "*" "")))))) + (format "(&%s)" + (concat + (mapconcat formatter (butlast query) "") + (funcall formatter (car (last query)) t))))) ;;}}} diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index eb1b7589b48..a77fc3c6514 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -34,6 +34,7 @@ ;;; Code: (require 'custom) +(require 'password-cache) (autoload 'auth-source-search "auth-source") @@ -47,15 +48,13 @@ A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") - (const :tag "Use library default" nil)) - :group 'ldap) + (const :tag "Use library default" nil))) (defcustom ldap-default-port nil "Default TCP port for LDAP connections. Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) - (integer :tag "Port number")) - :group 'ldap) + (integer :tag "Port number"))) (defcustom ldap-default-base nil "Default base for LDAP searches. @@ -63,8 +62,7 @@ This is a string using the syntax of RFC 1779. For instance, \"o=ACME, c=US\" limits the search to the Acme organization in the United States." :type '(choice (const :tag "Use library default" nil) - (string :tag "Search base")) - :group 'ldap) + (string :tag "Search base"))) (defcustom ldap-host-parameters-alist nil @@ -144,35 +142,35 @@ Valid properties include: :tag "Size Limit" :inline t (const :tag "Size Limit" sizelimit) - (integer :tag "(number of records)"))))) - :group 'ldap) + (integer :tag "(number of records)")))))) (defcustom ldap-ldapsearch-prog "ldapsearch" "The name of the ldapsearch command line program." - :type '(string :tag "`ldapsearch' Program") - :group 'ldap) + :type '(string :tag "`ldapsearch' Program")) (defcustom ldap-ldapsearch-args '("-LL" "-tt") "A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" - (string :tag "Argument")) - :group 'ldap) + (string :tag "Argument"))) + +(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: " + "A regular expression used to recognize the `ldapsearch' +program's password prompt." + :type 'regexp + :version "25.1") (defcustom ldap-ignore-attribute-codings nil "If non-nil, do not encode/decode LDAP attribute values." - :type 'boolean - :group 'ldap) + :type 'boolean) (defcustom ldap-default-attribute-decoder nil "Decoder function to use for attributes whose syntax is unknown." - :type 'symbol - :group 'ldap) + :type 'symbol) (defcustom ldap-coding-system 'utf-8 "Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8." - :type 'symbol - :group 'ldap) + :type 'symbol) (defvar ldap-attribute-syntax-encoders [nil ; 1 ACI Item N @@ -476,6 +474,47 @@ Additional search parameters can be specified through (mapcar 'ldap-decode-attribute record)) result)))) +(defun ldap-password-read (host) + "Read LDAP password for HOST. +If the password is cached, it is read from the cache, otherwise the user +is prompted for the password. If `password-cache' is non-nil the password +is verified and cached. The `password-cache-expiry' variable +controls for how long the password is cached. + +This function can be specified for the `passwd' property in +`ldap-host-parameters-alist' when interactive password prompting +is desired for HOST." + ;; Add ldap: namespace to allow empty string for default host. + (let* ((host-key (concat "ldap:" host)) + (password (password-read + (format "Enter LDAP Password%s: " + (if (equal host "") + "" + (format " for %s" host))) + host-key))) + (when (and password-cache + (not (password-in-cache-p host-key)) + ;; Confirm the password is valid before adding it to + ;; the password cache. ldap-search-internal will throw + ;; an error if the password is invalid. + (not (ldap-search-internal + `(host ,host + ;; Specify an arbitrary filter that should + ;; produce no results, since only + ;; authentication success is of interest. + filter "emacs-test-password=" + attributes nil + attrsonly nil + withdn nil + ;; Preempt passwd ldap-password-read + ;; setting in ldap-host-parameters-alist. + passwd ,password + ,@(cdr + (assoc + host + ldap-host-parameters-alist)))))) + (password-cache-add host-key password)) + password)) (defun ldap-search-internal (search-plist) "Perform a search on a LDAP server. @@ -531,7 +570,11 @@ an alist of attribute/value pairs." (passwd (or (plist-get search-plist 'passwd) (plist-get asfound :secret))) ;; convert the password from a function call if needed - (passwd (if (functionp passwd) (funcall passwd) passwd)) + (passwd (if (functionp passwd) + (if (eq passwd 'ldap-password-read) + (funcall passwd host) + (funcall passwd)) + passwd)) ;; get the binddn from the search-list or from the ;; auth-source user or binddn tokens (binddn (or (plist-get search-plist 'binddn) @@ -550,7 +593,7 @@ an alist of attribute/value pairs." (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) - arglist dn name value record result) + arglist dn name value record result proc) (if (or (null filter) (equal "" filter)) (error "No search filter")) @@ -559,7 +602,13 @@ an alist of attribute/value pairs." (erase-buffer) (if (and host (not (equal "" host))) - (setq arglist (nconc arglist (list (format "-h%s" host))))) + (setq arglist (nconc arglist + (list (format + ;; Use -H if host is a new-style LDAP URI. + (if (string-match "^[a-zA-Z]+://" host) + "-H%s" + "-h%s") + host))))) (if (and attrsonly (not (equal "" attrsonly))) (setq arglist (nconc arglist (list "-A")))) @@ -575,9 +624,9 @@ an alist of attribute/value pairs." (if (and auth (equal 'simple auth)) (setq arglist (nconc arglist (list "-x")))) - (if (and passwd - (not (equal "" passwd))) - (setq arglist (nconc arglist (list (format "-w%s" passwd))))) + ;; Allow passwd to be set to "", representing a blank password. + (if passwd + (setq arglist (nconc arglist (list "-W")))) (if (and deref (not (equal "" deref))) (setq arglist (nconc arglist (list (format "-a%s" deref))))) @@ -587,14 +636,43 @@ an alist of attribute/value pairs." (if (and sizelimit (not (equal "" sizelimit))) (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) - (apply #'call-process ldap-ldapsearch-prog - ;; Ignore stderr, which can corrupt results - nil (list buf nil) nil - (append arglist ldap-ldapsearch-args filter)) + (if passwd + (let* ((process-connection-type nil) + (proc-args (append arglist ldap-ldapsearch-args + filter)) + (proc (apply #'start-process "ldapsearch" buf + ldap-ldapsearch-prog + proc-args))) + (while (null (progn + (goto-char (point-min)) + (re-search-forward + ldap-ldapsearch-password-prompt-regexp + (point-max) t))) + (accept-process-output proc 1)) + (process-send-string proc passwd) + (process-send-string proc "\n") + (while (not (memq (process-status proc) '(exit signal))) + (sit-for 0.1)) + (let ((status (process-exit-status proc))) + (when (not (eq status 0)) + ;; Handle invalid credentials exit status specially + ;; for ldap-password-read. + (if (eq status 49) + (error (concat "Incorrect LDAP password or" + " bind distinguished name (binddn)")) + (error "Failed ldapsearch invocation: %s \"%s\"" + ldap-ldapsearch-prog + (mapconcat 'identity proc-args "\" \"")))))) + (apply #'call-process ldap-ldapsearch-prog + ;; Ignore stderr, which can corrupt results + nil (list buf nil) nil + (append arglist ldap-ldapsearch-args filter))) (insert "\n") (goto-char (point-min)) - (while (re-search-forward "[\t\n\f]+ " nil t) + (while (re-search-forward (concat "[\t\n\f]+ \\|" + ldap-ldapsearch-password-prompt-regexp) + nil t) (replace-match "" nil nil)) (goto-char (point-min)) diff --git a/test/ChangeLog b/test/ChangeLog index af36b5d2bde..5a4e616f6c6 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,4 +1,12 @@ -2015-01-20 Jorgen Schaefer <contact@jorgenschaefer.de> +2015-01-23 Dmitry Gutov <dgutov@yandex.ru> + + Fix package tests when TMPDIR is in HOME. (Bug#19657) + * automated/package-test.el (with-package-test): + Bind `abbreviated-home-dir' to nil. + (package-test-describe-package, package-test-signed): + Expect abbreviated directory names. + +2015-01-22 Jorgen Schaefer <contact@jorgenschaefer.de> * automated/package-test.el (package-test-install-prioritized): Re-add the test case and add priority to the correct repository diff --git a/test/automated/package-test.el b/test/automated/package-test.el index 3ea13dee4ad..a8488652c2f 100644 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -95,6 +95,7 @@ (package-archives `(("gnu" . ,package-test-data-dir))) (old-yes-no-defn (symbol-function 'yes-or-no-p)) (default-directory package-test-file-dir) + abbreviated-home-dir package--initialized package-alist ,@(if update-news @@ -339,8 +340,7 @@ Must called from within a `tar-mode' buffer." (goto-char (point-min)) (should (search-forward "simple-single is an installed package." nil t)) (should (search-forward - (format "Status: Installed in `%s/' (unsigned)." - (expand-file-name "simple-single-1.3" package-user-dir)) + "Status: Installed in `~/simple-single-1.3/' (unsigned)." nil t)) (should (search-forward "Version: 1.3" nil t)) (should (search-forward "Summary: A single-file package with no dependencies" @@ -409,8 +409,7 @@ Must called from within a `tar-mode' buffer." (goto-char (point-min)) (should (search-forward "signed-good is an installed package." nil t)) (should (search-forward - (format "Status: Installed in `%s/'." - (expand-file-name "signed-good-1.0" package-user-dir)) + "Status: Installed in `~/signed-good-1.0/'." nil t)))))) |