Mercurial > hg > xemacs-beta

comparison lisp/ldap.el @ 400:a86b2b5e0111 r21-2-30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-30
author cvs
date Mon, 13 Aug 2007 11:14:34 +0200
parents 74fd4e045ea6
children 697ef44129c6
comparison
equal deleted inserted replaced
399:376370fb5946 400:a86b2b5e0111
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.7 $
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)
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-search (arg1 &rest args)
440 (defun ldap-search (filter &optional host attributes attrsonly withdn) 449 "Perform an LDAP search."
450 (apply (if (ldapp arg1)
451 'ldap-search-basic
452 'ldap-search-entries) arg1 args))
453
454 (make-obsolete 'ldap-search
455 "Use `ldap-search-entries' instead or
456 `ldap-search-basic' for the low-level search API.")
457
458 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
441 "Perform an LDAP search. 459 "Perform an LDAP search.
442 FILTER is the search filter in RFC1558 syntax, i.e., something that 460 FILTER is the search filter in RFC1558 syntax, i.e., something that
443 looks like \"(cn=John Smith)\". 461 looks like \"(cn=John Smith)\".
444 HOST is the LDAP host on which to perform the search. 462 HOST is the LDAP host on which to perform the search.
445 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. 463 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
457 (setq host ldap-default-host) 475 (setq host ldap-default-host)
458 (error "No LDAP host specified")) 476 (error "No LDAP host specified"))
459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) 477 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
460 ldap 478 ldap
461 result) 479 result)
462 (message "Opening LDAP connection to %s..." host) 480 (if ldap-verbose
481 (message "Opening LDAP connection to %s..." host))
463 (setq ldap (ldap-open host host-plist)) 482 (setq ldap (ldap-open host host-plist))
464 (message "Searching with LDAP on %s..." host) 483 (if ldap-verbose
465 (setq result (ldap-search-internal ldap filter 484 (message "Searching with LDAP on %s..." host))
466 (plist-get host-plist 'base) 485 (setq result (ldap-search ldap filter
467 (plist-get host-plist 'scope) 486 (plist-get host-plist 'base)
468 attributes attrsonly withdn)) 487 (plist-get host-plist 'scope)
488 attributes attrsonly withdn
489 ldap-verbose))
469 (ldap-close ldap) 490 (ldap-close ldap)
470 (if ldap-ignore-attribute-codings 491 (if ldap-ignore-attribute-codings
471 result 492 result
472 (mapcar (function 493 (mapcar (function
473 (lambda (record) 494 (lambda (record)
474 (mapcar 'ldap-decode-attribute record))) 495 (mapcar 'ldap-decode-attribute record)))
475 result)))) 496 result))))
476 497
498 (defun ldap-add-entries (entries &optional host binddn passwd)
499 "Add entries to an LDAP directory.
500 ENTRIES is a list of entry specifications of
501 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
502 DN is the distinguished name of an entry to add, the following
503 are cons cells containing attribute/value string pairs.
504 HOST is the LDAP host, defaulting to `ldap-default-host'
505 BINDDN is the DN to bind as to the server
506 PASSWD is the corresponding password"
507 (or host
508 (setq host ldap-default-host)
509 (error "No LDAP host specified"))
510 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
511 ldap
512 (i 1))
513 (if (or binddn passwd)
514 (setq host-plist (copy-seq host-plist)))
515 (if binddn
516 (setq host-plist (plist-put host-plist 'binddn binddn)))
517 (if passwd
518 (setq host-plist (plist-put host-plist 'passwd passwd)))
519 (if ldap-verbose
520 (message "Opening LDAP connection to %s..." host))
521 (setq ldap (ldap-open host host-plist))
522 (if ldap-verbose
523 (message "Adding LDAP entries..."))
524 (mapcar (function
525 (lambda (thisentry)
526 (ldap-add ldap (car thisentry) (cdr thisentry))
527 (if ldap-verbose
528 (message "%d added" i))
529 (setq i (1+ i))))
530 entries)
531 (ldap-close ldap)))
532
533
534 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
535 "Modify entries of an LDAP directory.
536 ENTRY_MODS is a list of entry modifications of the form
537 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
538 the entry to modify, the following are modification specifications.
539 A modification specification is itself a list of the form
540 (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
541 VALUEs are optional depending on MOD-OP.
542 MOD-OP is the type of modification, one of the symbols `add', `delete'
543 or `replace'. ATTR is the LDAP attribute type to modify.
544 HOST is the LDAP host, defaulting to `ldap-default-host'
545 BINDDN is the DN to bind as to the server
546 PASSWD is the corresponding password"
547 (or host
548 (setq host ldap-default-host)
549 (error "No LDAP host specified"))
550 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
551 ldap
552 (i 1))
553 (if (or binddn passwd)
554 (setq host-plist (copy-seq host-plist)))
555 (if binddn
556 (setq host-plist (plist-put host-plist 'binddn binddn)))
557 (if passwd
558 (setq host-plist (plist-put host-plist 'passwd passwd)))
559 (if ldap-verbose
560 (message "Opening LDAP connection to %s..." host))
561 (setq ldap (ldap-open host host-plist))
562 (if ldap-verbose
563 (message "Modifying LDAP entries..."))
564 (mapcar (function
565 (lambda (thisentry)
566 (ldap-modify ldap (car thisentry) (cdr thisentry))
567 (if ldap-verbose
568 (message "%d modified" i))
569 (setq i (1+ i))))
570 entry-mods)
571 (ldap-close ldap)))
572
573
574 (defun ldap-delete-entries (dn &optional host binddn passwd)
575 "Delete an entry from an LDAP directory.
576 DN is the distinguished name of an entry to delete or
577 a list of those.
578 HOST is the LDAP host, defaulting to `ldap-default-host'
579 BINDDN is the DN to bind as to the server
580 PASSWD is the corresponding password."
581 (or host
582 (setq host ldap-default-host)
583 (error "No LDAP host specified"))
584 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
585 ldap)
586 (if (or binddn passwd)
587 (setq host-plist (copy-seq host-plist)))
588 (if binddn
589 (setq host-plist (plist-put host-plist 'binddn binddn)))
590 (if passwd
591 (setq host-plist (plist-put host-plist 'passwd passwd)))
592 (if ldap-verbose
593 (message "Opening LDAP connection to %s..." host))
594 (setq ldap (ldap-open host host-plist))
595 (if (consp dn)
596 (let ((i 1))
597 (if ldap-verbose
598 (message "Deleting LDAP entries..."))
599 (mapcar (function
600 (lambda (thisdn)
601 (ldap-delete ldap thisdn)
602 (if ldap-verbose
603 (message "%d deleted" i))
604 (setq i (1+ i))))
605 dn))
606 (if ldap-verbose
607 (message "Deleting LDAP entry..."))
608 (ldap-delete ldap dn))
609 (ldap-close ldap)))
610
611
477 (provide 'ldap) 612 (provide 'ldap)
478 613
479 ;;; ldap.el ends here 614 ;;; ldap.el ends here