eudc / eudc-ldap.el

;;; eudc.el --- Emacs Unified Directory Client - LDAP Support

;; Copyright (C) 1998 Free Software Foundation, Inc.

;; Author: Oscar Figueiredo <>
;; Maintainer: Oscar Figueiredo <>
;; Created: Feb 1998
;; Version: 1.5
;; 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
;; 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))
  "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-filter-$ (string)
  (let ((res ""))
    (while (string-match " \\$ " string)
      (setq res (concat res 
			(substring string 0 (match-beginning 0))
      (setq string (substring string (match-end 0))))
    (setq res (concat res string))))

(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
	    (eudc-filter-$ (car (cdr field))))
    ;; Make the field name a symbol
    (cons (intern (car field)) (cdr field))))

(defun eudc-ldap-cleanup-record (record)
  (mapcar 'eudc-ldap-cleanup-record-field

(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 
  (mapcar 'eudc-ldap-cleanup-record
	  (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
		       (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)))

;; 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 ()

(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."
  (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