X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6b8bc570715801cb194dc4273370eab87628e8bf..63efa6c6a559a23be863cad0c08457a2d29a0a67:/lisp/net/eudcb-ldap.el

diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 14594409df..1d426a7b7b 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,9 +1,10 @@
-;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*- coding: utf-8 -*-
 
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;;         Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
 ;; Keywords: comm
 ;; Package: eudc
 
@@ -70,16 +71,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 +97,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)))
@@ -136,7 +138,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
 	 result))
     final-result))
 
-(defun eudc-ldap-get-field-list (dummy &optional objectclass)
+(defun eudc-ldap-get-field-list (_dummy &optional objectclass)
   "Return a list of valid attribute names for the current server.
 OBJECTCLASS is the LDAP object class for which the valid
 attribute names are returned. Default to `person'"
@@ -170,14 +172,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)))))
 
 ;;}}}