134 lines
		
	
	
		
			3.3 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			134 lines
		
	
	
		
			3.3 KiB
		
	
	
	
		
			Factor
		
	
	
| 
								 | 
							
								! 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 ;
							 |