2004-02-12 10:48:37 -05:00
|
|
|
;;; ,open ldap-low ldap-types pp
|
|
|
|
|
|
|
|
|
|
(define (open-anonymous-ldap-v3-session host)
|
|
|
|
|
(let ((session (ldap-init host)))
|
2004-02-13 05:06:15 -05:00
|
|
|
(set-ldap-session-option! (ldap-session-option-value protocol-version) 3 session)
|
2004-02-12 10:48:37 -05:00
|
|
|
(ldap-simple-bind-as-nobody session)
|
|
|
|
|
session))
|
|
|
|
|
|
2004-02-13 05:06:15 -05:00
|
|
|
(define (get-value-alist entry)
|
|
|
|
|
(let ((attributes (ldap-all-attributes entry)))
|
2004-02-12 10:48:37 -05:00
|
|
|
(map (lambda (attribute)
|
|
|
|
|
(cons (string->symbol attribute)
|
2004-02-13 05:06:15 -05:00
|
|
|
(ldap-get-values entry attribute)))
|
2004-02-12 10:48:37 -05:00
|
|
|
attributes)))
|
|
|
|
|
|
|
|
|
|
(define (find-all-entries host root-dn)
|
2004-02-13 05:06:15 -05:00
|
|
|
(with-ldap-session
|
|
|
|
|
(open-anonymous-ldap-v3-session host)
|
|
|
|
|
(lambda ()
|
|
|
|
|
(let ((first-entry
|
|
|
|
|
(ldap-search
|
|
|
|
|
root-dn (ldap-scope-arguments onelevel)
|
|
|
|
|
"(objectClass=*)" ldap-attributes-all-user-attributes #f)))
|
|
|
|
|
(let lp ((entry (ldap-first-entry first-entry))
|
|
|
|
|
(res '()))
|
|
|
|
|
(if (not entry)
|
|
|
|
|
res
|
|
|
|
|
(lp (ldap-next-entry entry)
|
|
|
|
|
(cons (ldap-entry-dn entry)
|
|
|
|
|
(cons (get-value-alist entry) res)))))))))
|
|
|
|
|
|
