On Sun, Jun 23, 2002 at 07:16:23PM +0300, Kalle Olavi Niemitalo wrote:
>
> Is there a package for accessing an LDAP server with CMUCL?
> I could use either an FFI to the OpenLDAP libraries, or a
> standalone implementation of the protocol over TCP.
>
> I have set up a small LDAP server and the "ldapexplorer" WWW
> gateway. I don't like how it relies on cookies and JavaScript,
> so I'm considering fixing it, but I'd rather get more Lisp
> experience than learn PHP.
>
I'm not aware of any LDAP FFI or implementation, but here's the beginnings
of an UFFI interface attached. Though I'm starting to wonder whether it
wouldn't be more worthwhile to implement it directly after all.
BTW I don't guarentee this to work very well, but it should get you started..
--
; Matthew Danish <[EMAIL PROTECTED]>
; OpenPGP public key: C24B6010 on keyring.debian.org
; Signed or encrypted mail welcome.
; "There is no dark side of the moon really; matter of fact, it's all dark."
-- Attached file included as plaintext by Listar --
(require :UFFI)
(defpackage #:LDAP
(:use #:COMMON-LISP #:UFFI)
(:export #:INIT
#:RESULT
#:ABANDON
#:MSGFREE
#:BIND-S
#:SIMPLE-BIND-S
#:RESULT->ERROR
#:ERROR->STRING
#:ERR->STRING ; identical to above
#:COUNT-ENTRIES
#:FIRST-ENTRY
#:NEXT-ENTRY
#:GET-ENTRIES))
(in-package #:LDAP)
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((ldap-lib (find-foreign-library "libldap"
'("/lib/"
"/usr/lib/"
"/usr/local/lib/")
:types '("so.2" "so"))))
(when ldap-lib
(load-foreign-library ldap-lib
:module "ldap"
:supporting-libraries '("c")))))
(def-foreign-type ldap :pointer-void)
(def-foreign-type ldap-message :pointer-void)
(def-struct timeval
(tv_sec :long)
(tv_usec :long))
(def-struct ldap-error
(e_code :int)
(e_reason (* :unsigned-char)))
(def-function ("ldap_init" init)
((host (* :unsigned-char))
(port :int))
:returning ldap)
(def-function ("ldap_result" c-result)
((ld ldap)
(msgid :int)
(all :int)
(timeout (* timeval))
(result (* ldap-message)))
:returning :int)
(defun result (ld msgid all-p timeout &optional (milliseconds 0))
(let ((result (allocate-foreign-object 'ldap-message))
(tv-timeout (if timeout
(allocate-foreign-object 'timeval)
(make-null-pointer 'timeval))))
(when timeout
(setf (get-slot-value tv-timeout 'timeval 'tv_sec)
timeout)
(setf (get-slot-value tv-timeout 'timeval 'tv_usec)
milliseconds))
(let ((ret (c-result ld msgid (if all-p 1 0) tv-timeout result)))
(values ret (deref-pointer result 'ldap-message)))))
(def-function ("ldap_msgfree" msgfree)
((msg ldap-message))
:returning :int)
(def-function ("ldap_bind_s" bind-s)
((ld ldap)
(who (* :unsigned-char))
(cred (* :unsigned-char))
(method :int))
:returning :int)
(def-function ("ldap_simple_bind_s" simple-bind-s)
((ld ldap)
(who (* :unsigned-char))
(passwd (* :unsigned-char)))
:returning :int)
(def-function ("ldap_abandon" abandon)
((ld ldap)
(msgid :int))
:returning :int)
(def-function ("ldap_result2error" c-result->error)
((ld ldap)
(res ldap-message)
(freeit :int))
:returning :int)
(defun result->error (ld res &optional (freeit nil))
(c-result->error ld res (if freeit 1 0)))
(def-function ("ldap_err2string" c-error->string)
((err :int))
:returning (* :unsigned-char))
(defun error->string (err)
(let ((ret (c-error->string err)))
(convert-from-foreign-string ret)))
(defun err->string (err)
(error->string err))
(def-function ("ldap_count_entries" count-entries)
((ld ldap)
(result ldap-message))
:returning :int)
(def-function ("ldap_first_entry" first-entry)
((ld ldap)
(result ldap-message))
:returning ldap-message)
(def-function ("ldap_next_entry" next-entry)
((ld ldap)
(result ldap-message))
:returning ldap-message)
(defun get-entries (ld result)
(loop for res = (first-entry ld result)
then (next-entry ld res)
until (null-pointer-p res)
collect res))
