XEmacs 21.2.7
[chise/xemacs-chise.git.1] / lisp / ldap.el
index 1f09377..7a06c6a 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Created: Jan 1998
-;; Version: $Revision: 1.7.2.1 $
+;; Version: $Revision: 1.7.2.2 $
 ;; Keywords: help comm
 
 ;; This file is part of XEmacs
 
 ;;; Code:
 
-(eval-when '(load eval)
-  (require 'ldap))
-
-(defvar ldap-default-host nil
-  "*Default LDAP server.")
-
-(defvar ldap-host-parameters-alist nil
-  "*An alist of per host options for LDAP transactions
-The list elements look like (HOST PROP1 VAL1 PROP2 VAL2 ...)
-HOST is the name of an LDAP server. PROPn and VALn are property/value pairs
-describing parameters for the server.  Valid properties: 
+(require 'ldap)
+(require 'custom)
+
+(defgroup ldap nil
+  "Lightweight Directory Access Protocol"
+  :group 'comm)
+
+(defcustom ldap-default-host nil
+  "*Default LDAP server."
+  :type '(choice (string :tag "Host name")
+                (const :tag "Use library default" nil))
+  :group 'ldap)
+
+(defcustom ldap-default-port nil
+  "*Default TCP port for LDAP connections.
+Initialized from the LDAP library at build time. Default value is 389."
+  :type '(choice (const :tag "Use library default" nil)
+                (integer :tag "Port number"))
+  :group 'ldap)
+
+(defcustom ldap-default-base nil
+  "*Default base for LDAP searches.
+This is a string using the syntax of RFC 1779.
+For instance, \"o=ACME, c=US\" limits the search to the
+Acme organization in the United States."
+  :type '(choice (const :tag "Use library default" nil)
+                (string :tag "Search base"))
+  :group 'ldap)
+
+
+(defcustom ldap-host-parameters-alist nil
+  "*Alist of host-specific options for LDAP transactions.
+The format of each list element is:
+\(HOST PROP1 VAL1 PROP2 VAL2 ...)
+HOST is the name of an LDAP server. PROPn and VALn are property/value 
+pairs describing parameters for the server.  Valid properties include: 
   `binddn' is the distinguished name of the user to bind as 
     (in RFC 1779 syntax).
   `passwd' is the password to use for simple authentication.
@@ -55,39 +80,95 @@ describing parameters for the server.  Valid properties:
   `scope' is one of the three symbols `subtree', `base' or `onelevel'.
   `deref' is one of the symbols `never', `always', `search' or `find'.
   `timelimit' is the timeout limit for the connection in seconds.
-  `sizelimit' is the maximum number of matches to return." )
+  `sizelimit' is the maximum number of matches to return."
+  :type '(repeat :menu-tag "Host parameters"
+                :tag "Host parameters"
+                (list :menu-tag "Host parameters"
+                      :tag "Host parameters"
+                      :value nil
+                      (string :tag "Host name")
+                      (checklist :inline t
+                                 :greedy t
+                                 (list
+                                  :tag "Binding DN"
+                                  :inline t
+                                  (const :tag "Binding DN" binddn)
+                                  string)
+                                 (list
+                                  :tag "Password"
+                                  :inline t
+                                  (const :tag "Password" passwd)
+                                  string)
+                                 (list
+                                  :tag "Authentication Method"
+                                  :inline t
+                                  (const :tag "Authentication Method" auth)
+                                  (choice
+                                   (const :menu-tag "None" :tag "None" nil)
+                                   (const :menu-tag "Simple" :tag "Simple" simple)
+                                   (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
+                                   (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
+                                 (list
+                                  :tag "Search Base" 
+                                  :inline t
+                                  (const :tag "Search Base" base)
+                                  string)
+                                 (list
+                                  :tag "Search Scope" 
+                                  :inline t
+                                  (const :tag "Search Scope" scope)
+                                  (choice
+                                   (const :menu-tag "Default" :tag "Default" nil)
+                                   (const :menu-tag "Subtree" :tag "Subtree" subtree)
+                                   (const :menu-tag "Base" :tag "Base" base)
+                                   (const :menu-tag "One Level" :tag "One Level" onelevel)))
+                                 (list
+                                  :tag "Dereferencing"
+                                  :inline t
+                                  (const :tag "Dereferencing" deref)
+                                  (choice
+                                   (const :menu-tag "Default" :tag "Default" nil)
+                                   (const :menu-tag "Never" :tag "Never" never)
+                                   (const :menu-tag "Always" :tag "Always" always)
+                                   (const :menu-tag "When searching" :tag "When searching" search)
+                                   (const :menu-tag "When locating base" :tag "When locating base" find)))
+                                 (list
+                                  :tag "Time Limit"
+                                  :inline t
+                                  (const :tag "Time Limit" timelimit)
+                                  (integer :tag "(in seconds)"))
+                                 (list
+                                  :tag "Size Limit"
+                                  :inline t
+                                  (const :tag "Size Limit" sizelimit)
+                                  (integer :tag "(number of records)")))))
+:group 'ldap)
 
 
 (defun ldap-search (filter &optional host attributes attrsonly)
   "Perform an LDAP search.
-FILTER is the search filter in RFC1558 syntax
-HOST is the LDAP host on which to perform the search
-ATTRIBUTES is a list of the specific attributes to retrieve, 
-nil means retrieve all
-ATTRSONLY if non nil retrieves the attributes only without 
+FILTER is the search filter in RFC1558 syntax, i.e. something that
+looks like \"(cn=John Smith)\".
+HOST is the LDAP host on which to perform the search.
+ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
+If ATTRSONLY is non nil, the attributes will be retrieved without
 the associated values.
 Additional search parameters can be specified through 
 `ldap-host-parameters-alist' which see."
   (interactive "sFilter:")
-  (let (host-plist res ldap)
-    (if (null host)
-       (setq host ldap-default-host))
-    (if (null host)
-       (error "No LDAP host specified"))
-    (setq host-plist
-         (cdr (assoc host ldap-host-parameters-alist)))
+  (or host
+      (setq host ldap-default-host))
+  (or host
+      (error "No LDAP host specified"))
+  (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
+       ldap)
     (message "Opening LDAP connection to %s..." host)
     (setq ldap (ldap-open host host-plist))
     (message "Searching with LDAP on %s..." host)
-    (setq res (ldap-search-internal ldap filter 
-                                   (plist-get host-plist 'base)
-                                   (plist-get host-plist 'scope)
-                                   attributes attrsonly))
-    (ldap-close ldap)
-    res))
-
+    (prog1 (ldap-search-internal ldap filter 
+                                (plist-get host-plist 'base)
+                                (plist-get host-plist 'scope)
+                                attributes attrsonly)
+      (ldap-close ldap))))
                
-
-(provide 'ldap)
-
 ;;; ldap.el ends here