1 ;;; pldap.el --- A portable LDAP support for Emacs.
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
4 ;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Original was ldap.el:
7 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
8 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
11 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
12 ;; Maintainer: Yuuichi Teranishi <teranisi@gohome.org>
13 ;; Keywords: emulating, LDAP, comm
14 ;; Created: 15 June 2000
16 ;; This file is not part of GNU Emacs
18 ;; This program is free software; you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation; either version 2, or (at your option)
23 ;; This program is distributed in the hope that it will be useful,
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 ;; GNU General Public License for more details.
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs; see the file COPYING. If not, write to the
30 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
31 ;; Boston, MA 02111-1307, USA.
39 (eval-when-compile (require 'cl))
41 (defmacro ldap-static-if (cond then &rest else)
42 "`if' expression but COND is evaluated at compile-time."
45 (` (progn (,@ else)))))
47 (ldap-static-if (and (not (featurep 'pldap))
49 ;; You have built-in ldap feature (XEmacs).
52 ;; You don't have built-in ldap feature.
53 ;; Use external program.
55 ;;; For LDIF encoding.
56 ;; SAFE-CHAR = %x01-09 / %x0B-0C / %x0E-7F
57 (defconst ldap-ldif-safe-char-regexp
58 "[\000-\011\013\014\016-\177]"
59 "A Regexp for safe-char.")
60 ;; SAFE-INIT-CHAR = %x01-09 / %x0B-0C / %x0E-1F /
61 ;; %x21-39 / %x3B / %x3D-7F
62 (defconst ldap-ldif-safe-init-char-regexp
63 "[\001-\011\013\014\016-\037\038-\071\073\075-\177]"
64 "A Regexp for safe-init-char.")
65 ;; SAFE-STRING = [SAFE-INIT-CHAR *SAFE-CHAR]
66 (defconst ldap-ldif-safe-string-regexp
67 (concat ldap-ldif-safe-init-char-regexp ldap-ldif-safe-char-regexp "*")
68 "A Regexp for safe-string.")
70 (defconst ldap-ldif-field-name-regexp "[a-zA-Z][a-zA-Z0-9-;]*"
71 "A Regexp for field name.")
73 (defconst ldap-ldif-field-head-regexp
74 (concat "^" ldap-ldif-field-name-regexp ":")
75 "A Regexp for field head.")
77 (defconst ldap-ldif-next-field-head-regexp
78 (concat "\n" ldap-ldif-field-name-regexp ":")
79 "A Regexp for next field head.")
81 (defmacro ldap/ldif-safe-string-p (string)
82 "Return t if STRING is a safe-string for LDIF."
83 ;; Need better implentation.
84 (` (string-match ldap-ldif-safe-string-regexp (, string))))
87 "Lightweight Directory Access Protocol"
90 (defvar ldap-search-program "ldapsearch"
91 "LDAP search program.")
93 (defvar ldap-add-program "ldapadd"
96 (defvar ldap-delete-program "ldapdelete"
97 "LDAP delete program.")
99 (defvar ldap-modify-program "ldapmodify"
100 "LDAP modify program.")
102 (defcustom ldap-search-program-arguments '("-LL" "-x")
103 "*A list of additional arguments to pass to `ldapsearch'.
104 It is recommended to use the `-T' switch with Nescape's
105 implementation to avoid line wrapping.
106 `-L' is needed to get LDIF outout.
107 (`-LL' is needed to get rid of comments from OpenLDAP's ldapsearch.)
108 `-x' is needed to use simple authentication.
109 The `-B' switch should be used to enable the retrieval of
111 :type '(repeat :tag "`ldapsearch' Arguments"
112 (string :tag "Argument"))
115 (defcustom ldap-default-host nil
116 "*Default LDAP server hostname.
117 A TCP port number can be appended to that name using a colon as
119 :type '(choice (string :tag "Host name")
120 (const :tag "Use library default" nil))
123 (defcustom ldap-default-port nil
124 "*Default TCP port for LDAP connections.
125 Initialized from the LDAP library at build time. Default value is 389."
126 :type '(choice (const :tag "Use library default" nil)
127 (integer :tag "Port number"))
130 (defcustom ldap-default-base nil
131 "*Default base for LDAP searches.
132 This is a string using the syntax of RFC 1779.
133 For instance, \"o=ACME, c=US\" limits the search to the
134 Acme organization in the United States."
135 :type '(choice (const :tag "Use library default" nil)
136 (string :tag "Search base"))
139 (defcustom ldap-host-parameters-alist nil
140 "*Alist of host-specific options for LDAP transactions.
141 The format of each list element is:
142 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
143 HOST is the hostname of an LDAP server (with an optional TCP port number
144 appended to it using a colon as a separator).
145 PROPn and VALn are property/value pairs describing parameters for the server.
146 Valid properties include:
147 `binddn' is the distinguished name of the user to bind as
148 (in RFC 1779 syntax).
149 `passwd' is the password to use for simple authentication.
150 `auth' is the authentication method to use.
151 Possible values are: `simple', `krbv41' and `krbv42'.
152 `base' is the base for the search as described in RFC 1779.
153 `scope' is one of the three symbols `subtree', `base' or `onelevel'.
154 `deref' is one of the symbols `never', `always', `search' or `find'.
155 `timelimit' is the timeout limit for the connection in seconds.
156 `sizelimit' is the maximum number of matches to return."
157 :type '(repeat :menu-tag "Host parameters"
158 :tag "Host parameters"
159 (list :menu-tag "Host parameters"
160 :tag "Host parameters"
162 (string :tag "Host name")
168 (const :tag "Search Base" base)
173 (const :tag "Binding DN" binddn)
178 (const :tag "Password" passwd)
181 :tag "Authentication Method"
183 (const :tag "Authentication Method" auth)
185 (const :menu-tag "None" :tag "None" nil)
186 (const :menu-tag "Simple" :tag "Simple" simple)
187 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
188 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
192 (const :tag "Search Scope" scope)
194 (const :menu-tag "Default" :tag "Default" nil)
195 (const :menu-tag "Subtree" :tag "Subtree" subtree)
196 (const :menu-tag "Base" :tag "Base" base)
197 (const :menu-tag "One Level" :tag "One Level" onelevel)))
201 (const :tag "Dereferencing" deref)
203 (const :menu-tag "Default" :tag "Default" nil)
204 (const :menu-tag "Never" :tag "Never" never)
205 (const :menu-tag "Always" :tag "Always" always)
206 (const :menu-tag "When searching" :tag "When searching" search)
207 (const :menu-tag "When locating base" :tag "When locating base" find)))
211 (const :tag "Time Limit" timelimit)
212 (integer :tag "(in seconds)"))
216 (const :tag "Size Limit" sizelimit)
217 (integer :tag "(number of records)")))))
220 (defcustom ldap-verbose nil
221 "*If non-nil, LDAP operations echo progress messages."
225 (defcustom ldap-ignore-attribute-codings nil
226 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
230 (defcustom ldap-default-attribute-encoder nil
231 "*Encoder function to use for attributes whose syntax is unknown."
235 (defcustom ldap-default-attribute-decoder nil
236 "*Decoder function to use for attributes whose syntax is unknown."
240 (defcustom ldap-coding-system nil
241 "*Coding system of LDAP string values.
242 LDAP v3 specifies the coding system of strings to be UTF-8.
243 Mule support is needed for this."
247 (defvar ldap-attribute-syntax-encoders
249 nil ; 2 Access Point Y
250 nil ; 3 Attribute Type Description Y
254 ldap-encode-boolean ; 7 Boolean Y
255 nil ; 8 Certificate N
256 nil ; 9 Certificate List N
257 nil ; 10 Certificate Pair N
258 ldap-encode-country-string ; 11 Country String Y
259 ldap-encode-string ; 12 DN Y
260 nil ; 13 Data Quality Syntax Y
261 nil ; 14 Delivery Method Y
262 ldap-encode-string ; 15 Directory String Y
263 nil ; 16 DIT Content Rule Description Y
264 nil ; 17 DIT Structure Rule Description Y
265 nil ; 18 DL Submit Permission Y
266 nil ; 19 DSA Quality Syntax Y
268 nil ; 21 Enhanced Guide Y
269 nil ; 22 Facsimile Telephone Number Y
271 nil ; 24 Generalized Time Y
273 nil ; 26 IA5 String Y
274 number-to-string ; 27 INTEGER Y
276 nil ; 29 Master And Shadow Access Points Y
277 nil ; 30 Matching Rule Description Y
278 nil ; 31 Matching Rule Use Description Y
279 nil ; 32 Mail Preference Y
280 nil ; 33 MHS OR Address Y
281 nil ; 34 Name And Optional UID Y
282 nil ; 35 Name Form Description Y
283 nil ; 36 Numeric String Y
284 nil ; 37 Object Class Description Y
286 nil ; 39 Other Mailbox Y
287 nil ; 40 Octet String Y
288 ldap-encode-address ; 41 Postal Address Y
289 nil ; 42 Protocol Information Y
290 nil ; 43 Presentation Address Y
291 ldap-encode-string ; 44 Printable String Y
292 nil ; 45 Subtree Specification Y
293 nil ; 46 Supplier Information Y
294 nil ; 47 Supplier Or Consumer Y
295 nil ; 48 Supplier And Consumer Y
296 nil ; 49 Supported Algorithm N
297 nil ; 50 Telephone Number Y
298 nil ; 51 Teletex Terminal Identifier Y
299 nil ; 52 Telex Number Y
301 nil ; 54 LDAP Syntax Description Y
302 nil ; 55 Modify Rights Y
303 nil ; 56 LDAP Schema Definition Y
304 nil ; 57 LDAP Schema Description Y
305 nil ; 58 Substring Assertion Y
307 "A vector of functions used to encode LDAP attribute values.
308 The sequence of functions corresponds to the sequence of LDAP attribute syntax
309 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
310 RFC2252 section 4.3.2")
312 (defvar ldap-attribute-syntax-decoders
314 nil ; 2 Access Point Y
315 nil ; 3 Attribute Type Description Y
319 ldap-decode-boolean ; 7 Boolean Y
320 nil ; 8 Certificate N
321 nil ; 9 Certificate List N
322 nil ; 10 Certificate Pair N
323 ldap-decode-string ; 11 Country String Y
324 ldap-decode-string ; 12 DN Y
325 nil ; 13 Data Quality Syntax Y
326 nil ; 14 Delivery Method Y
327 ldap-decode-string ; 15 Directory String Y
328 nil ; 16 DIT Content Rule Description Y
329 nil ; 17 DIT Structure Rule Description Y
330 nil ; 18 DL Submit Permission Y
331 nil ; 19 DSA Quality Syntax Y
333 nil ; 21 Enhanced Guide Y
334 nil ; 22 Facsimile Telephone Number Y
336 nil ; 24 Generalized Time Y
338 nil ; 26 IA5 String Y
339 string-to-number ; 27 INTEGER Y
341 nil ; 29 Master And Shadow Access Points Y
342 nil ; 30 Matching Rule Description Y
343 nil ; 31 Matching Rule Use Description Y
344 nil ; 32 Mail Preference Y
345 nil ; 33 MHS OR Address Y
346 nil ; 34 Name And Optional UID Y
347 nil ; 35 Name Form Description Y
348 nil ; 36 Numeric String Y
349 nil ; 37 Object Class Description Y
351 nil ; 39 Other Mailbox Y
352 nil ; 40 Octet String Y
353 ldap-decode-address ; 41 Postal Address Y
354 nil ; 42 Protocol Information Y
355 nil ; 43 Presentation Address Y
356 ldap-decode-string ; 44 Printable String Y
357 nil ; 45 Subtree Specification Y
358 nil ; 46 Supplier Information Y
359 nil ; 47 Supplier Or Consumer Y
360 nil ; 48 Supplier And Consumer Y
361 nil ; 49 Supported Algorithm N
362 nil ; 50 Telephone Number Y
363 nil ; 51 Teletex Terminal Identifier Y
364 nil ; 52 Telex Number Y
366 nil ; 54 LDAP Syntax Description Y
367 nil ; 55 Modify Rights Y
368 nil ; 56 LDAP Schema Definition Y
369 nil ; 57 LDAP Schema Description Y
370 nil ; 58 Substring Assertion Y
372 "A vector of functions used to decode LDAP attribute values.
373 The sequence of functions corresponds to the sequence of LDAP attribute syntax
374 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
375 RFC2252 section 4.3.2")
377 (defvar ldap-attribute-syntaxes-alist
378 '((createtimestamp . 24)
379 (modifytimestamp . 24)
382 (subschemasubentry . 12)
386 (matchingruleuse . 31)
387 (namingcontexts . 12)
389 (supportedextension . 38)
390 (supportedcontrol . 38)
391 (supportedsaslmechanisms . 15)
392 (supportedldapversion . 27)
394 (ditstructurerules . 17)
396 (ditcontentrules . 16)
398 (aliasedobjectname . 12)
411 (businesscategory . 15)
415 (physicaldeliveryofficename . 15)
416 (telephonenumber . 50)
418 (telexterminalidentifier . 51)
419 (facsimiletelephonenumber . 22)
421 (internationalisdnnumber . 36)
422 (registeredaddress . 41)
423 (destinationindicator . 44)
424 (preferreddeliverymethod . 14)
425 (presentationaddress . 43)
426 (supportedapplicationcontext . 38)
432 (usercertificate . 8)
434 (authorityrevocationlist . 9)
435 (certificaterevocationlist . 9)
436 (crosscertificatepair . 10)
440 (generationqualifier . 15)
441 (x500uniqueidentifier . 6)
443 (enhancedsearchguide . 21)
444 (protocolinformation . 42)
445 (distinguishedname . 12)
447 (houseidentifier . 15)
448 (supportedalgorithms . 49)
449 (deltarevocationlist . 9)
451 "A map of LDAP attribute names to their type object id minor number.
452 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
454 ;;; LDAP primitive functions.
457 ;; (__ldap-object HOSTNAME PLIST)
459 (defun ldapp (object)
460 "Return t if OBJECT is a LDAP connection."
462 (eq (car object) '__ldap-object)))
464 (defun ldap-open (host &optional plist)
465 "Open a LDAP connection to HOST.
466 PLIST is a plist containing additional parameters for the connection.
467 Valid keys in that list are:
468 `port' the TCP port to use for the connection if different from
470 `auth' is the authentication method to use, possible values depend on
471 the LDAP library: `simple', `krbv41' and `krbv42'.
472 `binddn' is the distinguished name of the user to bind as
473 (in RFC 1779 syntax).
474 `passwd' is the password to use for simple authentication.
475 `deref' is one of the symbols `never', `always', `search' or `find'.
476 `timelimit' is the timeout limit for the connection in seconds.
477 `sizelimit' is the maximum number of matches to return."
478 (list '__ldap-object host plist))
480 (defun ldap-host (ldap)
481 "Return the server host of the connection LDAP, as a string."
484 (defun ldap-close (ldap)
485 "Close an LDAP connection."
488 (defun ldap-delete (ldap dn)
489 "Delete an entry to an LDAP directory.
490 LDAP is an LDAP connection object created with `ldap-open'.
491 DN is the distinguished name of the entry to delete."
492 (let* ((plist (or (nth 2 ldap)
493 (cdr (assoc (ldap-host ldap)
494 ldap-host-parameters-alist))))
495 (port (plist-get plist 'port))
496 (binddn (plist-get plist 'binddn))
497 (passwd (plist-get plist 'passwd))
499 (setq arglist (list (format "-h%s" (ldap-host ldap))))
500 (if (and port (not (equal 389 port)))
501 (setq arglist (nconc arglist (list (format "-p%d" port)))))
503 (not (equal "" binddn)))
504 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
506 (not (equal "" passwd)))
507 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
509 (setq ret (apply 'call-process
511 nil (current-buffer) t
515 (if (not (zerop ret))
516 (error (car (split-string (buffer-string) "\n"))))
517 (if (and (setq ret (buffer-string)); Nemacs
518 (string-match "ldap_delete:" ret))
519 (error (car (split-string ret "\n"))))))))
521 (defmacro ldap/ldif-insert-field (attr value)
522 (` (if (not (ldap/ldif-safe-string-p (, value)))
523 (insert (, attr) ":: " (base64-encode-string (, value)) "\n")
524 (insert (, attr) ": " (, value) "\n"))))
526 (defun ldap-modify (ldap dn mods)
527 "Add an entry to an LDAP directory.
528 LDAP is an LDAP connection object created with `ldap-open'.
529 DN is the distinguished name of the entry to modify.
530 MODS is a list of modifications to apply.
531 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
532 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
533 MOD-OP is the type of modification, one of the symbols `add', `delete'
534 or `replace'. ATTR is the LDAP attribute type to modify."
535 (let* ((plist (or (nth 2 ldap)
536 (cdr (assoc (ldap-host ldap)
537 ldap-host-parameters-alist))))
538 (port (plist-get plist 'port))
539 (binddn (plist-get plist 'binddn))
540 (passwd (plist-get plist 'passwd))
542 (setq arglist (list (format "-h%s" (ldap-host ldap))))
543 (if (and port (not (equal 389 port)))
544 (setq arglist (nconc arglist (list (format "-p%d" port)))))
546 (not (equal "" binddn)))
547 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
549 (not (equal "" passwd)))
550 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
552 (ldap/ldif-insert-field "dn" dn)
553 (insert "changetype: modify\n")
556 ((eq (nth 0 (car mods)) 'add)
557 (insert "add: " (nth 1 (car mods)) "\n")
558 (ldap/ldif-insert-field (nth 1 (car mods)) (nth 2 (car mods)))
560 ((eq (nth 0 (car mods)) 'delete)
561 (insert "delete: " (nth 1 (car mods)) "\n-\n"))
562 ((eq (nth 0 (car mods)) 'replace)
563 (insert "replace: " (nth 1 (car mods)) "\n")
564 (ldap/ldif-insert-field (nth 1 (car mods)) (nth 2 (car mods)))
566 (setq mods (cdr mods)))
567 (setq ret (apply 'call-process-region
568 (point-min) (point-max)
573 (if (not (zerop ret))
574 (error (car (split-string (buffer-string) "\n"))))
575 (if (and (setq ret (buffer-string)); Nemacs
576 (string-match "ldap_modify:" ret))
577 (error (car (split-string ret "\n"))))))))
579 (defun ldap-add (ldap dn entry)
580 "Add an entry to an LDAP directory.
581 LDAP is an LDAP connection object created with `ldap-open'.
582 DN is the distinguished name of the entry to add.
583 ENTRY is an entry specification, i.e., a list of cons cells
584 containing attribute/value string pairs."
585 (let* ((plist (or (nth 2 ldap)
586 (cdr (assoc (ldap-host ldap)
587 ldap-host-parameters-alist))))
588 (port (plist-get plist 'port))
589 (binddn (plist-get plist 'binddn))
590 (passwd (plist-get plist 'passwd))
592 (setq arglist (list (format "-h%s" (ldap-host ldap))))
593 (if (and port (not (equal 389 port)))
594 (setq arglist (nconc arglist (list (format "-p%d" port)))))
596 (not (equal "" binddn)))
597 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
599 (not (equal "" passwd)))
600 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
602 (set-buffer-multibyte nil)
603 (ldap/ldif-insert-field "dn" dn)
605 (ldap/ldif-insert-field (car (car entry)) (cdr (car entry)))
606 (setq entry (cdr entry)))
607 (setq ret (apply 'call-process-region
608 (point-min) (point-max)
613 (if (not (zerop ret))
614 (error (car (split-string (buffer-string) "\n"))))
615 (if (and (setq ret (buffer-string)) ; Nemacs
616 (string-match "ldap_add:" ret))
617 (error (car (split-string ret "\n"))))))))
619 (defun ldap-search-basic (ldap filter base scope
620 &optional attrs attrsonly withdn verbose)
621 "Perform a search on a LDAP server. (Use external program `ldapsearch')
622 FILTER is a filter string for the search as described in RFC 1558.
623 BASE is the distinguished name at which to start the search.
624 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
625 the scope of the search.
626 ATTRS is a list of strings indicating which attributes to retrieve
627 for each matching entry. If nil return all available attributes.
628 If ATTRSONLY is non-nil then only the attributes are retrieved, not
629 the associated values.
630 If WITHDN is non-nil each entry in the result will be prepended with
631 its distinguished name DN.
632 If VERBOSE is non-nil progress messages will be echoed.
633 The function returns a list of matching entries. Each entry is itself
634 an alist of attribute/value pairs optionally preceded by the DN of the
635 entry according to the value of WITHDN."
636 (let* ((plist (or (nth 2 ldap)
637 (cdr (assoc (ldap-host ldap)
638 ldap-host-parameters-alist))))
639 (port (plist-get plist 'port))
640 (base (or base (plist-get plist 'base) ldap-default-base))
641 (scope (or scope (plist-get plist 'scope)))
642 (binddn (plist-get plist 'binddn))
643 (passwd (plist-get plist 'passwd))
644 (deref (plist-get plist 'deref))
645 (timelimit (plist-get plist 'timelimit))
646 (sizelimit (plist-get plist 'sizelimit))
647 start value attrs-result
650 (setq arglist (list (format "-h%s" (ldap-host ldap))))
651 (if (and port (not (equal 389 port)))
652 (setq arglist (nconc arglist (list (format "-p%d" port)))))
654 (not (equal "" base)))
655 (setq arglist (nconc arglist (list (format "-b%s" base)))))
657 (not (equal "" scope)))
663 (cond ((eq scope 'onelevel) "one")
664 ((eq scope 'base) "base")
665 ((eq scope 'subtree) "sub")
667 (t (error "Invalid scope: %s" scope))))))))
669 (not (equal "" binddn)))
670 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
672 (not (equal "" passwd)))
673 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
675 (not (equal "" deref)))
676 (setq arglist (nconc arglist (list (format "-a%s" deref)))))
678 (not (equal "" timelimit)))
679 (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
681 (not (equal "" sizelimit)))
682 (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
684 (set-buffer-multibyte nil)
685 (setq ret (apply 'call-process
687 nil (current-buffer) t
689 ldap-search-program-arguments
692 (if (and (integerp ret)
694 ;; When openldap's `ldapsearch' exceeds response size limit,
695 ;; it's exit status becomes `4'.
697 (error "LDAP error: \"No such object\""))
698 (goto-char (point-min))
700 (while (and (not (eobp))
701 (re-search-forward "^$" nil t)) ; empty line is a delimiter.
703 (message "Parsing ldap results...%d" (setq i (+ i 1))))
706 (narrow-to-region start (point))
708 (setq attrs-result (delq
712 ;; dn is not an attribute.
713 (unless (string= attr "dn")
715 (ldap/field-body attr))
718 (nconc (list attr) value)))))
720 (setq attrs-result (ldap/collect-field "dn"))
722 (setq attrs-result (mapcar (lambda (x) (list (car x)))
728 (nconc (ldap/field-body "dn") attrs-result)
729 (ldap/field-body "dn"))
732 (if (not (eobp)) (forward-char 1))
733 (setq start (point)))
735 (message "Parsing ldap results...done"))
736 (delq nil (nreverse result)))))
738 (defun ldap/field-end ()
739 "Move to end of field and return this point."
740 (if (re-search-forward ldap-ldif-next-field-head-regexp nil t)
741 (goto-char (match-beginning 0))
742 (if (re-search-forward "^$" nil t)
743 (goto-char (1- (match-beginning 0)))
747 (defun ldap/field-body (name)
748 "Return field body list of NAME."
750 (goto-char (point-min))
751 (let ((case-fold-search t)
754 ;; search for the line which have name with options.
755 (while (re-search-forward (concat "^" name
756 "\\(;[a-zA-Z0-9-]+\\)?:[ \t]*") nil t)
758 (if (string-match "^:[ \t]*" (setq body
759 (buffer-substring-no-properties
762 (setq body (base64-decode-string (substring body (match-end 0)))))
763 (setq field-body (nconc field-body (list body))))
766 (defun ldap/collect-field (without)
767 "Collect fields without WITHOUT."
768 (goto-char (point-min))
769 (let ((regexp (concat "\\(" ldap-ldif-field-head-regexp "\\)[ \t]*"))
770 dest name name-option body entry)
771 (while (re-search-forward regexp nil t)
772 ;; name with options.
773 (setq name-option (split-string (downcase (buffer-substring-no-properties
777 ;; XXX options are discarded.
778 (setq name (car name-option))
779 (setq body (buffer-substring-no-properties
780 (match-end 0) (ldap/field-end)))
781 (if (string-match "^:[ \t]*" body)
782 (setq body (base64-decode-string (substring body (match-end 0)))))
783 (unless (string= name without)
784 (if (setq entry (assoc name dest))
785 (nconc entry (list body))
786 (setq dest (cons (list name body) dest)))))
789 ;;; Coding/decoding functions
791 (defun ldap-encode-boolean (bool)
792 "Encode BOOL to LDAP type."
797 (defun ldap-decode-boolean (str)
798 "Decode STR to elisp type."
800 ((string-equal str "TRUE")
802 ((string-equal str "FALSE")
805 (error "Wrong LDAP boolean string: %s" str))))
807 (defun ldap-encode-country-string (str)
808 "Encode STR to LDAP country string."
809 ;; We should do something useful here...
810 (if (not (= 2 (length str)))
811 (error "Invalid country string: %s" str)))
813 (defun ldap-decode-string (str)
815 (if (fboundp 'decode-coding-string)
816 (decode-coding-string str ldap-coding-system)))
818 (defun ldap-encode-string (str)
820 (if (fboundp 'encode-coding-string)
821 (encode-coding-string str ldap-coding-system)))
823 (defun ldap-decode-address (str)
824 "Decode LDAP address STR."
825 (mapconcat 'ldap-decode-string
826 (split-string str "\\$")
829 (defun ldap-encode-address (str)
830 "Encode address STR to LDAP type."
831 (mapconcat 'ldap-encode-string
832 (split-string str "\n")
835 ;;; LDAP protocol functions
837 (defun ldap-get-host-parameter (host parameter)
838 "Get HOST's PARAMETER in `ldap-host-parameters-alist'."
839 (plist-get (cdr (assoc host ldap-host-parameters-alist))
842 (defun ldap-encode-attribute (attr)
843 "Encode the attribute/value pair ATTR according to LDAP rules.
844 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
845 and the corresponding decoder is then retrieved from
846 `ldap-attribute-syntax-encoders' and applied on the value(s)."
847 (let* ((name (car attr))
849 (syntax-id (cdr (assq (intern (downcase name))
850 ldap-attribute-syntaxes-alist)))
853 (setq encoder (aref ldap-attribute-syntax-encoders
855 (setq encoder ldap-default-attribute-encoder))
857 (cons name (mapcar encoder values))
860 (defun ldap-decode-attribute (attr)
861 "Decode the attribute/value pair ATTR according to LDAP rules.
862 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
863 and the corresponding decoder is then retrieved from
864 `ldap-attribute-syntax-decoders' and applied on the value(s)."
866 (let* ((name (car attr))
868 (syntax-id (cdr (assq (intern (downcase name))
869 ldap-attribute-syntaxes-alist)))
872 (setq decoder (aref ldap-attribute-syntax-decoders
874 (setq decoder ldap-default-attribute-decoder))
876 (cons name (mapcar decoder values))
880 (defun ldap-search (arg1 &rest args)
881 "Perform an LDAP search.if ARG1 is LDAP object, invoke `ldap-search-basic'.
882 Otherwise, invoke `ldap-search-entries'. ARGS are passed to each function."
883 (apply (if (ldapp arg1)
885 'ldap-search-entries) arg1 args))
887 (make-obsolete 'ldap-search
888 "Use `ldap-search-entries' instead or
889 `ldap-search-basic' for the low-level search API.")
891 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
892 "Perform an LDAP search.
893 FILTER is the search filter in RFC1558 syntax, i.e., something that
894 looks like \"(cn=John Smith)\".
895 HOST is the LDAP host on which to perform the search.
896 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
897 If ATTRSONLY is non nil, the attributes will be retrieved without
898 the associated values.
899 If WITHDN is non-nil each entry in the result will be prepennded with
900 its distinguished name DN.
901 Additional search parameters can be specified through
902 `ldap-host-parameters-alist' which see.
903 The function returns a list of matching entries. Each entry is itself
904 an alist of attribute/value pairs optionally preceded by the DN of the
905 entry according to the value of WITHDN."
906 (interactive "sFilter:")
908 (setq host ldap-default-host)
909 (error "No LDAP host specified"))
910 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
914 (message "Opening LDAP connection to %s..." host))
915 (setq ldap (ldap-open host host-plist))
917 (message "Searching with LDAP on %s..." host))
918 (setq result (ldap-search ldap filter
919 (plist-get host-plist 'base)
920 (plist-get host-plist 'scope)
921 attributes attrsonly withdn
925 (set-buffer-multibyte nil)
926 (if ldap-ignore-attribute-codings
930 (mapcar 'ldap-decode-attribute record)))
933 (defun ldap-add-entries (entries &optional host binddn passwd)
934 "Add entries to an LDAP directory.
935 ENTRIES is a list of entry specifications of
936 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
937 DN is the distinguished name of an entry to add, the following
938 are cons cells containing attribute/value string pairs.
939 HOST is the LDAP host, defaulting to `ldap-default-host'
940 BINDDN is the DN to bind as to the server
941 PASSWD is the corresponding password"
943 (setq host ldap-default-host)
944 (error "No LDAP host specified"))
945 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
948 (if (or binddn passwd)
949 (setq host-plist (copy-seq host-plist)))
951 (setq host-plist (plist-put host-plist 'binddn binddn)))
953 (setq host-plist (plist-put host-plist 'passwd passwd)))
955 (message "Opening LDAP connection to %s..." host))
956 (setq ldap (ldap-open host host-plist))
958 (message "Adding LDAP entries..."))
959 (mapcar (lambda (thisentry)
963 (setq add-spec (ldap-encode-attribute
966 (cons (nth 0 add-spec)
969 (setq thisentry (ldap-encode-attribute thisentry))
970 (ldap-add ldap (car thisentry) (cdr thisentry))
972 (message "%d added" i))
977 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
978 "Modify entries of an LDAP directory.
979 ENTRY-MODS is a list of entry modifications of the form
980 \(DN MOD-SPEC1 MOD-SPEC2 ...\) where DN is the distinguished name of
981 the entry to modify, the following are modification specifications.
982 A modification specification is itself a list of the form
983 \(MOD-OP ATTR VALUE1 VALUE2 ...\) MOD-OP and ATTR are mandatory,
984 VALUEs are optional depending on MOD-OP.
985 MOD-OP is the type of modification, one of the symbols `add', `delete'
986 or `replace'. ATTR is the LDAP attribute type to modify.
987 HOST is the LDAP host, defaulting to `ldap-default-host'
988 BINDDN is the DN to bind as to the server
989 PASSWD is the corresponding password"
991 (setq host ldap-default-host)
992 (error "No LDAP host specified"))
993 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
996 (if (or binddn passwd)
997 (setq host-plist (copy-seq host-plist)))
999 (setq host-plist (plist-put host-plist 'binddn binddn)))
1001 (setq host-plist (plist-put host-plist 'passwd passwd)))
1003 (message "Opening LDAP connection to %s..." host))
1004 (setq ldap (ldap-open host host-plist))
1006 (message "Modifying LDAP entries..."))
1007 (mapcar (lambda (thisentry)
1011 (if (or (eq (car mod-spec) 'add)
1012 (eq (car mod-spec) 'replace))
1013 (append (list (nth 0 mod-spec))
1014 (ldap-encode-attribute
1017 (ldap-modify ldap (car thisentry) (cdr thisentry))
1019 (message "%d modified" i))
1024 (defun ldap-delete-entries (dn &optional host binddn passwd)
1025 "Delete an entry from an LDAP directory.
1026 DN is the distinguished name of an entry to delete or
1028 HOST is the LDAP host, defaulting to `ldap-default-host'
1029 BINDDN is the DN to bind as to the server
1030 PASSWD is the corresponding password."
1032 (setq host ldap-default-host)
1033 (error "No LDAP host specified"))
1034 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
1036 (if (or binddn passwd)
1037 (setq host-plist (copy-seq host-plist)))
1039 (setq host-plist (plist-put host-plist 'binddn binddn)))
1041 (setq host-plist (plist-put host-plist 'passwd passwd)))
1043 (message "Opening LDAP connection to %s..." host))
1044 (setq ldap (ldap-open host host-plist))
1048 (message "Deleting LDAP entries..."))
1051 (ldap-delete ldap thisdn)
1053 (message "%d deleted" i))
1057 (message "Deleting LDAP entry..."))
1058 (ldap-delete ldap dn))
1060 ;; end of ldap-static-if
1065 ;;; pldap.el ends here