procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix EUDC LDAP duplicate mail handling

Browse source 
Fixes: debbugs:17720

* net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
obsolete.
(eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
Don't clean up postal addresses if ldap-ignore-attribute-codings
is set.  Combine mail addresses into one field. (Bug#17720)
(eudc-ldap-simple-query-internal): Call
eudc-ldap-cleanup-record-filtering-addresses instead of
eudc-ldap-cleanup-record-simple.
(eudc-ldap-get-field-list): Likewise.
This commit is contained in:
Thomas Fitzsimmons 2015-03-05 21:53:37 -05:00
parent b08f8bb06a
commit bfebebbc72
2 changed files with 42 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lisp/ChangeLog
View file

@ -1,3 +1,15 @@
2015-03-06 Thomas Fitzsimmons <fitzsim@fitzsim.org>
* net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
obsolete.
(eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
Don't clean up postal addresses if ldap-ignore-attribute-codings
is set. Combine mail addresses into one field. (Bug#17720)
(eudc-ldap-simple-query-internal): Call
eudc-ldap-cleanup-record-filtering-addresses instead of
eudc-ldap-cleanup-record-simple.
(eudc-ldap-get-field-list): Likewise.
2015-03-05 Ivan Shmakov <ivan@siamics.net>
* net/eww.el (eww-html-p): New function (bug#20009).

53
lisp/net/eudcb-ldap.el
View file

@ -74,13 +74,10 @@
(defun eudc-ldap-cleanup-record-simple (record)
"Do some cleanup in a RECORD to make it suitable for EUDC."
(declare (obsolete eudc-ldap-cleanup-record-filtering-addresses "25.1"))
(mapcar
(function
(lambda (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)
@ -90,22 +87,36 @@
(defun eudc-filter-$ (string)
(mapconcat 'identity (split-string string "\\$") "\n"))
;; Cleanup a LDAP record to make it suitable for EUDC:
;; Make the record a cons-cell instead of a list if it is single-valued
;; Filter the $ character in addresses into \n if not done by the LDAP lib
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
(mapcar
(function
(lambda (field)
"Clean up RECORD to make it suitable for EUDC.
Make the record a cons-cell instead of a list if it is
single-valued. Change the `$' character in postal addresses to a
newline. Combine separate mail fields into one mail field with
multiple addresses."
(let ((clean-up-addresses (or (not (boundp 'ldap-ignore-attribute-codings))
(not ldap-ignore-attribute-codings)))
result mail-addresses)
(dolist (field record)
;; 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.
(let ((name (intern (downcase (car field))))
(value (cdr field)))
(if (memq name '(postaladdress registeredaddress))
(setq value (mapcar 'eudc-filter-$ value)))
(cons name
(if (cdr value)
value
(car value))))))
record))
(when (and clean-up-addresses
(memq name '(postaladdress registeredaddress)))
(setq value (mapcar 'eudc-filter-$ value)))
(if (eq name 'mail)
(setq mail-addresses (append mail-addresses value))
(push (cons name (if (cdr value)
value
(car value)))
result))))
(push (cons 'mail (if (cdr mail-addresses)
mail-addresses
(car mail-addresses)))
result)
(nreverse result)))
(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
"Query the LDAP server with QUERY.
@ -118,11 +129,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(if (listp return-attrs)
(mapcar 'symbol-name return-attrs))))
final-result)
(if (or (not (boundp 'ldap-ignore-attribute-codings))
ldap-ignore-attribute-codings)
(setq result
(mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
(setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(if (and eudc-strict-return-matches
return-attrs
@ -148,7 +155,7 @@ attribute names are returned. Default to `person'"
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
(mapcar 'eudc-ldap-cleanup-record-simple
(mapcar 'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"