unmaintained/ldap/ldap.factor

   1 ! Copyright (C) 2007 Elie CHAFTARI
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 ! Tested with OpenLDAP 2.2.7.0.21 on Mac OS X 10.4.9 PowerPC
   5
   6 USING: alien alien.c-types assocs continuations hashtables io kernel
   7 ldap.libldap math namespaces sequences ;
   8
   9 IN: ldap
  10
  11 SYMBOL: message
  12 SYMBOL: ldp
  13
  14 ! =========================================================
  15 ! Error interpretation routines
  16 ! =========================================================
  17
  18 : result-to-error ( ld res freeit -- num )
  19     ldap_result2error ;
  20
  21 : err-to-string ( err -- str )
  22     ldap_err2string ;
  23
  24 : check-result ( result -- )
  25     dup zero? [ drop ] [
  26         err-to-string throw
  27     ] if ;
  28
  29 : result-type ( result -- )
  30     result-types >hashtable at print ;
  31
  32 ! =========================================================
  33 ! Initialization routines
  34 ! =========================================================
  35
  36 ! deprecated in favor of ldap_initialize
  37 : open ( host port -- ld )
  38     ldap_open ;
  39
  40 ! deprecated in favor of ldap_initialize
  41 : init ( host port -- ld )
  42     ldap_init ;
  43
  44 : initialize ( ld url -- )
  45     dupd ldap_initialize swap *void* ldp set check-result ;
  46
  47 : get-option ( ld option outvalue -- )
  48     ldap_get_option check-result ;
  49
  50 : set-option ( ld option invalue -- )
  51     ldap_set_option check-result ;
  52
  53 ! =========================================================
  54 ! Bind operations
  55 ! =========================================================
  56
  57 : simple-bind ( ld who passwd -- id )
  58     ldap_simple_bind ;
  59
  60 : simple-bind-s ( ld who passwd -- )
  61     ldap_simple_bind_s check-result ;
  62
  63 : unbind-s ( ld -- )
  64     ldap_unbind_s check-result ;
  65
  66 : with-bind ( ld who passwd quot -- )
  67     -roll [ simple-bind-s [ ldp get unbind-s ] [ ] cleanup ] with-scope ; inline
  68
  69 ! =========================================================
  70 ! Search operations
  71 ! =========================================================
  72
  73 : search ( ld base scope filter attrs attrsonly -- id )
  74     ldap_search ;
  75
  76 : search-s ( ld base scope filter attrs attrsonly res -- )
  77     ldap_search_s check-result ;
  78
  79 ! =========================================================
  80 ! Return results of asynchronous operation routines
  81 ! =========================================================
  82
  83 : result ( ld msgid all timeout result -- )
  84     [ ldap_result ] keep *void* message set result-type ;
  85
  86 : parse-result ( ld result errcodep matcheddnp errmsgp referralsp serverctrlsp freeit -- )
  87     ldap_parse_result check-result ;
  88
  89 : count-messages ( ld result -- count )
  90     ldap_count_messages ;
  91
  92 : first-message ( ld result -- message )
  93     ldap_first_message ;
  94
  95 : next-message ( ld message -- message )
  96     ldap_next_message ;
  97
  98 : msgtype ( msg -- num )
  99     ldap_msgtype ;
 100
 101 : msgid ( msg -- num )
 102     ldap_msgid ;
 103
 104 : count-entries ( ld result -- count )
 105     ldap_count_entries ;
 106
 107 : first-entry ( ld result -- entry )
 108     ldap_first_entry ;
 109
 110 : next-entry ( ld entry -- entry )
 111     ldap_next_entry ;
 112
 113 : first-attribute ( ld entry berptr -- str )
 114     ldap_first_attribute ;
 115
 116 : next-attribute ( ld entry ber -- str )
 117     ldap_next_attribute ;
 118
 119 : get-values ( ld entry attr -- values )
 120     ldap_get_values ;
 121
 122 : get-dn ( ld entry -- str )
 123     ldap_get_dn ;
 124
 125 ! =========================================================
 126 ! Public routines
 127 ! =========================================================
 128
 129 : get-message ( -- message )
 130     message get ;
 131
 132 : get-ldp ( -- ldp )
 133     ldp get ;