;;; 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 ;; Version: $Revision$ ;; 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) (firstname . givenname) (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-list-attributes-function . eudc-ldap-get-field-list) (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)) "\n")) (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 (stringp (car (cdr field))) (cons (intern (car field)) (eudc-filter-$ (car (cdr field)))) ;; Otherwise simply 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-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'" (interactive) (or eudc-server (call-interactively 'eudc-set-server)) (let ((ldap-host-parameters-plist (list (cons eudc-server '(scope subtree sizelimit 1))))) (mapcar 'eudc-ldap-cleanup-record (ldap-search (eudc-ldap-format-query-as-rfc1558 (list (cons "objectclass" (or objectclass "person")))) eudc-server nil t)))) (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) (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