unmaintained: New home for misfit Factor vocabularies.

[factor-unmaintained.git] / ldap / ldap.factor

diff --git a/ldap/ldap.factor b/ldap/ldap.factor
new file mode 100644 (file)
index 0000000..2ada976
--- /dev/null
+++ b/ldap/ldap.factor
@@ -0,0 +1,133 @@
+! Copyright (C) 2007 Elie CHAFTARI
+! See http://factorcode.org/license.txt for BSD license.
+!
+! Tested with OpenLDAP 2.2.7.0.21 on Mac OS X 10.4.9 PowerPC
+
+USING: alien alien.c-types assocs continuations hashtables io kernel
+ldap.libldap math namespaces sequences ;
+
+IN: ldap
+
+SYMBOL: message
+SYMBOL: ldp
+
+! =========================================================
+! Error interpretation routines
+! =========================================================
+
+: result-to-error ( ld res freeit -- num )
+    ldap_result2error ;
+
+: err-to-string ( err -- str )
+    ldap_err2string ;
+
+: check-result ( result -- )
+    dup zero? [ drop ] [
+        err-to-string throw
+    ] if ;
+
+: result-type ( result -- )
+    result-types >hashtable at print ;
+
+! =========================================================
+! Initialization routines
+! =========================================================
+
+! deprecated in favor of ldap_initialize
+: open ( host port -- ld )
+    ldap_open ;
+
+! deprecated in favor of ldap_initialize
+: init ( host port -- ld )
+    ldap_init ;
+
+: initialize ( ld url -- )
+    dupd ldap_initialize swap *void* ldp set check-result ;
+
+: get-option ( ld option outvalue -- )
+    ldap_get_option check-result ;
+
+: set-option ( ld option invalue -- )
+    ldap_set_option check-result ;
+
+! =========================================================
+! Bind operations
+! =========================================================
+
+: simple-bind ( ld who passwd -- id )
+    ldap_simple_bind ;
+
+: simple-bind-s ( ld who passwd -- )
+    ldap_simple_bind_s check-result ;
+
+: unbind-s ( ld -- )
+    ldap_unbind_s check-result ;
+
+: with-bind ( ld who passwd quot -- )
+    -roll [ simple-bind-s [ ldp get unbind-s ] [ ] cleanup ] with-scope ; inline
+
+! =========================================================
+! Search operations
+! =========================================================
+
+: search ( ld base scope filter attrs attrsonly -- id )
+    ldap_search ;
+
+: search-s ( ld base scope filter attrs attrsonly res -- )
+    ldap_search_s check-result ;
+
+! =========================================================
+! Return results of asynchronous operation routines
+! =========================================================
+
+: result ( ld msgid all timeout result -- )
+    [ ldap_result ] keep *void* message set result-type ;
+
+: parse-result ( ld result errcodep matcheddnp errmsgp referralsp serverctrlsp freeit -- )
+    ldap_parse_result check-result ;
+
+: count-messages ( ld result -- count )
+    ldap_count_messages ;
+
+: first-message ( ld result -- message )
+    ldap_first_message ;
+
+: next-message ( ld message -- message )
+    ldap_next_message ;
+
+: msgtype ( msg -- num )
+    ldap_msgtype ;
+
+: msgid ( msg -- num )
+    ldap_msgid ;
+
+: count-entries ( ld result -- count )
+    ldap_count_entries ;
+
+: first-entry ( ld result -- entry )
+    ldap_first_entry ;
+
+: next-entry ( ld entry -- entry )
+    ldap_next_entry ;
+
+: first-attribute ( ld entry berptr -- str )
+    ldap_first_attribute ;
+
+: next-attribute ( ld entry ber -- str )
+    ldap_next_attribute ;
+
+: get-values ( ld entry attr -- values )
+    ldap_get_values ;
+
+: get-dn ( ld entry -- str )
+    ldap_get_dn ;
+
+! =========================================================
+! Public routines
+! =========================================================
+
+: get-message ( -- message )
+    message get ;
+
+: get-ldp ( -- ldp )
+    ldp get ;