Newer
Older
;;; eudc.el --- Emacs Unified Directory Client - LDAP Support
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
;; Created: Feb 1998
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
;; Keywords: help
;; This file is part of XEmacs
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This library provides specific LDAP protocol support for the
;; Emacs Unified Directory Client library.
;;; Installation:
;; Install EUDC first. See EUDC documentation.
;; This library runs under XEmacs 20 and under Emacs 19.34 and above
;;; Usage:
;;; Code:
(require 'eudc)
(require 'ldap)
;;{{{ Package customization variables
(defgroup eudc-ldap nil
"Emacs Unified Directory Client - LDAP Support"
:group 'comm)
(defcustom eudc-ldap-bbdb-conversion-alist
'((name . cn)
(net . mail)
(address . (eudc-bbdbify-address postaladdress "Address"))
(phone . ((eudc-bbdbify-phone telephonenumber "Phone"))))
"*A mapping from BBDB to LDAP attributes.
This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where
BBDB-FIELD is the name of a field that must be defined in your BBDB
environment (standard field names are `name', `company', `net', `phone',
`address' and `notes'). SPEC-OR-LIST is either a single SPEC or a list
of SPECs. Lists of specs are valid only for the `phone' and `address'
BBDB fields. SPECs are sexps which are evaluated:
a string evaluates to itself,
a symbol evaluates to the symbol value. Symbols naming LDAP attributes
present in the record evaluate to the value of the field in the record,
a form is evaluated as a function. The argument list may contain LDAP
field names which eval to the corresponding values in the
record. The form evaluation should return something appropriate for
the particular BBDB-FIELD (see `bbdb-create-internal').
`eudc-bbdbify-phone' and `eudc-bbdbify-address' are provided as convenience
functions to parse phones and addresses."
:tag "BBDB to LDAP Attribute Names Mapping"
:type '(repeat (cons :tag "Field Name"
(symbol :tag "BBDB Field")
(sexp :tag "Conversion Spec")))
:group 'eudc-ldap)
;;}}}
;;{{{ Internal cooking
;; Whether eudc-inline-query-format should be cleared on switching protocols
;; from LDAP
(defvar eudc-ldap-clear-inline-query-format-on-exit nil)
(defvar eudc-ldap-attributes-translation-alist
'((name . sn)
(email . mail)
(phone . telephonenumber))
"Alist mapping EUDC attribute names to LDAP names.")
(defconst eudc-ldap-protocol-locals
'((eudc-query-function . eudc-ldap-simple-query-internal)
(eudc-protocol-attributes-translation-alist . eudc-ldap-attributes-translation-alist)
(eudc-bbdb-conversion-alist . eudc-ldap-bbdb-conversion-alist)
(eudc-protocol-switch-init-function . eudc-ldap-protocol-switch-init)
(eudc-protocol-switch-exit-function . eudc-ldap-protocol-switch-exit))
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
"LDAP protocol specific values of EUDC variables.
This should be an alist of the form (EUDC-VAR . LDAP-VAR) where
EUDC-VAR is the name of a EUDC variable and LDAP-VAR is
the corresponding LDAP-specific variable.")
(defun eudc-ldap-cleanup-record-field (field)
"Do some cleanup in a record field to make it suitable for EUDC."
;; Make the field a cons-cell if it's single-valued
;;
(if (null (cdr (cdr field)))
(cons (intern (car field))
;; Convert separators to newlines
(replace-in-string (car (cdr field)) " \\$ " "\n"))
;; Make the field name a symbol
(cons (intern (car field)) (cdr field))))
(defun eudc-ldap-cleanup-record (record)
(mapcar 'eudc-ldap-cleanup-record-field
record))
(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
"Query the LDAP server with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
LDAP attribute names.
RETURN-ATTRS is a list of attributes to return, defaulting to
`eudc-default-return-attributes'."
(mapcar 'eudc-ldap-cleanup-record
(ldap-search (eudc-ldap-format-query-as-rfc1558 query)
eudc-server
(mapcar 'symbol-name return-attrs))))
(defun eudc-ldap-format-query-as-rfc1558 (query)
"Format the QUERY list as a RFC1558 LDAP search filter."
(format "(&%s)" (apply 'concat (mapcar '(lambda (item)
(format "(%s=%s)" (car item) (cdr item)))
query))))
;; Set eudc-inline-query-format for LDAP since LDAP does not
;; have default query attributes and hence won't accept plain
;; string queries without an associated attribute name
(defun eudc-ldap-set-inline-query-format-maybe ()
(when (null eudc-inline-query-format)
(setq eudc-inline-query-format '(name))
(setq eudc-ldap-clear-inline-query-format-on-exit t)))
(defun eudc-ldap-protocol-switch-init ()
(eudc-ldap-set-inline-query-format-maybe))
(defun eudc-ldap-protocol-switch-exit ()
(if eudc-ldap-clear-inline-query-format-on-exit
(setq eudc-inline-query-format nil)))
;;}}}
;;{{{ High-level interfaces (interactive functions)
(defun eudc-ldap-customize ()
"Customize the EUDC LDAP support."
(interactive)
(customize-group 'eudc-ldap))
(defun eudc-ldap-set-server (server)
"Set the LDAP server to SERVER."
(interactive "sNew LDAP Server: ")
(eudc-set-server server 'ldap)
(message "Selected LDAP server is now %s" server))
;;;}}}
(eudc-register-protocol 'ldap eudc-ldap-protocol-locals)
(provide 'eudc-ldap)
;;; eudc-ldap.el ends here