Mercurial > hg > xemacs-beta

comparison lisp/ldap.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 3ecd8885ac67
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
7 ;; Created: Jan 1998 7 ;; Created: Jan 1998
8 ;; Version: $Revision: 1.7.2.6 $ 8 ;; Version: $Revision: 1.7.2.8 $
9 ;; Keywords: help comm 9 ;; Keywords: help comm
10 10
11 ;; This file is part of XEmacs 11 ;; This file is part of XEmacs
12 12
13 ;; XEmacs is free software; you can redistribute it and/or modify it 13 ;; XEmacs is free software; you can redistribute it and/or modify it
32 ;;; Installation: 32 ;;; Installation:
33 ;; LDAP support must have been built into XEmacs. 33 ;; LDAP support must have been built into XEmacs.
34 34
35 35
36 ;;; Code: 36 ;;; Code:
37
38 (eval-when '(load)
39 (if (not (fboundp 'ldap-open))
40 (error "No LDAP support compiled in this XEmacs")))
37 41
38 (defgroup ldap nil 42 (defgroup ldap nil
39 "Lightweight Directory Access Protocol" 43 "Lightweight Directory Access Protocol"
40 :group 'comm) 44 :group 'comm)
41 45
142 :tag "Size Limit" 146 :tag "Size Limit"
143 :inline t 147 :inline t
144 (const :tag "Size Limit" sizelimit) 148 (const :tag "Size Limit" sizelimit)
145 (integer :tag "(number of records)"))))) 149 (integer :tag "(number of records)")))))
146 :group 'ldap) 150 :group 'ldap)
151
152 (defcustom ldap-verbose nil
153 "*If non-nil, LDAP operations echo progress messages."
154 :type 'boolean
155 :group 'ldap)
147 156
148 (defcustom ldap-ignore-attribute-codings nil 157 (defcustom ldap-ignore-attribute-codings nil
149 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values." 158 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
150 :type 'boolean 159 :type 'boolean
151 :group 'ldap) 160 :group 'ldap)
433 (1- syntax-id))) 442 (1- syntax-id)))
434 (setq decoder ldap-default-attribute-decoder)) 443 (setq decoder ldap-default-attribute-decoder))
435 (if decoder 444 (if decoder
436 (cons name (mapcar decoder values)) 445 (cons name (mapcar decoder values))
437 attr))) 446 attr)))
438 447
439 448 (defun ldap-decode-entry (entry)
440 (defun ldap-search (filter &optional host attributes attrsonly withdn) 449 "Decode the attributes of ENTRY according to LDAP rules."
450 (let (dn decoded)
451 (setq dn (car entry))
452 (if (stringp dn)
453 (setq entry (cdr entry))
454 (setq dn nil))
455 (setq decoded (mapcar 'ldap-decode-attribute entry))
456 (if dn
457 (cons dn decoded)
458 decoded)))
459
460 (defun ldap-search (arg1 &rest args)
461 "Perform an LDAP search."
462 (apply (if (ldapp arg1)
463 'ldap-search-basic
464 'ldap-search-entries) arg1 args))
465
466 (make-obsolete 'ldap-search
467 "Use `ldap-search-entries' instead or
468 `ldap-search-basic' for the low-level search API.")
469
470 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
441 "Perform an LDAP search. 471 "Perform an LDAP search.
442 FILTER is the search filter in RFC1558 syntax, i.e., something that 472 FILTER is the search filter in RFC1558 syntax, i.e., something that
443 looks like \"(cn=John Smith)\". 473 looks like \"(cn=John Smith)\".
444 HOST is the LDAP host on which to perform the search. 474 HOST is the LDAP host on which to perform the search.
445 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. 475 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
457 (setq host ldap-default-host) 487 (setq host ldap-default-host)
458 (error "No LDAP host specified")) 488 (error "No LDAP host specified"))
459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) 489 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
460 ldap 490 ldap
461 result) 491 result)
462 (message "Opening LDAP connection to %s..." host) 492 (if ldap-verbose
493 (message "Opening LDAP connection to %s..." host))
463 (setq ldap (ldap-open host host-plist)) 494 (setq ldap (ldap-open host host-plist))
464 (message "Searching with LDAP on %s..." host) 495 (if ldap-verbose
465 (setq result (ldap-search-internal ldap filter 496 (message "Searching with LDAP on %s..." host))
466 (plist-get host-plist 'base) 497 (setq result (ldap-search ldap filter
467 (plist-get host-plist 'scope) 498 (plist-get host-plist 'base)
468 attributes attrsonly withdn)) 499 (plist-get host-plist 'scope)
500 attributes attrsonly withdn
501 ldap-verbose))
469 (ldap-close ldap) 502 (ldap-close ldap)
470 (if ldap-ignore-attribute-codings 503 (if ldap-ignore-attribute-codings
471 result 504 result
472 (mapcar (function 505 (mapcar 'ldap-decode-entry result))))
473 (lambda (record) 506
474 (mapcar 'ldap-decode-attribute record))) 507 (defun ldap-add-entries (entries &optional host binddn passwd)
475 result)))) 508 "Add entries to an LDAP directory.
509 ENTRIES is a list of entry specifications of
510 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
511 DN is the distinguished name of an entry to add, the following
512 are cons cells containing attribute/value string pairs.
513 HOST is the LDAP host, defaulting to `ldap-default-host'
514 BINDDN is the DN to bind as to the server
515 PASSWD is the corresponding password"
516 (or host
517 (setq host ldap-default-host)
518 (error "No LDAP host specified"))
519 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
520 ldap
521 (i 1))
522 (if (or binddn passwd)
523 (setq host-plist (copy-seq host-plist)))
524 (if binddn
525 (setq host-plist (plist-put host-plist 'binddn binddn)))
526 (if passwd
527 (setq host-plist (plist-put host-plist 'passwd passwd)))
528 (if ldap-verbose
529 (message "Opening LDAP connection to %s..." host))
530 (setq ldap (ldap-open host host-plist))
531 (if ldap-verbose
532 (message "Adding LDAP entries..."))
533 (mapcar (function
534 (lambda (thisentry)
535 (ldap-add ldap (car thisentry) (cdr thisentry))
536 (if ldap-verbose
537 (message "%d added" i))
538 (setq i (1+ i))))
539 entries)
540 (ldap-close ldap)))
541
542
543 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
544 "Modify entries of an LDAP directory.
545 ENTRY_MODS is a list of entry modifications of the form
546 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
547 the entry to modify, the following are modification specifications.
548 A modification specification is itself a list of the form
549 (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
550 VALUEs are optional depending on MOD-OP.
551 MOD-OP is the type of modification, one of the symbols `add', `delete'
552 or `replace'. ATTR is the LDAP attribute type to modify.
553 HOST is the LDAP host, defaulting to `ldap-default-host'
554 BINDDN is the DN to bind as to the server
555 PASSWD is the corresponding password"
556 (or host
557 (setq host ldap-default-host)
558 (error "No LDAP host specified"))
559 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
560 ldap
561 (i 1))
562 (if (or binddn passwd)
563 (setq host-plist (copy-seq host-plist)))
564 (if binddn
565 (setq host-plist (plist-put host-plist 'binddn binddn)))
566 (if passwd
567 (setq host-plist (plist-put host-plist 'passwd passwd)))
568 (if ldap-verbose
569 (message "Opening LDAP connection to %s..." host))
570 (setq ldap (ldap-open host host-plist))
571 (if ldap-verbose
572 (message "Modifying LDAP entries..."))
573 (mapcar (function
574 (lambda (thisentry)
575 (ldap-modify ldap (car thisentry) (cdr thisentry))
576 (if ldap-verbose
577 (message "%d modified" i))
578 (setq i (1+ i))))
579 entry-mods)
580 (ldap-close ldap)))
581
582
583 (defun ldap-delete-entries (dn &optional host binddn passwd)
584 "Delete an entry from an LDAP directory.
585 DN is the distinguished name of an entry to delete or
586 a list of those.
587 HOST is the LDAP host, defaulting to `ldap-default-host'
588 BINDDN is the DN to bind as to the server
589 PASSWD is the corresponding password."
590 (or host
591 (setq host ldap-default-host)
592 (error "No LDAP host specified"))
593 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
594 ldap)
595 (if (or binddn passwd)
596 (setq host-plist (copy-seq host-plist)))
597 (if binddn
598 (setq host-plist (plist-put host-plist 'binddn binddn)))
599 (if passwd
600 (setq host-plist (plist-put host-plist 'passwd passwd)))
601 (if ldap-verbose
602 (message "Opening LDAP connection to %s..." host))
603 (setq ldap (ldap-open host host-plist))
604 (if (consp dn)
605 (let ((i 1))
606 (if ldap-verbose
607 (message "Deleting LDAP entries..."))
608 (mapcar (function
609 (lambda (thisdn)
610 (ldap-delete ldap thisdn)
611 (if ldap-verbose
612 (message "%d deleted" i))
613 (setq i (1+ i))))
614 dn))
615 (if ldap-verbose
616 (message "Deleting LDAP entry..."))
617 (ldap-delete ldap dn))
618 (ldap-close ldap)))
619
476 620
477 (provide 'ldap) 621 (provide 'ldap)
478 622
479 ;;; ldap.el ends here 623 ;;; ldap.el ends here