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 '("-L" "-B")
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 The `-B' switch should be used to enable the retrieval of
109 :type '(repeat :tag "`ldapsearch' Arguments"
110 (string :tag "Argument"))
113 (defcustom ldap-default-host nil
114 "*Default LDAP server hostname.
115 A TCP port number can be appended to that name using a colon as
117 :type '(choice (string :tag "Host name")
118 (const :tag "Use library default" nil))
121 (defcustom ldap-default-port nil
122 "*Default TCP port for LDAP connections.
123 Initialized from the LDAP library at build time. Default value is 389."
124 :type '(choice (const :tag "Use library default" nil)
125 (integer :tag "Port number"))
128 (defcustom ldap-default-base nil
129 "*Default base for LDAP searches.
130 This is a string using the syntax of RFC 1779.
131 For instance, \"o=ACME, c=US\" limits the search to the
132 Acme organization in the United States."
133 :type '(choice (const :tag "Use library default" nil)
134 (string :tag "Search base"))
137 (defcustom ldap-host-parameters-alist nil
138 "*Alist of host-specific options for LDAP transactions.
139 The format of each list element is:
140 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
141 HOST is the hostname of an LDAP server (with an optional TCP port number
142 appended to it using a colon as a separator).
143 PROPn and VALn are property/value pairs describing parameters for the server.
144 Valid properties include:
145 `binddn' is the distinguished name of the user to bind as
146 (in RFC 1779 syntax).
147 `passwd' is the password to use for simple authentication.
148 `auth' is the authentication method to use.
149 Possible values are: `simple', `krbv41' and `krbv42'.
150 `base' is the base for the search as described in RFC 1779.
151 `scope' is one of the three symbols `subtree', `base' or `onelevel'.
152 `deref' is one of the symbols `never', `always', `search' or `find'.
153 `timelimit' is the timeout limit for the connection in seconds.
154 `sizelimit' is the maximum number of matches to return."
155 :type '(repeat :menu-tag "Host parameters"
156 :tag "Host parameters"
157 (list :menu-tag "Host parameters"
158 :tag "Host parameters"
160 (string :tag "Host name")
166 (const :tag "Search Base" base)
171 (const :tag "Binding DN" binddn)
176 (const :tag "Password" passwd)
179 :tag "Authentication Method"
181 (const :tag "Authentication Method" auth)
183 (const :menu-tag "None" :tag "None" nil)
184 (const :menu-tag "Simple" :tag "Simple" simple)
185 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
186 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
190 (const :tag "Search Scope" scope)
192 (const :menu-tag "Default" :tag "Default" nil)
193 (const :menu-tag "Subtree" :tag "Subtree" subtree)
194 (const :menu-tag "Base" :tag "Base" base)
195 (const :menu-tag "One Level" :tag "One Level" onelevel)))
199 (const :tag "Dereferencing" deref)
201 (const :menu-tag "Default" :tag "Default" nil)
202 (const :menu-tag "Never" :tag "Never" never)
203 (const :menu-tag "Always" :tag "Always" always)
204 (const :menu-tag "When searching" :tag "When searching" search)
205 (const :menu-tag "When locating base" :tag "When locating base" find)))
209 (const :tag "Time Limit" timelimit)
210 (integer :tag "(in seconds)"))
214 (const :tag "Size Limit" sizelimit)
215 (integer :tag "(number of records)")))))
218 (defcustom ldap-verbose nil
219 "*If non-nil, LDAP operations echo progress messages."
223 (defcustom ldap-ignore-attribute-codings nil
224 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
228 (defcustom ldap-default-attribute-encoder nil
229 "*Encoder function to use for attributes whose syntax is unknown."
233 (defcustom ldap-default-attribute-decoder nil
234 "*Decoder function to use for attributes whose syntax is unknown."
238 (defcustom ldap-coding-system (if (boundp 'NEMACS) 0
240 "*Coding system of LDAP string values.
241 LDAP v3 specifies the coding system of strings to be UTF-8.
242 Mule support is needed for this."
246 (defvar ldap-attribute-syntax-encoders
248 nil ; 2 Access Point Y
249 nil ; 3 Attribute Type Description Y
253 ldap-encode-boolean ; 7 Boolean Y
254 nil ; 8 Certificate N
255 nil ; 9 Certificate List N
256 nil ; 10 Certificate Pair N
257 ldap-encode-country-string ; 11 Country String Y
258 ldap-encode-string ; 12 DN Y
259 nil ; 13 Data Quality Syntax Y
260 nil ; 14 Delivery Method Y
261 ldap-encode-string ; 15 Directory String Y
262 nil ; 16 DIT Content Rule Description Y
263 nil ; 17 DIT Structure Rule Description Y
264 nil ; 18 DL Submit Permission Y
265 nil ; 19 DSA Quality Syntax Y
267 nil ; 21 Enhanced Guide Y
268 nil ; 22 Facsimile Telephone Number Y
270 nil ; 24 Generalized Time Y
272 nil ; 26 IA5 String Y
273 number-to-string ; 27 INTEGER Y
275 nil ; 29 Master And Shadow Access Points Y
276 nil ; 30 Matching Rule Description Y
277 nil ; 31 Matching Rule Use Description Y
278 nil ; 32 Mail Preference Y
279 nil ; 33 MHS OR Address Y
280 nil ; 34 Name And Optional UID Y
281 nil ; 35 Name Form Description Y
282 nil ; 36 Numeric String Y
283 nil ; 37 Object Class Description Y
285 nil ; 39 Other Mailbox Y
286 nil ; 40 Octet String Y
287 ldap-encode-address ; 41 Postal Address Y
288 nil ; 42 Protocol Information Y
289 nil ; 43 Presentation Address Y
290 ldap-encode-string ; 44 Printable String Y
291 nil ; 45 Subtree Specification Y
292 nil ; 46 Supplier Information Y
293 nil ; 47 Supplier Or Consumer Y
294 nil ; 48 Supplier And Consumer Y
295 nil ; 49 Supported Algorithm N
296 nil ; 50 Telephone Number Y
297 nil ; 51 Teletex Terminal Identifier Y
298 nil ; 52 Telex Number Y
300 nil ; 54 LDAP Syntax Description Y
301 nil ; 55 Modify Rights Y
302 nil ; 56 LDAP Schema Definition Y
303 nil ; 57 LDAP Schema Description Y
304 nil ; 58 Substring Assertion Y
306 "A vector of functions used to encode LDAP attribute values.
307 The sequence of functions corresponds to the sequence of LDAP attribute syntax
308 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
309 RFC2252 section 4.3.2")
311 (defvar ldap-attribute-syntax-decoders
313 nil ; 2 Access Point Y
314 nil ; 3 Attribute Type Description Y
318 ldap-decode-boolean ; 7 Boolean Y
319 nil ; 8 Certificate N
320 nil ; 9 Certificate List N
321 nil ; 10 Certificate Pair N
322 ldap-decode-string ; 11 Country String Y
323 ldap-decode-string ; 12 DN Y
324 nil ; 13 Data Quality Syntax Y
325 nil ; 14 Delivery Method Y
326 ldap-decode-string ; 15 Directory String Y
327 nil ; 16 DIT Content Rule Description Y
328 nil ; 17 DIT Structure Rule Description Y
329 nil ; 18 DL Submit Permission Y
330 nil ; 19 DSA Quality Syntax Y
332 nil ; 21 Enhanced Guide Y
333 nil ; 22 Facsimile Telephone Number Y
335 nil ; 24 Generalized Time Y
337 nil ; 26 IA5 String Y
338 string-to-number ; 27 INTEGER Y
340 nil ; 29 Master And Shadow Access Points Y
341 nil ; 30 Matching Rule Description Y
342 nil ; 31 Matching Rule Use Description Y
343 nil ; 32 Mail Preference Y
344 nil ; 33 MHS OR Address Y
345 nil ; 34 Name And Optional UID Y
346 nil ; 35 Name Form Description Y
347 nil ; 36 Numeric String Y
348 nil ; 37 Object Class Description Y
350 nil ; 39 Other Mailbox Y
351 nil ; 40 Octet String Y
352 ldap-decode-address ; 41 Postal Address Y
353 nil ; 42 Protocol Information Y
354 nil ; 43 Presentation Address Y
355 ldap-decode-string ; 44 Printable String Y
356 nil ; 45 Subtree Specification Y
357 nil ; 46 Supplier Information Y
358 nil ; 47 Supplier Or Consumer Y
359 nil ; 48 Supplier And Consumer Y
360 nil ; 49 Supported Algorithm N
361 nil ; 50 Telephone Number Y
362 nil ; 51 Teletex Terminal Identifier Y
363 nil ; 52 Telex Number Y
365 nil ; 54 LDAP Syntax Description Y
366 nil ; 55 Modify Rights Y
367 nil ; 56 LDAP Schema Definition Y
368 nil ; 57 LDAP Schema Description Y
369 nil ; 58 Substring Assertion Y
371 "A vector of functions used to decode LDAP attribute values.
372 The sequence of functions corresponds to the sequence of LDAP attribute syntax
373 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
374 RFC2252 section 4.3.2")
376 (defvar ldap-attribute-syntaxes-alist
377 '((createtimestamp . 24)
378 (modifytimestamp . 24)
381 (subschemasubentry . 12)
385 (matchingruleuse . 31)
386 (namingcontexts . 12)
388 (supportedextension . 38)
389 (supportedcontrol . 38)
390 (supportedsaslmechanisms . 15)
391 (supportedldapversion . 27)
393 (ditstructurerules . 17)
395 (ditcontentrules . 16)
397 (aliasedobjectname . 12)
410 (businesscategory . 15)
414 (physicaldeliveryofficename . 15)
415 (telephonenumber . 50)
417 (telexterminalidentifier . 51)
418 (facsimiletelephonenumber . 22)
420 (internationalisdnnumber . 36)
421 (registeredaddress . 41)
422 (destinationindicator . 44)
423 (preferreddeliverymethod . 14)
424 (presentationaddress . 43)
425 (supportedapplicationcontext . 38)
431 (usercertificate . 8)
433 (authorityrevocationlist . 9)
434 (certificaterevocationlist . 9)
435 (crosscertificatepair . 10)
439 (generationqualifier . 15)
440 (x500uniqueidentifier . 6)
442 (enhancedsearchguide . 21)
443 (protocolinformation . 42)
444 (distinguishedname . 12)
446 (houseidentifier . 15)
447 (supportedalgorithms . 49)
448 (deltarevocationlist . 9)
450 "A map of LDAP attribute names to their type object id minor number.
451 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
453 ;;; LDAP primitive functions.
456 ;; (__ldap-object HOSTNAME PLIST)
458 (defun ldapp (object)
459 "Return t if OBJECT is a LDAP connection."
461 (eq (car object) '__ldap-object)))
463 (defun ldap-open (host &optional plist)
464 "Open a LDAP connection to HOST.
465 PLIST is a plist containing additional parameters for the connection.
466 Valid keys in that list are:
467 `port' the TCP port to use for the connection if different from
469 `auth' is the authentication method to use, possible values depend on
470 the LDAP library: `simple', `krbv41' and `krbv42'.
471 `binddn' is the distinguished name of the user to bind as
472 (in RFC 1779 syntax).
473 `passwd' is the password to use for simple authentication.
474 `deref' is one of the symbols `never', `always', `search' or `find'.
475 `timelimit' is the timeout limit for the connection in seconds.
476 `sizelimit' is the maximum number of matches to return."
477 (list '__ldap-object host plist))
479 (defun ldap-host (ldap)
480 "Return the server host of the connection LDAP, as a string."
483 (defun ldap-close (ldap)
484 "Close an LDAP connection."
487 (defun ldap-delete (ldap dn)
488 "Delete an entry to an LDAP directory.
489 LDAP is an LDAP connection object created with `ldap-open'.
490 DN is the distinguished name of the entry to delete."
491 (let* ((plist (or (nth 2 ldap)
492 (cdr (assoc (ldap-host ldap)
493 ldap-host-parameters-alist))))
494 (port (plist-get plist 'port))
495 (binddn (plist-get plist 'binddn))
496 (passwd (plist-get plist 'passwd))
498 (setq arglist (list (format "-h%s" (ldap-host ldap))))
499 (if (and port (not (equal 389 port)))
500 (setq arglist (nconc arglist (list (format "-p%d" port)))))
502 (not (equal "" binddn)))
503 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
505 (not (equal "" passwd)))
506 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
508 (setq ret (apply 'call-process
510 nil (current-buffer) t
514 (if (not (zerop ret))
515 (error (car (split-string (buffer-string) "\n"))))
516 (if (and (setq ret (buffer-string)); Nemacs
517 (string-match "ldap_delete:" ret))
518 (error (car (split-string ret "\n"))))))))
520 (defmacro ldap/ldif-insert-field (attr value)
521 (` (if (not (ldap/ldif-safe-string-p (, value)))
522 (insert (, attr) ":: " (base64-encode-string (, value)) "\n")
523 (insert (, attr) ": " (, value) "\n"))))
525 (defun ldap-modify (ldap dn mods)
526 "Add an entry to an LDAP directory.
527 LDAP is an LDAP connection object created with `ldap-open'.
528 DN is the distinguished name of the entry to modify.
529 MODS is a list of modifications to apply.
530 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
531 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
532 MOD-OP is the type of modification, one of the symbols `add', `delete'
533 or `replace'. ATTR is the LDAP attribute type to modify."
534 (let* ((plist (or (nth 2 ldap)
535 (cdr (assoc (ldap-host ldap)
536 ldap-host-parameters-alist))))
537 (port (plist-get plist 'port))
538 (binddn (plist-get plist 'binddn))
539 (passwd (plist-get plist 'passwd))
541 (setq arglist (list (format "-h%s" (ldap-host ldap))))
542 (if (and port (not (equal 389 port)))
543 (setq arglist (nconc arglist (list (format "-p%d" port)))))
545 (not (equal "" binddn)))
546 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
548 (not (equal "" passwd)))
549 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
551 (ldap/ldif-insert-field "dn" dn)
552 (insert "changetype: modify\n")
555 ((eq (nth 0 (car mods)) 'add)
556 (insert "add: " (nth 1 (car mods)) "\n")
557 (ldap/ldif-insert-field (nth 1 (car mods)) (nth 2 (car mods)))
559 ((eq (nth 0 (car mods)) 'delete)
560 (insert "delete: " (nth 1 (car mods)) "\n-\n"))
561 ((eq (nth 0 (car mods)) 'replace)
562 (insert "replace: " (nth 1 (car mods)) "\n")
563 (ldap/ldif-insert-field (nth 1 (car mods)) (nth 2 (car mods)))
565 (setq mods (cdr mods)))
566 (setq ret (apply 'call-process-region
567 (point-min) (point-max)
572 (if (not (zerop ret))
573 (error (car (split-string (buffer-string) "\n"))))
574 (if (and (setq ret (buffer-string)); Nemacs
575 (string-match "ldap_modify:" ret))
576 (error (car (split-string ret "\n"))))))))
578 (defun ldap-add (ldap dn entry)
579 "Add an entry to an LDAP directory.
580 LDAP is an LDAP connection object created with `ldap-open'.
581 DN is the distinguished name of the entry to add.
582 ENTRY is an entry specification, i.e., a list of cons cells
583 containing attribute/value string pairs."
584 (let* ((plist (or (nth 2 ldap)
585 (cdr (assoc (ldap-host ldap)
586 ldap-host-parameters-alist))))
587 (port (plist-get plist 'port))
588 (binddn (plist-get plist 'binddn))
589 (passwd (plist-get plist 'passwd))
591 (setq arglist (list (format "-h%s" (ldap-host ldap))))
592 (if (and port (not (equal 389 port)))
593 (setq arglist (nconc arglist (list (format "-p%d" port)))))
595 (not (equal "" binddn)))
596 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
598 (not (equal "" passwd)))
599 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
601 (set-buffer-multibyte nil)
602 (ldap/ldif-insert-field "dn" dn)
604 (ldap/ldif-insert-field (car (car entry)) (cdr (car entry)))
605 (setq entry (cdr entry)))
606 (setq ret (apply 'call-process-region
607 (point-min) (point-max)
612 (if (not (zerop ret))
613 (error (car (split-string (buffer-string) "\n"))))
614 (if (and (setq ret (buffer-string)) ; Nemacs
615 (string-match "ldap_add:" ret))
616 (error (car (split-string ret "\n"))))))))
618 (defun ldap-search-basic (ldap filter base scope
619 &optional attrs attrsonly withdn verbose)
620 "Perform a search on a LDAP server. (Use external program `ldapsearch')
621 FILTER is a filter string for the search as described in RFC 1558.
622 BASE is the distinguished name at which to start the search.
623 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
624 the scope of the search.
625 ATTRS is a list of strings indicating which attributes to retrieve
626 for each matching entry. If nil return all available attributes.
627 If ATTRSONLY is non-nil then only the attributes are retrieved, not
628 the associated values.
629 If WITHDN is non-nil each entry in the result will be prepended with
630 its distinguished name DN.
631 If VERBOSE is non-nil progress messages will be echoed.
632 The function returns a list of matching entries. Each entry is itself
633 an alist of attribute/value pairs optionally preceded by the DN of the
634 entry according to the value of WITHDN."
635 (let* ((plist (or (nth 2 ldap)
636 (cdr (assoc (ldap-host ldap)
637 ldap-host-parameters-alist))))
638 (port (plist-get plist 'port))
639 (base (or base (plist-get plist 'base) ldap-default-base))
640 (scope (or scope (plist-get plist 'scope)))
641 (binddn (plist-get plist 'binddn))
642 (passwd (plist-get plist 'passwd))
643 (deref (plist-get plist 'deref))
644 (timelimit (plist-get plist 'timelimit))
645 (sizelimit (plist-get plist 'sizelimit))
646 start value attrs-result
649 (setq arglist (list (format "-h%s" (ldap-host ldap))))
650 (if (and port (not (equal 389 port)))
651 (setq arglist (nconc arglist (list (format "-p%d" port)))))
653 (not (equal "" base)))
654 (setq arglist (nconc arglist (list (format "-b%s" base)))))
656 (not (equal "" scope)))
662 (cond ((eq scope 'onelevel) "one")
663 ((eq scope 'base) "base")
664 ((eq scope 'subtree) "sub")
666 (t (error "Invalid scope: %s" scope))))))))
668 (not (equal "" binddn)))
669 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
671 (not (equal "" passwd)))
672 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
674 (not (equal "" deref)))
675 (setq arglist (nconc arglist (list (format "-a%s" deref)))))
677 (not (equal "" timelimit)))
678 (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
680 (not (equal "" sizelimit)))
681 (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
683 (set-buffer-multibyte nil)
684 (setq ret (apply 'call-process
686 nil (current-buffer) t
688 ldap-search-program-arguments
691 (if (and (integerp ret)
693 (error "LDAP error: \"No such object\""))
694 (goto-char (point-min))
696 (while (and (not (eobp))
697 (re-search-forward "^$" nil t)) ; empty line is a delimiter.
699 (message "Parsing ldap results...%d" (setq i (+ i 1))))
702 (narrow-to-region start (point))
704 (setq attrs-result (delq
708 ;; dn is not an attribute.
709 (unless (string= attr "dn")
711 (ldap/field-body attr))
714 (nconc (list attr) value)))))
716 (setq attrs-result (ldap/collect-field "dn"))
718 (setq attrs-result (mapcar (lambda (x) (list (car x)))
724 (nconc (ldap/field-body "dn") attrs-result)
725 (ldap/field-body "dn"))
728 (if (not (eobp)) (forward-char 1))
729 (setq start (point)))
731 (message "Parsing ldap results...done"))
732 (delq nil (nreverse result)))))
734 (defun ldap/field-end ()
735 "Move to end of field and return this point."
736 (if (re-search-forward ldap-ldif-next-field-head-regexp nil t)
737 (goto-char (match-beginning 0))
738 (if (re-search-forward "^$" nil t)
739 (goto-char (1- (match-beginning 0)))
743 (defun ldap/field-body (name)
744 "Return field body list of NAME."
746 (goto-char (point-min))
747 (let ((case-fold-search t)
750 (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
752 (if (string-match "^:[ \t]*" (setq body
753 (buffer-substring-no-properties
756 (setq body (base64-decode-string (substring body (match-end 0)))))
757 (setq field-body (nconc field-body (list body))))
760 (defun ldap/collect-field (without)
761 "Collect fields without WITHOUT."
762 (goto-char (point-min))
763 (let ((regexp (concat "\\(" ldap-ldif-field-head-regexp "\\)[ \t]*"))
764 dest name body entry)
765 (while (re-search-forward regexp nil t)
766 (setq name (downcase (buffer-substring-no-properties
767 (match-beginning 1)(1- (match-end 1)))))
768 (setq body (buffer-substring-no-properties
769 (match-end 0) (ldap/field-end)))
770 (if (string-match "^:[ \t]*" body)
771 (setq body (base64-decode-string (substring body (match-end 0)))))
772 (unless (string= name without)
773 (if (setq entry (assoc name dest))
774 (nconc entry (list body))
775 (setq dest (cons (list name body) dest)))))
778 ;;; Coding/decoding functions
780 (defun ldap-encode-boolean (bool)
781 "Encode BOOL to LDAP type."
786 (defun ldap-decode-boolean (str)
787 "Decode STR to elisp type."
789 ((string-equal str "TRUE")
791 ((string-equal str "FALSE")
794 (error "Wrong LDAP boolean string: %s" str))))
796 (defun ldap-encode-country-string (str)
797 "Encode STR to LDAP country string."
798 ;; We should do something useful here...
799 (if (not (= 2 (length str)))
800 (error "Invalid country string: %s" str)))
802 (defun ldap-decode-string (str)
804 (if (fboundp 'decode-coding-string)
805 (decode-coding-string str ldap-coding-system)))
807 (defun ldap-encode-string (str)
809 (if (fboundp 'encode-coding-string)
810 (encode-coding-string str ldap-coding-system)))
812 (defun ldap-decode-address (str)
813 "Decode LDAP address STR."
814 (mapconcat 'ldap-decode-string
815 (split-string str "\\$")
818 (defun ldap-encode-address (str)
819 "Encode address STR to LDAP type."
820 (mapconcat 'ldap-encode-string
821 (split-string str "\n")
824 ;;; LDAP protocol functions
826 (defun ldap-get-host-parameter (host parameter)
827 "Get HOST's PARAMETER in `ldap-host-parameters-alist'."
828 (plist-get (cdr (assoc host ldap-host-parameters-alist))
831 (defun ldap-encode-attribute (attr)
832 "Encode the attribute/value pair ATTR according to LDAP rules.
833 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
834 and the corresponding decoder is then retrieved from
835 `ldap-attribute-syntax-encoders' and applied on the value(s)."
836 (let* ((name (car attr))
838 (syntax-id (cdr (assq (intern (downcase name))
839 ldap-attribute-syntaxes-alist)))
842 (setq encoder (aref ldap-attribute-syntax-encoders
844 (setq encoder ldap-default-attribute-encoder))
846 (cons name (mapcar encoder values))
849 (defun ldap-decode-attribute (attr)
850 "Decode the attribute/value pair ATTR according to LDAP rules.
851 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
852 and the corresponding decoder is then retrieved from
853 `ldap-attribute-syntax-decoders' and applied on the value(s)."
855 (let* ((name (car attr))
857 (syntax-id (cdr (assq (intern (downcase name))
858 ldap-attribute-syntaxes-alist)))
861 (setq decoder (aref ldap-attribute-syntax-decoders
863 (setq decoder ldap-default-attribute-decoder))
865 (cons name (mapcar decoder values))
869 (defun ldap-search (arg1 &rest args)
870 "Perform an LDAP search.if ARG1 is LDAP object, invoke `ldap-search-basic'.
871 Otherwise, invoke `ldap-search-entries'. ARGS are passed to each function."
872 (apply (if (ldapp arg1)
874 'ldap-search-entries) arg1 args))
876 (make-obsolete 'ldap-search
877 "Use `ldap-search-entries' instead or
878 `ldap-search-basic' for the low-level search API.")
880 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
881 "Perform an LDAP search.
882 FILTER is the search filter in RFC1558 syntax, i.e., something that
883 looks like \"(cn=John Smith)\".
884 HOST is the LDAP host on which to perform the search.
885 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
886 If ATTRSONLY is non nil, the attributes will be retrieved without
887 the associated values.
888 If WITHDN is non-nil each entry in the result will be prepennded with
889 its distinguished name DN.
890 Additional search parameters can be specified through
891 `ldap-host-parameters-alist' which see.
892 The function returns a list of matching entries. Each entry is itself
893 an alist of attribute/value pairs optionally preceded by the DN of the
894 entry according to the value of WITHDN."
895 (interactive "sFilter:")
897 (setq host ldap-default-host)
898 (error "No LDAP host specified"))
899 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
903 (message "Opening LDAP connection to %s..." host))
904 (setq ldap (ldap-open host host-plist))
906 (message "Searching with LDAP on %s..." host))
907 (setq result (ldap-search ldap filter
908 (plist-get host-plist 'base)
909 (plist-get host-plist 'scope)
910 attributes attrsonly withdn
914 (set-buffer-multibyte nil)
915 (if ldap-ignore-attribute-codings
919 (mapcar 'ldap-decode-attribute record)))
922 (defun ldap-add-entries (entries &optional host binddn passwd)
923 "Add entries to an LDAP directory.
924 ENTRIES is a list of entry specifications of
925 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
926 DN is the distinguished name of an entry to add, the following
927 are cons cells containing attribute/value string pairs.
928 HOST is the LDAP host, defaulting to `ldap-default-host'
929 BINDDN is the DN to bind as to the server
930 PASSWD is the corresponding password"
932 (setq host ldap-default-host)
933 (error "No LDAP host specified"))
934 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
937 (if (or binddn passwd)
938 (setq host-plist (copy-seq host-plist)))
940 (setq host-plist (plist-put host-plist 'binddn binddn)))
942 (setq host-plist (plist-put host-plist 'passwd passwd)))
944 (message "Opening LDAP connection to %s..." host))
945 (setq ldap (ldap-open host host-plist))
947 (message "Adding LDAP entries..."))
948 (mapcar (lambda (thisentry)
952 (setq add-spec (ldap-encode-attribute
955 (cons (nth 0 add-spec)
958 (setq thisentry (ldap-encode-attribute thisentry))
959 (ldap-add ldap (car thisentry) (cdr thisentry))
961 (message "%d added" i))
966 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
967 "Modify entries of an LDAP directory.
968 ENTRY-MODS is a list of entry modifications of the form
969 \(DN MOD-SPEC1 MOD-SPEC2 ...\) where DN is the distinguished name of
970 the entry to modify, the following are modification specifications.
971 A modification specification is itself a list of the form
972 \(MOD-OP ATTR VALUE1 VALUE2 ...\) MOD-OP and ATTR are mandatory,
973 VALUEs are optional depending on MOD-OP.
974 MOD-OP is the type of modification, one of the symbols `add', `delete'
975 or `replace'. ATTR is the LDAP attribute type to modify.
976 HOST is the LDAP host, defaulting to `ldap-default-host'
977 BINDDN is the DN to bind as to the server
978 PASSWD is the corresponding password"
980 (setq host ldap-default-host)
981 (error "No LDAP host specified"))
982 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
985 (if (or binddn passwd)
986 (setq host-plist (copy-seq host-plist)))
988 (setq host-plist (plist-put host-plist 'binddn binddn)))
990 (setq host-plist (plist-put host-plist 'passwd passwd)))
992 (message "Opening LDAP connection to %s..." host))
993 (setq ldap (ldap-open host host-plist))
995 (message "Modifying LDAP entries..."))
996 (mapcar (lambda (thisentry)
1000 (if (or (eq (car mod-spec) 'add)
1001 (eq (car mod-spec) 'replace))
1002 (append (list (nth 0 mod-spec))
1003 (ldap-encode-attribute
1006 (ldap-modify ldap (car thisentry) (cdr thisentry))
1008 (message "%d modified" i))
1013 (defun ldap-delete-entries (dn &optional host binddn passwd)
1014 "Delete an entry from an LDAP directory.
1015 DN is the distinguished name of an entry to delete or
1017 HOST is the LDAP host, defaulting to `ldap-default-host'
1018 BINDDN is the DN to bind as to the server
1019 PASSWD is the corresponding password."
1021 (setq host ldap-default-host)
1022 (error "No LDAP host specified"))
1023 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
1025 (if (or binddn passwd)
1026 (setq host-plist (copy-seq host-plist)))
1028 (setq host-plist (plist-put host-plist 'binddn binddn)))
1030 (setq host-plist (plist-put host-plist 'passwd passwd)))
1032 (message "Opening LDAP connection to %s..." host))
1033 (setq ldap (ldap-open host host-plist))
1037 (message "Deleting LDAP entries..."))
1040 (ldap-delete ldap thisdn)
1042 (message "%d deleted" i))
1046 (message "Deleting LDAP entry..."))
1047 (ldap-delete ldap dn))
1049 ;; end of ldap-static-if
1054 ;;; pldap.el ends here