ocamldap-2.1.8/0000755000175000017500000000000010455014253012623 5ustar gildorgildorocamldap-2.1.8/._.DS_Store0000400000175000017500000000012210444405447014513 0ustar gildorgildorMac OS X  2 R@ocamldap-2.1.8/.DS_Store0000644000175000017500000001400410444405447014314 0ustar gildorgildorBud1i0blobdocfwi0blobicnvdocfwswlongzdocfwvhshor  @ @ @ @ EDSDB ` @ @ @ocamldap-2.1.8/Changelog0000644000175000017500000005656610444405447014466 0ustar gildorgildor2.1.7 * Fixed a bug in search_a, if a search results in zero results an exception (LDAP_Failure (`SUCCESS, ..)) was being raised by the search_a function instead of by the closure which it returnes. 2.1.7 handles this case correctly, the exception is only raised by the closure which is returned. 2.1.6 * Fixed a bug in the filter parser, it was rejecting filters of the form uid=cn=... which are valid filters. * fixed several bugs in the output of ldif change records * Ldap_ooclient.fold now runs in constant stack space in the presence of arbitrarially complex exception handlers. * Ldap_ooclient.ldapcon.search_a makes an effort to detect if the server is really still there before returning the cursor function. It does this by trying to download the first object. This should eliminate errors when starting an async search with a connection which has timed out (it will now reconnect automatically). * Ldap_ooclient.ldapcon.search_a, the cursor now does a reconnect when the operation is abandoned. This clears a lot of common problems, however one gotcha is that all currently active async operations will be ended if one of them abandons. This is usually not a problem however, since an abandon is almost always caused by a serious error. 2.1.5 * Fixed a bug in the delete method of ldapentry, it would not correctly process a list of deleteions in a certian case * Added two new functions to ldif_oo, read_ldif_file, and write_ldif_file. The former reads all the entries in an ldif file into a list of entries, while the latter writes all the entries in the given list to an ldif file. * Added an object locking table to ldap_mutex, which allows individual objects to be locked (advisory locking like POSIX flock) * Applied a patch which makes the toplevel printers to pass all data through String.escaped, and which adds a close bracket which was missing in some cases.Thanks to Victor Seletsky for this patch. * Changed the toplevel printer to print a max of 50 entries, to avoid overwhelming emacs. At some point I want to make this configurable. * Added a function to return the canonical dn to Ldap_dn. * Improved (drastically) the ldap_strerror, and ldap_perror functions, they now print out something which looks exactly like the string representation of an LDAP_Failure exception in the toplevel. Avid users of the toplevel will hopefully appreciate this as much as I do. 2.1.4 * Changed the type of the result of the low level ldif parser (Ldif_parser) to produce search_result_entry instead of its own type. This allows better cross module communication, and simplified the Ldif_oo module's job a bit. * Fixed a bug in the ldif pretty printer. It would print values containing only white space, or with leading white space without base64 encoding them, this is an error. * 2.5x decoder speedup. (4.0 MB/s sustained on an 800Mhz G4). The bytecode decoder is now 10% faster than the original native code compiled decoder released in 2.0, and it is 14 times faster than Perl's Net::LDAP library. * Fixed a bug in the ssl readbyte implementation which could cause data loss to occurr if peeking very far ahead. * The print method of ldapentry is now deprecated 2.1.3 * Added toplevel pretty printers for Oid.t, Lcstring.t, and ldapentry_t * fixed in readbyte_of_fd, upon reading the C code for this function I realized that under some conditions Unix.in_channel_of_fd may fail. I was not aware of this previously. We now catch the resulting Sys_error, and change it to a Transport_error. It is very unlikely that this would ever happen. * Added a parser and pretty printer for extended ldif as used by openldap. ldif change records can now be read and written from and to nice data structures. I implemented this because I needed to read replogs from slurpd. * Fixed the ldap_url module, it will now raise Invalid_ldap_url when it fails to parse the url, instead of raising a generic exception such as Failure. * Fixed the regular expression for safe-string to actually detect non safe strings, which will be base64 encoded. * Fixed the encoding/decoding of substring filters, which did not perfectly follow the standard. * Fixed a bug in the filter grammar which would not allow multiple substring components * Fixed multiple bugs in the changerec parser and lexer * Added a new module, ldap_mutex, which implements mutexes in an ldap database using it's build in test and set mechanism. You can use this to implement advisory locking around various database operations such as the allocation of unique ids, and transactions. * Added documentation for the ldap_toplevel module, and improved the modify command. 2.1.2 * fixed a bug in the encoding of substring filters, the length was not being computed correctly. * fixed a bug in diff, when syncing attributes it was not considering values which were not on the master, but were on the replica. This has been fixed. * added a dn parser and pretty printer which conforms to rfc 2253 * added an exception Invalid_filter to the filter parser, it will raise this exception whenever there is an error. In addition to a string the exception contains an int, which indicates at which charachter the parser failed. * fixed a bug in the filter parser which allowed it to accept filters with garbage at the end. * exposed the escaping functions for attribute values in the dn parser, and the filter parser. These functions are intended to be used when you are manually manipulating stringified versions of the dn or filter via regular expressions or other means. * added some functions which are designed to be used from the toplevel for quick searches, and modifies. These are a work in progress. 2.1.1 * Changed Lcstring to work like it used to, added a new module CaseInsensitiveString which does case preserving case insensitive comparisons. 2.1.0 * ocaml-ssl is now required * BER Decoder - Improved decoding performance, 2x speedup. Beats OpenLDAP 2.2's decoder by about 5% (tested on PPC Mac OS 10.3, and Intel Linux) - Fixed decoding of negative integers - Fixed decoding of error codes to comply with rfc2251. Unknown error codes will now be returned as `OTHER according to the rfc. - Fixed buggy decoding of ldap controls. They were not well tested until now, and several misinterpertations of the standard existed. - Fixed a bug which only happens when controls are asserted, some operations with optional values at the end would fail to decode when the control was present because of improper boundry setting. Boundries are now set at the end of each operation. * BER Encoder - Fixed several bugs in the encoding of two's complement integers where the sign bit was not being handled correctly. This never effected ldap clients, but severly limited the functionality of ldap servers. They would be unable to respond to requests with message id 128, which would cause most clients to hang - Fixed discrepancies between the ldap_errorcode variant type, and the type recognized by encode_ldapresultcode. They are not the same type, and no exception can be raised, the compiler will prove that client code doesn't send a variant which cannot be recognized. * ldap_funclient - Studied OpenLDAP's client library in depth, and adapted msgid allocation to look exactly like theirs. This will expose fewer bugs in ldap servers. - Changed the msgid type to an int32 (this should not be a visible change, it is an opaque type). - Refactored readbyte implementations, moved them to lber.ml, and tightened their exception handling. * ldap_ooclient - connect_timeout is now available as an optional argument to ldapcon. - added a method called "diff" to the ldapentry higharchy. It takes an entry and returns a list of differences between itself and the specified entry in the form of a modify record. * ldap_funserver - Deal with protocol errors according to rfc2251 - Use the new readbyte implementations in lber.ml instead of a custom one - Implemented a logging harness. You pass in a function (optional) to init which takes a log level, and a string. The server will send your function log lines which exactly match the log format of OpenLDAP. The default function does nothing with the log lines. A parser for this log format is in the works and will be released as a seperate library. * LDIF Parser improvements - Improved the performance of write_entry, and to_string in Ldif_oo - Fixed a bug in the LDIF parser which could cause it to return the wrong line count when it finds a syntax error. * RFC 2252 schema parser/lexer - Fixed a typo in the lexer which would cause it not to correctly lex non numeric OIDs - Fixed bad lexing of X- attributes. There was an error in the definition of qdstring which would cause the lexer to eat all of the X- attributes in one pass. Tested fix with Active Directory 2003, OpenLDAP, and Novell eDirectory. - Changed the type of the attribute length field in the attribute record of the schema parser to be an Int64. The standard does not define the numeric range, and vendors (Novell) use huge numbers. * Schema Checker - Handled the case where the entry being checked does not have the objectclass attribute. Objectclass: top will be now be added in this case. - Fixed a bug in the "of_entry" method. It did not do a full schema check after importing the entry, so after calling of_entry the scldapentry was not proven to be valid. * Url Parser - Fixed a bug which could cause the url parser to return the wrong hostname if the hostname specified contained illegal characters. * Error Handling - moved err2string to a new module Ldap_error, which will contain functions for doing various things with LDAP_Failure exceptions. This WILL break existing applications which use err2string, however it is a simple matter of opening Ldap_error to fix them. - Implemented ldap_perror, and ldap_strerror functions, which either print, or return nicely formatted strings describing an LDAP_Failure exception. 2.0.3 * Handle additional Unix_error exceptions as reconnection events, including EPIPE, ECONNRESET, and ECONNABORTED. Not handling these exceptions caused the library not to autoreconnect when the connection was dropped under certian circumstances. 2.0.2 * Fixed a bug in the way delete was encoded which prevented it from working 2.0.1 * Fixed a major bug in async calls. 2.0 * Complete reimplementation of the low levels. - Pure Ocaml lber, and ldap protocol implementation. Ocamldap is no longer a C binding. - Server side as well as client side encoding/decoding functions. You can now make ldap servers with Ocamldap, as well as be a client! - No code optimization has been done yet, however the decoding performance is within 50% of the C library on the same hardware! Encoding performance has not been tested yet. * Some api changes to support additional error information, referrals and enhanced client side reliability. Minimal OO api changes, fairly significant lower level api changes * Module name reorganization. Painful, but it can only get worse if we let it stay the way it was. These two changes are the main reason for the 2.0 stamp. * Greatly simplified build system * All portions of the library are now covered by the LGPL license 1.6.5 * added a configure script generated with autoconf which aids portability 1.6.4 * Fixed a typo (DOH!) in ooldap which could cause crashes in some rare cases when the library is not used exactly as intended. 1.6.3 * Fixed a subtle bug in transparent reconnections which would occurr if your ldap server did not come back up fast after the connection failed. It would cause LDAP_Failure `STRONG_AUTH_REQUIRED to be raised for every operation after the server went down. There are still some bugs which I have not found. Spesifically, it is not a good idea to call unbind, and then use the object again. I've gotten libldap to die with an ascertion failure from doing this. However so far I can't identify the pattern. This isn't really a supported operation, and it has been very stable otherwise. 1.6.2 * The new map, and search_s routines were not being tail call optimized in the byte code environment. This made doing long searches in the toplevel loop impossible. * added a new method to ldapentry and subclasses. modify. Useful in many ways. It takes a regular Ocamldap modify structure, so it can help with migration. I think the most useful thing about it is that the changes method outputs an Ocamldap modify structure, so you can sync changes between entries by calling changes, and then using modify to move them to another entry. 1.6.1 * fixed a bug in the new code. was not checking the result of ldap_result, which resulted in an ascert failure when the connection was dropped. It is supposed to generate an exception. 1.6.0 * reimplemented the glue code for search. The new code uses the async calls, and has some efficency problems removed. The low level api is broken in a small way by this, the type of entry has changed. attributes are now a list, instead of an array. * Added an async search call to the high level OO environment. search_a. It returns a function of type (unit -> ldapentry) which you can call to get your results. Also added iterator functions which are compatible with this new call. iter, map, rev_map, and fold. They take a (unit -> ldapentry) function, and a user supplied function and iterate just like the list operators. See the newly improved testoo.ml program. * Gutted the old build system and switched to OCamlMakefile for a better building experiance. Also, now actually build the glue code as a .so, so you don't need to build a custom toplevel in order to use ocamldap in it. Yaaaaah. * REMOVED the finalization function on ldapcon in the high level api.This was causing problems in that it would try to finalize the object whenever I returned a closure from one of it's methods. Caused many Bus Errors and Segfaults, took an hour with valgrind to actually figure out what was going on. found no work around, so. Release your ldap objects manually on pain of memory and fd leaks. sorry :( * Referrals are broken again! However, this is a step in the right direction, because I now have control over them. I'm going to be doing a lot of thinking about how to handle them. Right now if you have a referral in your directory you will get LDAP_Failure `LOCAL_ERROR at the end of your async search. You can just consider it success. This is what search_s does, all the iter functions will do it for you. 1.5.0 * The library now depends on findlib, and ocamlnet. It will not compile without them. * added two new methods to ldapaccount service_exists, and services present, which allow the user to inspect what services are on an object. * Fixed a bug in ldapaccount. When computing whether it is possible to generate a dependancy of a generator it was not being taken into account whether the dependancy was allowed by the schema. ldapaccount, and scldapentry generally try to avoid adding objectclasses for you, because some attributes are allowed by so many objectclasses, and inference will pick the first one which allows the attribute. For things like "cn" you can end up with some very strange objectclasses on your objects. As a result attributes on which a generator is dependant, which could also be generated, but are not currently allowed, are no longer considered. * in the ldif parser added support for reading entries with base64 values (Matthew Backes) * added a new method to ooldif, write_entry, which writes an entry to ldif with base64 support. * added two new methods to ooldif, to_string, and of_string to write an entry to an ldif string, and read an entry from an ldif string * added rudimentry support for referrals. Don't raise an exception when we get LDAP_REFERRAL back from ldap_search_s. It seems that openldap's libldap follows referrals transparently, which could be both good and bad. Either way, referrals will need futher invesigation. 1.4.6 * fixed a bug in the ldif parser which prevented the last entry in an ldif file from being read. * fixed the ldif parser so that a file with just a dn is a valid ldif file. * added an unbind method to ldapcon, for explicit deallocation of sockets. * added a finalisation function to ldapcon which calls unbind. It IS safe to call unbind explicitly, the object will handle the case that it is unbound twice gracefully. * fixed a bug in delete service which could cause it not to delete all the attribute values that it should. 1.4.5 * fixed a bug in transparent reconnections which would cause an infinite loop. 1.4.4 * exposed an exception called "Cannot_sort_dependancies of string list" which indicates that circular dependancies have been detected among the attributes of the list. The exception will be raised when calling the generate method of an ldapaccount 1.4.3 * changed the way the delta between an object and a service is computed. Instead of always doing a case sensitive match of the attribute values we now look up the matching rule in the schema and try to apply something close. We currently understand objectIdentifierMatch, caseIgnoreMatch, and caseExactIA5Match. I will probably add more later. 1.4.2 * adds modrdn support in ooldap, which was horribly omitted previously * fixed a bug in the service code with respect to single valued attributes, and static service attributes. Previously, an object which needed to have a static attribute to satisfy a service would always get it be adding a second value. This won't work for single value attributes for obvious reasons. The fix is to check if the attribute is single valued, and if it is, replace it, otherwise, add it. 1.4.1 * fixes a bug in the schema parser. X-.* attributes were not previously supported. 1.4.1 adds support for them. 1.4.0 * added two new classes to the Ooldap module. - scldapentry understands the directory schema, and makes use of it in various ways. It is a subclass of ldapentry - ldapaccount is built on top of scldapentry. It understands the schema, and how to generate certian attributes (based on functions you give it). It also has a the ability to group attributes together into things it calls services, which can be added and removed atomically. 1.3.2 * fixed massive memory leaks in the search C glue code 1.3.1 * fixed some serious bugs in the C glue code which could cause the garbage collector to go nuts. * performance improvements in the way entry objects are arranged this will improve performance for searching, local modifications and the ldif parser. I haven't done another test, but the ldif parser spitting out entries is most likely just as fast as the engine (~26s for a 50MB ldif file on a PPC7450 800Mhz). 1.3.0 * Added an rfc2252 schema parser, and an interface to grab schema's from the server, see ooldap.mli, the method schema. See schemaparser.ml for the structure of the record returned. * performance enhancements to the ldif parser, ~3x improvement in parseing speed. Native code can parse a 50MB ldif file in ~38 seconds, bytecode takes about 1m45s for the same file. Obviously different files yeild different results. There is further room for improvement in the building of the entry objects. The engine alone in native code parses the 50MB file in ~26 seconds, so the rest is the overhead of building the entry objects. All tests were performed on an 800Mhz G4. * Fixed a bug with update_entry which caused changes to be applied in reverse order. This often breaks the symantics when replace is involved. 1.2.0 * Added support for transparently reconnecting to servers which have dropped the connection. Often servers will have an idle time out for connections. This is avaliable in the object oriented api only. It should create the illusion that the connection was never dropped. It can also be usefull in the case where one server in a failover cluster goes down. As long as something is there to take its place, the user of the api will never know that a server went down. This feature is experimental, but should work :). This is great for interactive sessions. * Added a standards compliant ldif parser. You can send it a stream of ldif, and by calling a method, get back an ldapentry object. See ooldif.mli for details. The known bugs are, its a bit slow, and it won't do anything with base64 encoded values. If you wish to decode them, do it yourself for now. Things of note, the parser is "picky" in that it tries to follow the rfc to the letter, it will generally not accept malformed ldif. Some users may consider that annoying, but we actually used it to find several errors in our directory server :), so it has advantages too. * Changed make dep to preprecess using cpp instead of camlp4o, due to strange undocumented changes in 3.07. I really need to look into this and fix it. * Changed the get_value method of ldapentry to raise Not_found instead of return the empty list when it is queried for an attribute which doesn't exist. Please complain if this annoys you. 1.1.2 * Added a patch from Sylvain Le Gall to ease packaging for debian. * Added another patch from Sylvain Le Gall which adds support for making documentation with ocamldoc. 1.1.1 * fixed the makefile to properly honor CFLAGS. This makes it possible to build on systems where the ldap libraries are in a nonstandard place * added findlib support. make install now installs a package called "ocamldap". 1.1.0 * Eric Stokes has taken over maintanence of the project * added a new object oriented interface modeled after Net::LDAP in perl. * added an optional argument to init which allows selection of the protocal version. It defaults to 3. 1.0 * added fixes from Eric Stokes: * added make dep to build dependencies * modified print_entry to print more ldif like output (it does not break up long lines correctly yet) 0.3.1 * added fixes from Eric Stokes: * updated varcc with the latest version from labgtk * fixed ocamldap_tags.var to work with the new varcc * changed build scripts to allow compilation under 3.06 * added ifdefs to remove kerberos support if not avaliable 0.3 * added kerberos binding methods * added modrdn methods * most function arguments are lists now * fixed crash bug in search_s 0.2 * add, modify, and delete are implemented * all ldap error codes are supported with the help of varcc * silly bugs fixed in bind and unbind 0.1 * first Release by Miles Egan * only synchronous searches are supported ocamldap-2.1.8/COPYING0000644000175000017500000000164010444405447013666 0ustar gildorgildorCopyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ocamldap-2.1.8/doc/0000755000175000017500000000000010455014206013366 5ustar gildorgildorocamldap-2.1.8/doc/ocamldap/0000755000175000017500000000000010455014206015146 5ustar gildorgildorocamldap-2.1.8/doc/ocamldap/html/0000755000175000017500000000000010455014207016113 5ustar gildorgildorocamldap-2.1.8/doc/ocamldap/html/index.html0000644000175000017500000001071410444405446020122 0ustar gildorgildor

Index of types
Index of exceptions
Index of values
Index of class methods
Index of classes
Index of class types
Index of modules


Lber
This library implements the subset of ber
Ldap_types
Common data types used by ocamldap.
Ldap_error
given an ldap error code return a string describing it
Ldap_protocol
an implementation of the ldap wire protocol
Ldap_url
a library for parsing a subset of the ldapurl syntax
Ldap_filter
operations on ldap search filters
Ldap_dn
operations on ldap dns
Ldap_funclient
a functional ldap client interface
Ldap_ooclient
an object oriented ldap client interface
Ldap_schemaparser
A library for parsing rfc2252 schemas as returned by directory servers
Ldap_funserver
A functional ldap server construction kit
Ldif_oo
an object oriented interface to the ldif parser
Ldap_toplevel
Functions which resemble the command line tools which many users are familar with, useful in the interactive environment
Ldap_mutex
functions for implementing mutexes on top of LDAP's built in test and set mechanism.
Ldif_changerec_oo
an object oriented interface to the ldif parser
Ldap_txooclient
the abstract type of a transaction
ocamldap-2.1.8/doc/ocamldap/html/index_attributes.html0000644000175000017500000000343010444405446022365 0ustar gildorgildor Index of class attributes

Index of class attributes


ocamldap-2.1.8/doc/ocamldap/html/index_class_types.html0000644000175000017500000000510110444405446022525 0ustar gildorgildor Index of class types

Index of class types


L
ldapentry_t [Ldap_ooclient]
The base type of an ldap entry represented in memory.

M
mutex_t [Ldap_mutex]
the class type of a single mutex, used for performing advisory locking of some action

O
object_lock_table_t [Ldap_mutex]
the class type of an object lock table which allows for advisory locking of objects by dn

ocamldap-2.1.8/doc/ocamldap/html/index_classes.html0000644000175000017500000000720010444405446021633 0ustar gildorgildor Index of classes

Index of classes


C
change [Ldif_changerec_oo]

L
ldapaccount [Ldap_ooclient]
ldapadvisorytxcon [Ldap_txooclient]
A subclass of ldapcon which implements an experimental interface to draft_zeilenga_ldap_txn.
ldapcon [Ldap_ooclient]
This class abstracts a connection to an LDAP server (or servers), an instance will be connected to the server you specify and can be used to perform operations on that server.
ldapentry [Ldap_ooclient]
this object represents a remote object within local memory.
ldif [Ldif_oo]

M
mutex [Ldap_mutex]
new mutex ldapurls binddn bindpw mutexdn

O
object_lock_table [Ldap_mutex]
new object_lock_table ldapurls binddn bindpw mutexdn

S
scldapentry [Ldap_ooclient]

ocamldap-2.1.8/doc/ocamldap/html/index_exceptions.html0000644000175000017500000002023110444405446022356 0ustar gildorgildor Index of exceptions

Index of exceptions


C
Cannot_sort_dependancies [Ldap_ooclient]
You have detached cycles in your generator dependancy lists

D
Decoding_error [Lber]

E
Encoding_error [Lber]
End_of_changerecs [Ldif_changerec_oo]
raised at the end of the change records

G
Generation_failed [Ldap_ooclient]
Generator has failed because of some kind of error
Generator_dep_unsatisfiable [Ldap_ooclient]
Your generator depends on an attribute which isn't in the schema

I
Invalid_attribute [Ldap_ooclient]
Invalid_changerec [Ldif_changerec_oo]
an exception raised when there is a parse error
Invalid_dn [Ldap_dn]
raised when something goes wrong with conversion to or from a string.
Invalid_filter [Ldap_filter]
raised when something goes wrong in to_string or of_string.
Invalid_ldap_url [Ldap_url]
will be raised in the event of a parse or type error.
Invalid_objectclass [Ldap_ooclient]

L
LDAP_Decoder [Ldap_types]
A decoding error has occurred, the argument contains a description of the error.
LDAP_Encoder [Ldap_types]
An encoding error has occurred, the argument contains a description of the error This is likely a bug, so it should be reported
LDAP_Failure [Ldap_types]
The exception raised to indicate all types of failure in the higher level libraries Ldap_funclient, and Ldap_ooclient.
Ldap_mutex
functions for implementing mutexes on top of LDAP's built in test and set mechanism.

N
No_generator [Ldap_ooclient]
You've asked it to generate an attribute (in a service) which doesn't have a generator
No_service [Ldap_ooclient]
The service you're talking about doesn't exist

O
Objectclass_is_required [Ldap_ooclient]

P
Parse_error_at [Ldap_schemaparser]
Parse_error_oc [Ldap_schemaparser]

R
Readbyte_error [Lber]

S
Server_error [Ldap_funserver]
raised whenever an error occurrs in the server
Service_dep_unsatisfiable [Ldap_ooclient]
A service which the one you tried to add depends on doesn't exists
Single_value [Ldap_ooclient]
Syntax_error_at [Ldap_schemaparser]
Syntax_error_oc [Ldap_schemaparser]

T
Txn_commit_failure [Ldap_txooclient]
raised when a commit fails, contains a list of entries which were not rolled back successfully only if rollback failed as well, otherwise None
Txn_rollback_failure [Ldap_txooclient]
raised when an explicit rollback fails

ocamldap-2.1.8/doc/ocamldap/html/index_methods.html0000644000175000017500000007655610444405446021665 0ustar gildorgildor Index of class methods

Index of class methods


A
adapt_service [Ldap_ooclient.ldapaccount]
Run service through the delta engine to find out what changes would actually be applied to this object
add [Ldap_txooclient.ldapadvisorytxcon]
add [Ldap_ooclient.ldapentry_t]
add [Ldap_ooclient.ldapaccount]
Missing attributes may be marked for generation.
add [Ldap_ooclient.scldapentry]
Add values to the entry, just as Ldap_ooclient.ldapentry.add, However, after the add is complete the schema checker is run in Optimistic mode.
add [Ldap_ooclient.ldapcon]
add an entry to the database
add [Ldap_ooclient.ldapentry]
add values to an attribute (or create a new attribute).
add_generate [Ldap_ooclient.ldapaccount]
add the named attribute to the list of attributes to be generated
add_service [Ldap_ooclient.ldapaccount]
add the named service to the object, this also adds all the services depended upon by the named service.
associate_entries [Ldap_txooclient.ldapadvisorytxcon]
associate_entry [Ldap_txooclient.ldapadvisorytxcon]
attributes [Ldap_ooclient.ldapentry_t]
attributes [Ldap_ooclient.ldapaccount]
attributes [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.attributes, except that the returned list contains attributes which may not yet exist on the entry.
attributes [Ldap_ooclient.ldapentry]
return a list of the type (name) of all the attributes present on the object

B
begin_txn [Ldap_txooclient.ldapadvisorytxcon]
bind [Ldap_txooclient.ldapadvisorytxcon]
bind [Ldap_ooclient.ldapcon]
bind to the database using dn.

C
changes [Ldap_ooclient.ldapentry_t]
changes [Ldap_ooclient.ldapaccount]
changes [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.changes except that changes made by the schema checker may also be listed.
changes [Ldap_ooclient.ldapentry]
return a list of changes made to the object in a the format of a modify operation.
changetype [Ldap_ooclient.ldapentry_t]
changetype [Ldap_ooclient.ldapaccount]
changetype [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.changetype
changetype [Ldap_ooclient.ldapentry]
return the changetype of the object
commit_txn [Ldap_txooclient.ldapadvisorytxcon]

D
delete [Ldap_txooclient.ldapadvisorytxcon]
delete [Ldap_ooclient.ldapentry_t]
delete [Ldap_ooclient.ldapaccount]
delete [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.add, except that the schema checker is run in Pessimistic mode after the operation is complete.
delete [Ldap_ooclient.ldapcon]
Delete the object named by dn from the database
delete [Ldap_ooclient.ldapentry]
delete attributes from the object, does not change the directory until you update
delete_generate [Ldap_ooclient.ldapaccount]
Delete the named attribute from the list of attributes to generate
delete_service [Ldap_ooclient.ldapaccount]
Delete the named service.
diff [Ldap_ooclient.ldapentry_t]
diff [Ldap_ooclient.ldapaccount]
diff [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.diff
diff [Ldap_ooclient.ldapentry]
given an ldapentry, return the differences between the current entry and the specified entry in the form of a modify operation which would make the specified entry the same as the current entry.
disassociate_entries [Ldap_txooclient.ldapadvisorytxcon]
disassociate_entry [Ldap_txooclient.ldapadvisorytxcon]
dn [Ldap_ooclient.ldapentry_t]
dn [Ldap_ooclient.ldapaccount]
dn [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.dn
dn [Ldap_ooclient.ldapentry]
return the dn of the object

E
exists [Ldap_ooclient.ldapentry_t]
exists [Ldap_ooclient.ldapaccount]
exists [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.exists except that it refrences attributes which may not yet exist.
exists [Ldap_ooclient.ldapentry]
query whether the attribute type (name) exists in the object

F
flush_changes [Ldap_ooclient.ldapentry_t]
flush_changes [Ldap_ooclient.ldapaccount]
flush_changes [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.flush_changes
flush_changes [Ldap_ooclient.ldapentry]
clear all accumulated changes

G
generate [Ldap_ooclient.ldapaccount]
Run the generation functions on the list of attributes to be generated, saving the results in the entry.
get_value [Ldap_ooclient.ldapentry_t]
get_value [Ldap_ooclient.ldapaccount]
If a missing attribute is marked for generation its value will be "generate" instead of "required"
get_value [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.get_value, except that attributes which do not yet exists may be referenced.
get_value [Ldap_ooclient.ldapentry]
get the value of an attribute

I
is_allowed [Ldap_ooclient.ldapaccount]
is_allowed [Ldap_ooclient.scldapentry]
Returns true if the attributed specified is allowed by the current set of objectclasses present on the entry.
is_missing [Ldap_ooclient.ldapaccount]
is_missing [Ldap_ooclient.scldapentry]
Returns true if the attribute specified is a must, but is not currently present.

L
list_allowed [Ldap_ooclient.ldapaccount]
list_allowed [Ldap_ooclient.scldapentry]
Return a list of all attributes allowed on the entry (by oid)
list_missing [Ldap_ooclient.ldapaccount]
list_missing [Ldap_ooclient.scldapentry]
Return a list of all missing attributes (by oid)
list_present [Ldap_ooclient.ldapaccount]
list_present [Ldap_ooclient.scldapentry]
Return a list of all present attributes.
lock [Ldap_mutex.object_lock_table_t]
lock [Ldap_mutex.mutex_t]
lock [Ldap_mutex.object_lock_table]
lock the specified dn, if it is already locked, then block until the lock can be aquired
lock [Ldap_mutex.mutex]
lock the mutex.

M
modify [Ldap_txooclient.ldapadvisorytxcon]
modify [Ldap_ooclient.ldapentry_t]
modify [Ldap_ooclient.ldapaccount]
modify [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.modify except that the schema checker is run in Pessimistic mode after the modification is applied.
modify [Ldap_ooclient.ldapcon]
Modify the entry named by dn, applying mods
modify [Ldap_ooclient.ldapentry]
Apply modifications to object in memory, does not change the database until you update using Ldap_ooclient.ldapcon.update_entry
modrdn [Ldap_txooclient.ldapadvisorytxcon]
modrdn [Ldap_ooclient.ldapcon]
Modify the rdn of the object named by dn, if the protocol version is 3 you may additionally change the superior, the rdn will be changed to the attribute represented (as a string) by newrdn,

O
of_entry [Ldap_ooclient.ldapaccount]
of_entry [Ldap_ooclient.scldapentry]
Given an Ldap_ooclient.ldapentry copy all of it's data into the current object, and perform a schema check.
of_string [Ldif_changerec_oo.change]
of_string [Ldif_oo.ldif]

P
print [Ldap_ooclient.ldapentry_t]
print [Ldap_ooclient.ldapaccount]
print [Ldap_ooclient.scldapentry]
print [Ldap_ooclient.ldapentry]

R
rawschema [Ldap_txooclient.ldapadvisorytxcon]
rawschema [Ldap_ooclient.ldapcon]
Fetch the raw (unparsed) schema from the directory using the standard mechanism (requires protocol version 3)
read_changerec [Ldif_changerec_oo.change]
read_entry [Ldif_oo.ldif]
replace [Ldap_ooclient.ldapentry_t]
replace [Ldap_ooclient.ldapaccount]
replace [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.replace except that once the replace has completed the schema checker is run again in Optimistic mode.
replace [Ldap_ooclient.ldapentry]
replace values in the object, does not change the database until you call update
rollback_txn [Ldap_txooclient.ldapadvisorytxcon]

S
schema [Ldap_txooclient.ldapadvisorytxcon]
schema [Ldap_ooclient.ldapcon]
Fetch and parse the schema from the directory via the standard mechanism (requires version 3).
search [Ldap_txooclient.ldapadvisorytxcon]
search [Ldap_ooclient.ldapcon]
Search the directory syncronously for an entry which matches the search criteria.
search_a [Ldap_txooclient.ldapadvisorytxcon]
search_a [Ldap_ooclient.ldapcon]
Search the directory asyncronously, otherwise the same as search.
service_exists [Ldap_ooclient.ldapaccount]
Tests whether the named service is satisfied by the current entry.
services_present [Ldap_ooclient.ldapaccount]
Return a list of all the named services which are satisfied by the current entry.
set_changetype [Ldap_ooclient.ldapentry_t]
set_changetype [Ldap_ooclient.ldapaccount]
set_changetype [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.set_changetype
set_changetype [Ldap_ooclient.ldapentry]
set the changetype of the object
set_dn [Ldap_ooclient.ldapentry_t]
set_dn [Ldap_ooclient.ldapaccount]
set_dn [Ldap_ooclient.scldapentry]
Same as Ldap_ooclient.ldapentry.set_dn
set_dn [Ldap_ooclient.ldapentry]
set the dn of the object

T
to_string [Ldif_changerec_oo.change]
to_string [Ldif_oo.ldif]

U
unbind [Ldap_txooclient.ldapadvisorytxcon]
unbind [Ldap_ooclient.ldapcon]
Deauthenticate and close the connection to the server
unlock [Ldap_mutex.object_lock_table_t]
unlock [Ldap_mutex.mutex_t]
unlock [Ldap_mutex.object_lock_table]
unlock [Ldap_mutex.mutex]
update_entry [Ldap_txooclient.ldapadvisorytxcon]
update_entry [Ldap_ooclient.ldapcon]
Syncronize changes made locally to an ldapentry with the directory.

W
write_changerec [Ldif_changerec_oo.change]
write_entry [Ldif_oo.ldif]

ocamldap-2.1.8/doc/ocamldap/html/index_module_types.html0000644000175000017500000000342010444405446022707 0ustar gildorgildor Index of module types

Index of module types


ocamldap-2.1.8/doc/ocamldap/html/index_modules.html0000644000175000017500000001155510444405446021656 0ustar gildorgildor Index of modules

Index of modules


L
Lber
This library implements the subset of ber
Lcstring [Ldap_schemaparser]
Ldap_dn
operations on ldap dns
Ldap_error
given an ldap error code return a string describing it
Ldap_filter
operations on ldap search filters
Ldap_funclient
a functional ldap client interface
Ldap_funserver
A functional ldap server construction kit
Ldap_mutex
functions for implementing mutexes on top of LDAP's built in test and set mechanism.
Ldap_ooclient
an object oriented ldap client interface
Ldap_protocol
an implementation of the ldap wire protocol
Ldap_schemaparser
A library for parsing rfc2252 schemas as returned by directory servers
Ldap_toplevel
Functions which resemble the command line tools which many users are familar with, useful in the interactive environment
Ldap_txooclient
the abstract type of a transaction
Ldap_types
Common data types used by ocamldap.
Ldap_url
a library for parsing a subset of the ldapurl syntax
Ldif_changerec_oo
an object oriented interface to the ldif parser
Ldif_oo
an object oriented interface to the ldif parser

O
Oid [Ldap_schemaparser]
OrdOid [Ldap_ooclient]
an ordered oid type, for placing oids in sets

S
Setstr [Ldap_ooclient]
A set of Oids

ocamldap-2.1.8/doc/ocamldap/html/index_types.html0000644000175000017500000003157310444405446021354 0ustar gildorgildor Index of types

Index of types


A
alias_deref [Ldap_types]
attribute [Ldap_schemaparser]
The type representing an attribute definition
attribute [Ldap_types]
attribute_value_assertion [Ldap_types]
authentication [Ldap_types]
authmethod [Ldap_funclient]

B
backendInfo [Ldap_funserver]
This structure is the guts of the ldap server.
ber_class [Lber]
ber_length [Lber]
ber_val_header [Lber]
bind_request [Ldap_types]
bind_response [Ldap_types]

C
changerec [Ldap_ooclient]
The type of an ldap change record, used by extended LDIF
changetype [Ldap_ooclient]
The change type of an ldapentry.
compare_request [Ldap_types]
con_mech [Ldap_types]
conn [Ldap_funclient]
connection_id [Ldap_funserver]

D
dn [Ldap_types]

E
elt [Ldap_ooclient.Setstr]
entry [Ldap_funclient]
extended_request [Ldap_types]
extended_response [Ldap_types]

F
filter [Ldap_types]

G
generation_error [Ldap_ooclient]
The type of error raised by attribute generators
generator [Ldap_ooclient]
The structure of a generator

L
ldap_control [Ldap_types]
ldap_controls [Ldap_types]
ldap_ext_return [Ldap_types]
extended information to return with the LDAP_Failure exception.
ldap_grouping_cookie [Ldap_types]
a cookie that is sent with every ldap operation which is part of a group
ldap_grouping_type [Ldap_types]
see draft-zeilenga-ldap-grouping-xx Ldap grouping is a way of telling the server that a set of ldap operations is related, its most interesting application is transactions across multiple objects.
ldap_message [Ldap_types]
ldap_result [Ldap_types]
ldap_resultcode [Ldap_types]
ldap_url [Ldap_types]
log_level [Ldap_funserver]

M
matching_rule_assertion [Ldap_types]
modattr [Ldap_funclient]
modify_dn_request [Ldap_types]
modify_op [Ldap_types]
modify_optype [Ldap_types]
modify_request [Ldap_types]
msgid [Ldap_funclient]

O
objectclass [Ldap_schemaparser]
The type representing an objectclass definition
octype [Ldap_schemaparser]
op [Ldap_ooclient]
the type of an operation, eg.
op_lst [Ldap_ooclient]

P
protocol_op [Ldap_types]

R
readbyte [Lber]
readbyte_error [Lber]
referral_policy [Ldap_ooclient]
The policy the client should take when it encounteres a referral.
result [Ldap_funclient]

S
saslCredentials [Ldap_types]
scflavor [Ldap_ooclient]
The type of schema checking to perform in Ldap_ooclient.scldapentry.
schema [Ldap_schemaparser]
The type representing the whole schema.
search_request [Ldap_types]
search_result [Ldap_funclient]
search_result_entry [Ldap_types]
the type used to encode and decode a search entry.
search_scope [Ldap_types]
a type defining the scope of a search filter
server_info [Ldap_funserver]
service [Ldap_ooclient]
The structure of a service
substring_component [Ldap_types]
substring_filter [Ldap_types]

T
t [Ldap_schemaparser.Lcstring]
t [Ldap_schemaparser.Oid]
t [Ldap_ooclient.Setstr]
t [Ldap_ooclient.OrdOid]
txn [Ldap_txooclient]
the abstract type of a transaction

W
writebyte [Lber]

ocamldap-2.1.8/doc/ocamldap/html/index_values.html0000644000175000017500000006072710444405446021512 0ustar gildorgildor Index of values

Index of values


A
abandon [Ldap_funclient]
abandon the async request attached to msgid.
add [Ldap_ooclient.Setstr]
add_s [Ldap_funclient]
add entry to the directory
apply_with_mutex [Ldap_mutex]
used to apply some function, first locking the mutex, unlocking it only after the function has been applied.
attrToOid [Ldap_ooclient]
given a name of an attribute name (canonical or otherwise), return its oid

B
bind_s [Ldap_funclient]
authenticatite to the server.

C
canonical_dn [Ldap_dn]
returns the canonical dn.
cardinal [Ldap_ooclient.Setstr]
choose [Ldap_ooclient.Setstr]
compare [Ldap_schemaparser.Lcstring]
compare [Ldap_schemaparser.Oid]
compare [Ldap_ooclient.Setstr]
compare [Ldap_ooclient.OrdOid]

D
decode_ber_bool [Lber]
Encoding/Decoding of the boolean primative ASN.1 type.
decode_ber_enum [Lber]
Encoding/Decoding of enum primative ASN.1 type.
decode_ber_header [Lber]
decoding and encoding of the ber header
decode_ber_int32 [Lber]
Encoding/Decoding of the integer primative ASN.1 type.
decode_ber_null [Lber]
Encoding/Decoding of Null ASN.1 type.
decode_ber_octetstring [Lber]
Encoding/Decoding of octetstring ASN.1 types.
decode_berval_list [Lber]
this is the reverse of the above, it takes a readbyte structure, and returns a list of decoded elements, processed according to the decoder function you pass in.
decode_ldapmessage [Ldap_protocol]
decode an ldap_message from the wire, and build/return a structure of type ldap_message
decode_resultcode [Ldap_protocol]
return the result code for the specified int, error codes which do not map to a code defined within the standard (or any of our own internal ones) will be represented as (`UNKNOWN_ERROR of int), where int is the unknown error code.
delete_s [Ldap_funclient]
delete the entry named by dn from the directory
diff [Ldap_ooclient.Setstr]

E
elements [Ldap_ooclient.Setstr]
empty [Ldap_ooclient.Setstr]
encode_ber_bool [Lber]
encode_ber_enum [Lber]
encode_ber_header [Lber]
encode_ber_int32 [Lber]
encode_ber_null [Lber]
encode_ber_octetstring [Lber]
encode_berval_list [Lber]
this function is for encoding lists of bervals, a common case.
encode_ldapmessage [Ldap_protocol]
encode a value of type ldap_message using lber and return a string which is ready to be put on the wire
encode_resultcode [Ldap_protocol]
return the int asociated with the specified result code
entry2ldif [Ldif_oo]
if you need a fast, low level interface to to_string, this function will write ldif directly into a buffer.
equal [Ldap_ooclient.Setstr]
equateAttrs [Ldap_ooclient]
equate attributes by oid.
err2string [Ldap_error]
given an ldap error code return a string describing it
escape_filterstring [Ldap_filter]
escape a string which is intended to be the VALUE of an attribute assertion in a filter.
escape_value [Ldap_dn]
Escape a string which you intend to be part of a VALUE in the dn.
exists [Ldap_ooclient.Setstr]

F
filter [Ldap_ooclient.Setstr]
fold [Ldif_changerec_oo]
Ldif_changerec.fold f change value, for each change entry en in the change object fold computes f (...
fold [Ldif_oo]
Ldif_oo.fold f ldif value, for each ldif entry en in the ldif object fold computes f (...
fold [Ldap_ooclient.Setstr]
fold [Ldap_ooclient]
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a compute (f eN ...
for_all [Ldap_ooclient.Setstr]
format_entries [Ldap_ooclient]
format lists of entries, in this case only print the dn
format_entry [Ldap_ooclient]
toplevel formatter for ldapentry, prints the whole entry with a nice structure.
format_lcstring [Ldap_schemaparser]
format_oid [Ldap_schemaparser]
format_schema [Ldap_schemaparser]
A formatter for the schema, prints the structure, and expands the hashtbls to show the keys.

G
getAttr [Ldap_ooclient]
get an attr structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster)
getOc [Ldap_ooclient]
get an objectclass structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster)
get_search_entry [Ldap_funclient]
fetch a search entry from the wire using the given msgid.

I
init [Ldap_funserver]
Initialize the server, create the listening socket and return the server context, which you will pass to serv to process connections.
init [Ldap_funclient]
Initializes the conn data structure, and opens a connection to the server.
inter [Ldap_ooclient.Setstr]
is_empty [Ldap_ooclient.Setstr]
iter [Ldif_changerec_oo]
Ldif_changerec.iter f change, iterate accross all change entries in the specified change object, applying f to each one
iter [Ldif_oo]
Ldif_oo.iter f ldif, iterate accross all ldif entries in the specified ldif object, applying f to each one
iter [Ldap_ooclient.Setstr]
iter [Ldap_ooclient]
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a, apply f (first arg) to each entry See List.iter

L
ldap_perror [Ldap_error]
print to stderr a string with a human readable description of an LDAP_Failure exception
ldap_strerror [Ldap_error]
return a string with a human readable description of an LDAP_Failure exception
ldapadd [Ldap_toplevel]
connect to the specified host and add the specified objects.
ldapmodify [Ldap_toplevel]
connect to the specified host and perform one or more modifications.
ldapsearch [Ldap_toplevel]
connect to the specified host and perform a search.

M
map [Ldap_ooclient]
same as rev_map, but does it in order
max_elt [Ldap_ooclient.Setstr]
mem [Ldap_ooclient.Setstr]
min_elt [Ldap_ooclient.Setstr]
modify_s [Ldap_funclient]
apply the list of modifications to the named entry
modrdn_s [Ldap_funclient]
change the rdn, and optionally the superior entry of dn

O
ocToOid [Ldap_ooclient]
given a name of an objectclass (canonical or otherwise), return its oid.
of_entry [Ldap_ooclient]
given an ldapentry as returned by ldapcon, or constructed manually, produce a search_result_entry suitable for ldap_funclient, or ldap_funserver.
of_string [Ldap_schemaparser.Lcstring]
of_string [Ldap_schemaparser.Oid]
of_string [Ldap_dn]
Given a string representation of a dn, return a structured representation.
of_string [Ldap_filter]
turn the string representation into the internal representation defined in ldap_types.ml.
of_string [Ldap_url]
internalize the url contained in the string argument
oidToAttr [Ldap_ooclient]
given the oid of an attribute, return its canonical name
oidToOc [Ldap_ooclient]
given the oid of an objectclass, return its canonical name

P
partition [Ldap_ooclient.Setstr]

R
readSchema [Ldap_schemaparser]
readSchema attribute_list objectclass_list, parse the schema into a schema type given a list of attribute definition lines, and objectclass definition lines.
read_contents [Lber]
reads the contents octets
read_ldif_file [Ldif_oo]
read all the entries in the named ldif file and return them in a list
readbyte_of_ber_element [Lber]
return a readbyte implementation which uses another readbyte, but allows setting a read boundry.
readbyte_of_fd [Lber]
a readbyte implementation which reads from an FD.
readbyte_of_ssl [Lber]
a readbyte implementation which reads from an SSL socket.
readbyte_of_string [Lber]
return a readbyte function for a string, currently not implemented
remove [Ldap_ooclient.Setstr]
rev_map [Ldap_ooclient]
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a apply f (first arg) to each entry in reverse, and return a list containing the result of each application.
run [Ldap_funserver]
Using the supplied server context, begin processing ldap operations.

S
schema_print_depth [Ldap_schemaparser]
This reference controls the dept of printing for the schema in the toplevel.
search [Ldap_funclient]
Search for the given entry with the specified base node and search scope, optionally limiting the returned attributes to those listed in 'attrs'.
search_s [Ldap_funclient]
This is the syncronus version of search.
shutdown [Ldap_funserver]
Shutdown the server
singleton [Ldap_ooclient.Setstr]
split [Ldap_ooclient.Setstr]
subset [Ldap_ooclient.Setstr]

T
to_entry [Ldap_ooclient]
given a search_result_entry as returned by ldap_funclient, produce an ldapentry containing either the entry, or the referral object
to_string [Ldap_schemaparser.Lcstring]
to_string [Ldap_schemaparser.Oid]
to_string [Ldap_dn]
Given a structural representation of a dn, return a string representation.
to_string [Ldap_filter]
turn an internal representaion of a filter into a string representaion compliant with rfc2254

U
unbind [Ldap_funclient]
close the connection to the server.
union [Ldap_ooclient.Setstr]

W
write_ldif_file [Ldif_oo]
write all the entries in the given list to the named file in ldif format

ocamldap-2.1.8/doc/ocamldap/html/Lber.html0000644000175000017500000003576010444405446017707 0ustar gildorgildor Lber
 Up  Next

Module Lber


module Lber: sig .. end
This library implements the subset of ber
exception Decoding_error of string
exception Encoding_error of string

type readbyte_error =
| End_of_stream
| Transport_error
| Peek_error
| Request_too_large
| Not_implemented 
exception Readbyte_error of readbyte_error
type readbyte = ?peek:bool -> int -> string 
type writebyte = char -> unit

type ber_class =
| Universal
| Application
| Context_specific
| Private

type ber_length =
| Definite of int
| Indefinite

type ber_val_header = {
   ber_class : ber_class;
   ber_primitive : bool;
   ber_tag : int;
   ber_length : ber_length;
} 
val readbyte_of_string : string -> readbyte
return a readbyte function for a string, currently not implemented
val readbyte_of_ber_element : ber_length -> readbyte -> readbyte
return a readbyte implementation which uses another readbyte, but allows setting a read boundry. Useful for constructing views of the octet stream which end at the end of a ber structure. This is essential for reading certian structures because length is only encoded in the toplevel in order to save space. Currently only implemented for definite lengths.
Raises Readbyte_error in the event of a an io error, or the end of file
val readbyte_of_fd : Unix.file_descr -> readbyte
a readbyte implementation which reads from an FD. It implements a peek buffer, so it can garentee that it will work with rb_of_ber_element, even with blocking fds.
Raises Readbyte_error in the event of a an io error, or the end of file
val readbyte_of_ssl : Ssl.socket -> readbyte
a readbyte implementation which reads from an SSL socket. It is otherwise the same as readbyte_of_fd.
Raises Readbyte_error in the event of a an io error, or the end of file
val decode_ber_header : ?peek:bool -> readbyte -> ber_val_header
decoding and encoding of the ber header
val encode_ber_header : ber_val_header -> string
val read_contents : ?peek:bool -> readbyte -> ber_length -> string
reads the contents octets

ENCODING and DECODING Functions

Explanation of optional arguments: The optional arguments are there to deal with a number of situations, cls, and tag are for context specific or application situations where it is expected that the value will not be marked with the class and tag defined in X.680. Contents is there for akward situations which arise because of the choice structure. Normally the decode functions will always read the header for you, however with the choice structure this is impossible. In this case you should read the header manually, determine which decode function to call, unpack the contents with read_contents, and send them in the contents optional. If contents is not None, then readbyte will never be called, and no attempt will be made to read the header or length.

val decode_ber_bool : ?peek:bool ->
       ?cls:ber_class ->
       ?tag:int -> ?contents:string option -> readbyte -> bool
Encoding/Decoding of the boolean primative ASN.1 type. Encode function encodes a valid ber type, including the header and length octets.
val encode_ber_bool : ?cls:ber_class -> ?tag:int -> bool -> string
val decode_ber_int32 : ?peek:bool ->
       ?cls:ber_class ->
       ?tag:int -> ?contents:string option -> readbyte -> int32
Encoding/Decoding of the integer primative ASN.1 type. Note, in this library, integers are represented as 32 bit values. In ASN.1 there is no practical limit to the size of an integer, later on, this library may provide an encoder/decoder to Int64, and Bigints, however for now, this will have to do. Encode function encodes a valid ber type, including the header and length octets
val encode_ber_int32 : ?cls:ber_class -> ?tag:int -> int32 -> string
val decode_ber_enum : ?peek:bool ->
       ?cls:ber_class ->
       ?tag:int -> ?contents:string option -> readbyte -> int32
Encoding/Decoding of enum primative ASN.1 type. Enums are simply integers, the same drawbacks apply as for decode_ber_int32. Encode function encodes a valid ber type, including the header and length octets
val encode_ber_enum : ?cls:ber_class -> ?tag:int -> int32 -> string
val decode_ber_octetstring : ?peek:bool ->
       ?cls:ber_class ->
       ?tag:int -> ?contents:string option -> readbyte -> string
Encoding/Decoding of octetstring ASN.1 types. The Nested or "segmented" version of the octetstring encoding described in X.690 is not yet supported. Encode function encodes a valid ber type, including the header and length octets
val encode_ber_octetstring : ?cls:ber_class -> ?tag:int -> string -> string
val decode_ber_null : ?peek:bool ->
       ?cls:ber_class ->
       ?tag:int -> ?contents:string option -> readbyte -> unit
Encoding/Decoding of Null ASN.1 type. Almost useful as an assertion-type operation
val encode_ber_null : ?cls:ber_class -> ?tag:int -> unit -> string
val encode_berval_list : ?buf:Buffer.t -> ('a -> string) -> 'a list -> string
this function is for encoding lists of bervals, a common case. you pass it a list of things to encode, and an encoding function, and it will apply the encoding function to each element in the list, storing the resulting encoding in a buffer (which you may either pass in or not)
val decode_berval_list : ?lst:'a list -> (readbyte -> 'a) -> readbyte -> 'a list
this is the reverse of the above, it takes a readbyte structure, and returns a list of decoded elements, processed according to the decoder function you pass in. Note, that you MUST pass a readbyte structure built with readbyte_of_string, OR, your reabyte function must raise Stream.Failure when you reach the end of input. Otherwise this function will explode. That said, it is usually not practical to pass anything but a readbyte created by readbyte_of_string so this should not be a huge problem.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_dn.html0000644000175000017500000001044710444405446020357 0ustar gildorgildor Ldap_dn
Previous  Up  Next

Module Ldap_dn


module Ldap_dn: sig .. end
operations on ldap dns

operations on ldap dns
exception Invalid_dn of int * string
raised when something goes wrong with conversion to or from a string. The integer argument is the charachter which the lexer was looking at then the failure ocurred. In the case of to_string the integer argument will always be zero.
val of_string : string -> Ldap_types.dn
Given a string representation of a dn, return a structured representation. unescapes any escape sequences present.
val to_string : Ldap_types.dn -> string
Given a structural representation of a dn, return a string representation. Performs all the necessary escaping to correctly represent any structured representation.
val escape_value : string -> string
Escape a string which you intend to be part of a VALUE in the dn. Do not use on the whole dn, just an attribute value. It is NOT necessary to use this if you intend to call to_string on your dn. It will be done for you as part of the conversion process. This function is exposed for the case where you find it easier to manipulate the dn via a regular expression, or other string based means, and you find it necessary to escape values.
val canonical_dn : string -> string
returns the canonical dn. A simple string compare can tell you accurately whether two canonical dns are equal or not.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_error.html0000644000175000017500000001035010444405446021100 0ustar gildorgildor Ldap_error
Previous  Up  Next

Module Ldap_error


module Ldap_error: sig .. end
given an ldap error code return a string describing it
val err2string : [> `ADMINLIMIT_EXCEEDED
        | `ALIAS_DEREF_PROBLEM
        | `ALIAS_PROBLEM
        | `ALREADY_EXISTS
        | `AUTH_METHOD_NOT_SUPPORTED
        | `BUSY
        | `COMPARE_FALSE
        | `COMPARE_TRUE
        | `CONFIDENTIALITY_REQUIRED
        | `CONSTRAINT_VIOLATION
        | `INAPPROPRIATE_AUTH
        | `INAPPROPRIATE_MATCHING
        | `INSUFFICIENT_ACCESS
        | `INVALID_CREDENTIALS
        | `INVALID_DN_SYNTAX
        | `INVALID_SYNTAX
        | `LOCAL_ERROR
        | `LOOP_DETECT
        | `NAMING_VIOLATION
        | `NOT_ALLOWED_ON_NONLEAF
        | `NOT_ALLOWED_ON_RDN
        | `NO_OBJECT_CLASS_MODS
        | `NO_SUCH_ATTRIBUTE
        | `NO_SUCH_OBJECT
        | `OBJECT_CLASS_VIOLATION
        | `OPERATIONS_ERROR
        | `OTHER
        | `PROTOCOL_ERROR
        | `REFERRAL
        | `SASL_BIND_IN_PROGRESS
        | `SERVER_DOWN
        | `SIZELIMIT_EXCEEDED
        | `STRONG_AUTH_REQUIRED
        | `SUCCESS
        | `TIMELIMIT_EXCEEDED
        | `TYPE_OR_VALUE_EXISTS
        | `UNAVAILABLE
        | `UNAVAILABLE_CRITICAL_EXTENSION
        | `UNDEFINED_TYPE
        | `UNWILLING_TO_PERFORM ] ->
       string
given an ldap error code return a string describing it
val ldap_strerror : string -> exn -> string
return a string with a human readable description of an LDAP_Failure exception
val ldap_perror : string -> exn -> unit
print to stderr a string with a human readable description of an LDAP_Failure exception
ocamldap-2.1.8/doc/ocamldap/html/Ldap_filter.html0000644000175000017500000001216010444405446021235 0ustar gildorgildor Ldap_filter
Previous  Up  Next

Module Ldap_filter


module Ldap_filter: sig .. end
operations on ldap search filters

Copyright (C) 2004 Eric Stokes, and The California State University at Northridge

This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

exception Invalid_filter of int * string
raised when something goes wrong in to_string or of_string. The integer argument is, in the case of of_string, the position in the string at which the error occurred. It has no meaning in to_string, and may take any value.
val of_string : string -> Ldap_types.filter
turn the string representation into the internal representation defined in ldap_types.ml. This representation is suitable for sending on the wire, and can also have all sorts of operations performed on it. play around with it in the toplevel to get a feel for it
val to_string : Ldap_types.filter -> string
turn an internal representaion of a filter into a string representaion compliant with rfc2254
val escape_filterstring : string -> string
escape a string which is intended to be the VALUE of an attribute assertion in a filter. Do not use this on a whole filter, it will destroy all the meta chars. Use it only on the VALUE part of the assertion. It is NOT necessary to use this function if you intend to call to_string, escaping will be done for you in that case. This function is exposed because you may want to manipulate a filter with a regular expression, or other string means, and you may find it necessary to escape values manually in that case.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_funclient.html0000644000175000017500000003327310444405446021747 0ustar gildorgildor Ldap_funclient
Previous  Up  Next

Module Ldap_funclient


module Ldap_funclient: sig .. end
a functional ldap client interface
type msgid 
type conn 
type modattr = Ldap_types.modify_optype * string * string list 
type result = Ldap_types.search_result_entry list 
type entry = Ldap_types.search_result_entry 
type authmethod = [ `SASL | `SIMPLE ] 
type search_result = [ `Entry of entry | `Referral of string list ] 
val init : ?connect_timeout:int -> ?version:int -> string list -> conn
Initializes the conn data structure, and opens a connection to the server. init ["ldap://rrhost.example.com/";"ldap://backup.example.com:1389"]. init is round robin dns aware, if dns returns multiple mappings it will try each one before finially failing. It also takes a list of hostnames, so you can specify backup servers to try. SSL and TLS are supported if selected at compile time.
Raises
version : the protocol version to use to connect, default is version 3. And actually, version 2 will probably not work correctly without some tweaking.
val unbind : conn -> unit
close the connection to the server. You may not use the conn after you have unbound, if you do you will get an exception.
val bind_s : ?who:string ->
       ?cred:string -> ?auth_method:[> `SIMPLE ] -> conn -> unit
authenticatite to the server. In this version only simple binds are supported, however the ldap_protocol.ml module DOES implement sasl binds. It would be fairly easy to support them here. We eventually will.
Raises
who : the dn to bind as
cred : the credentials to authenticate with. For `SIMPLE binds this is a password, but for `SASL binds it can be nearly anything. Perhaps a hash of the thumb print of your first born is sufficent.
auth_method : either `SIMPLE (the default) or `SASL
val search : ?base:string ->
       ?scope:Ldap_types.search_scope ->
       ?aliasderef:Ldap_types.alias_deref ->
       ?sizelimit:int32 ->
       ?timelimit:int32 ->
       ?attrs:string list ->
       ?attrsonly:bool -> conn -> string -> msgid
Search for the given entry with the specified base node and search scope, optionally limiting the returned attributes to those listed in 'attrs'. aliasderef sets the server's alias dereferencing policy, sizelimit is the number of entries to return, timelimit is the number of seconds to allow the search to run for, attrsonly tells the server not to return the values. This is the asyncronus version of search (it does not block) you will need to call the get_search_entry function below to actually get any data back. This function will return a msgid which you must use when you call get_search_entry.
Raises
base : The dn of the object in the tree to use as the base object, the search will only cover children of this object, and will be further governed by scope.
scope : The depth in the tree to look for the requested object. There are three possible values, `BASE, `ONELEVEL, and `SUBTREE. `BASE means to only search the base object, the search will return exactly 1 or 0 objects. `ONELEVEL means to search one level under the base, only immediate children of the base object will be considered. `SUBTREE means to search the entire tree under the base object.
aliasderef : Controls when aliases are dereferenced.
sizelimit : The maximum number of objects to return
timelimit : The maximum time, in seconds, that the search will be allowed to run before terminateing.
attrs : The list of attribute types (names) to include [] (the default) means all.
attrsonly : return only attribute types (names), not any of the values
val get_search_entry : conn ->
       msgid ->
       [> `Entry of Ldap_types.search_result_entry | `Referral of string list ]
fetch a search entry from the wire using the given msgid. The entry could be a search entry, OR it could be a referral structure.
Raises 
val abandon : conn -> msgid -> unit
abandon the async request attached to msgid.
Raises Encoding_error for encoder errors (unlikely, probably a bug)
val search_s : ?base:string ->
       ?scope:Ldap_types.search_scope ->
       ?aliasderef:Ldap_types.alias_deref ->
       ?sizelimit:int32 ->
       ?timelimit:int32 ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       conn ->
       string ->
       [> `Entry of Ldap_types.search_result_entry | `Referral of string list ] list
This is the syncronus version of search. It blocks until the search is complete, and returns a list of objects. It is exactly the same in all other ways.
val add_s : conn -> entry -> unit
add entry to the directory
Raises 
val delete_s : conn -> dn:string -> unit
delete the entry named by dn from the directory
Raises 
val modify_s : conn ->
       dn:string ->
       mods:(Ldap_types.modify_optype * string * string list) list -> unit
apply the list of modifications to the named entry
Raises
dn : The dn of the object to modify
mods : The list of modifications to apply
val modrdn_s : ?deleteoldrdn:bool ->
       ?newsup:'a option -> conn -> dn:string -> newdn:string -> unit
change the rdn, and optionally the superior entry of dn
Raises
deleteoldrdn : Delete the old rdn value, (default true)
newsup : The new superior dn of the object (default None)
dn : The dn of the object to modify
ocamldap-2.1.8/doc/ocamldap/html/Ldap_funserver.html0000644000175000017500000002263510444405446021777 0ustar gildorgildor Ldap_funserver
Previous  Up  Next

Module Ldap_funserver


module Ldap_funserver: sig .. end
A functional ldap server construction kit
exception Server_error of string
raised whenever an error occurrs in the server
type connection_id = int

type backendInfo = {
   bi_op_bind : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_unbind : (connection_id -> Ldap_types.ldap_message -> unit) option;
   bi_op_search : (connection_id ->
Ldap_types.ldap_message -> unit -> Ldap_types.ldap_message)
option;
   bi_op_compare : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_modify : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_modrdn : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_add : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_delete : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_op_abandon : (connection_id -> Ldap_types.ldap_message -> unit) option;
   bi_op_extended : (connection_id ->
Ldap_types.ldap_message -> Ldap_types.ldap_message)
option;
   bi_init : (unit -> unit) option;
   bi_close : (unit -> unit) option;
}
This structure is the guts of the ldap server. For each operation that you implement put the function (or closure) of the correct type in this structure. Any functions you set as None will return `UNWILLING_TO_PERFORM, with the error string set to "not implemented". bi_init will be called (if it is provided) before the server is brought up, and bi_close (if it is provided) will be called before the server is brought down. This interface is based loosely on the back-end api in OpenLDAP.
type log_level = [ `CONNECTION | `ERROR | `GENERAL | `OPERATIONS | `TRACE ]

This abstract type contains the server context. It has the listening, socket, all the connected client sockets, and some internal data structures.
type server_info 
val init : ?log:(log_level -> string -> unit) ->
       ?port:int -> backendInfo -> server_info
Initialize the server, create the listening socket and return the server context, which you will pass to serv to process connections. log is a string -> log_level -> unit function to which log messages will be sent.
val shutdown : server_info -> unit
Shutdown the server
val run : server_info -> unit
Using the supplied server context, begin processing ldap operations. This function should never terminate unless there is an exceptional condition, in which case the exception will be raised. In many cases it is safe to restart the server process when an exception happens.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_mutex.html0000644000175000017500000001265310444405446021121 0ustar gildorgildor Ldap_mutex
Previous  Up  Next

Module Ldap_mutex


module Ldap_mutex: sig .. end
functions for implementing mutexes on top of LDAP's built in test and set mechanism. In order to use this module you must load mutex.schema, which is an rfc2252 format schema file. raised when a mutex operation fails. The string argument contains the name of the method which failed, and the exception contains details about what failed.
exception Ldap_mutex of string * exn
functions for implementing mutexes on top of LDAP's built in test and set mechanism. In order to use this module you must load mutex.schema, which is an rfc2252 format schema file. raised when a mutex operation fails. The string argument contains the name of the method which failed, and the exception contains details about what failed.
class type mutex_t = object .. end
the class type of a single mutex, used for performing advisory locking of some action 
class type object_lock_table_t = object .. end
the class type of an object lock table which allows for advisory locking of objects by dn 
class mutex : string list -> string -> string -> string -> object .. end
new mutex ldapurls binddn bindpw mutexdn 
val apply_with_mutex : mutex -> (unit -> 'a) -> 'a
used to apply some function, first locking the mutex, unlocking it only after the function has been applied. If the function generates any exception, this wrapper catches that exception, and unlocks the mutex before reraising the exception. Generally garentees that the mutex will always be used consistantly when performing an action.
class object_lock_table : string list -> string -> string -> string -> object .. end
new object_lock_table ldapurls binddn bindpw mutexdn
ocamldap-2.1.8/doc/ocamldap/html/Ldap_mutex.mutex.html0000644000175000017500000000530610444405446022257 0ustar gildorgildor Ldap_mutex.mutex
 Up  Next

Class Ldap_mutex.mutex


class mutex : string list -> string -> string -> string -> object .. end
new mutex ldapurls binddn bindpw mutexdn
method lock : unit
lock the mutex. This WILL block if the mutex is already locked

unlock the mutex

method unlock : unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_mutex.mutex_t.html0000644000175000017500000000513010444405446022575 0ustar gildorgildor Ldap_mutex.mutex_t
 Up  Next

Class type Ldap_mutex.mutex_t


class type mutex_t = object .. end
the class type of a single mutex, used for performing advisory locking of some action
method lock : unit
method unlock : unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_mutex.object_lock_table.html0000644000175000017500000000566710444405446024554 0ustar gildorgildor Ldap_mutex.object_lock_table
Previous  Up  

Class Ldap_mutex.object_lock_table


class object_lock_table : string list -> string -> string -> string -> object .. end
new object_lock_table ldapurls binddn bindpw mutexdn
method lock : Ldap_types.dn -> unit
lock the specified dn, if it is already locked, then block until the lock can be aquired

unlock the specified dn, if it is not locked do nothing

method unlock : Ldap_types.dn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_mutex.object_lock_table_t.html0000644000175000017500000000540010444405446025060 0ustar gildorgildor Ldap_mutex.object_lock_table_t
Previous  Up  

Class type Ldap_mutex.object_lock_table_t


class type object_lock_table_t = object .. end
the class type of an object lock table which allows for advisory locking of objects by dn
method lock : Ldap_types.dn -> unit
method unlock : Ldap_types.dn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.html0000644000175000017500000006015310444405446021571 0ustar gildorgildor Ldap_ooclient
Previous  Up  Next

Module Ldap_ooclient


module Ldap_ooclient: sig .. end
an object oriented ldap client interface

Basic Data Types


type op = string * string list
the type of an operation, eg. ("cn", ["foo";"bar"])
type op_lst = op list 
type referral_policy = [ `FOLLOW | `RETURN ]
The policy the client should take when it encounteres a referral. This is currently not used
type changetype = [ `ADD | `DELETE | `MODDN | `MODIFY | `MODRDN ]
The change type of an ldapentry. This controls some aspects of it's behavior

Local Representation of LDAP Objects


class type ldapentry_t = object .. end
The base type of an ldap entry represented in memory. 
class ldapentry : object .. end
this object represents a remote object within local memory.

Miscallaneous


val format_entry : < attributes : string list; dn : string; get_value : string -> string list;
         .. > ->
       unit
toplevel formatter for ldapentry, prints the whole entry with a nice structure. Each attribute is in the correct syntax to be copied and pasted into a modify operation.
val format_entries : < attributes : string list; dn : string; get_value : string -> string list;
         .. >
       list -> unit
format lists of entries, in this case only print the dn
type changerec = [ `Addition of ldapentry
       | `Delete of string
       | `Modification of
           string * (Ldap_types.modify_optype * string * string list) list
       | `Modrdn of string * int * string ]
The type of an ldap change record, used by extended LDIF

Communication With Ldap_funclient
val to_entry : [< `Entry of Ldap_types.search_result_entry | `Referral of string list ] ->
       ldapentry
given a search_result_entry as returned by ldap_funclient, produce an ldapentry containing either the entry, or the referral object
val of_entry : ldapentry -> Ldap_types.search_result_entry
given an ldapentry as returned by ldapcon, or constructed manually, produce a search_result_entry suitable for ldap_funclient, or ldap_funserver.

Interacting with LDAP Servers


class ldapcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> object .. end
This class abstracts a connection to an LDAP server (or servers), an instance will be connected to the server you specify and can be used to perform operations on that server.

Iterators Over Streams of ldapentry Objects


val iter : (ldapentry -> unit) ->
       (?abandon:bool -> unit -> ldapentry) -> unit
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a, apply f (first arg) to each entry See List.iter
val rev_map : (ldapentry -> 'a) ->
       (?abandon:bool -> unit -> ldapentry) -> 'a list
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a apply f (first arg) to each entry in reverse, and return a list containing the result of each application. See List.map
val map : (ldapentry -> 'a) ->
       (?abandon:bool -> unit -> ldapentry) -> 'a list
same as rev_map, but does it in order
val fold : (ldapentry -> 'a -> 'a) ->
       'a -> (?abandon:bool -> unit -> ldapentry) -> 'a
given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a compute (f eN ... (f e2 (f e1 intial))) see List.fold_right.

Schema Aware ldapentry Derivatives



General Schema Aware Entry

Ldap_ooclient.scldapentry, A schema aware derivative of Ldap_ooclient.ldapentry. It contains an rfc2252 schema checker, and given the database schema, it can be used to garentee that operations performed in memory are valid against a standards compliant database. It has numerious uses, translation between two databases with different schemas an example of where it finds natural usage. For an example application
module OrdOid: sig .. end
an ordered oid type, for placing oids in sets 
module Setstr: sig .. end
A set of Oids

type scflavor =
| Optimistic (*Add missing attributes to make the object consistant, or add objectclasses in order to make illegal attribues legal*)
| Pessimistic (*Delete objectclasses which must attributes which are missing, and delete illegal attributes.*)
The type of schema checking to perform in Ldap_ooclient.scldapentry. Normally this is picked automatically, however it can be overridden in some cases.
val attrToOid : Ldap_schemaparser.schema ->
       Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t
given a name of an attribute name (canonical or otherwise), return its oid
Raises Invalid_attribute If the attribute is not found in the schema.
val oidToAttr : Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string
given the oid of an attribute, return its canonical name
Raises Invalid_attribute If the attribute is not found in the schema.
val ocToOid : Ldap_schemaparser.schema ->
       Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t
given a name of an objectclass (canonical or otherwise), return its oid.
Raises Invalid_objectclass If the objectclass is not found in the schema.
val oidToOc : Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string
given the oid of an objectclass, return its canonical name
Raises Invalid_objectclass If the objectclass is not found in the schema.
val getOc : Ldap_schemaparser.schema ->
       Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.objectclass
get an objectclass structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster)
Raises Invalid_objectclass If the objectclass is not found in the schema.
val getAttr : Ldap_schemaparser.schema ->
       Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.attribute
get an attr structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster)
Raises Invalid_attribute If the attribute is not found in the schema.
val equateAttrs : Ldap_schemaparser.schema ->
       Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Lcstring.t -> bool
equate attributes by oid. This allows non canonical names to be handled correctly, for example "uid" and "userID" are actually the same attribute.
Raises Invalid_attribute If either attribute is not found in the schema.
exception Invalid_objectclass of string
exception Invalid_attribute of string
exception Single_value of string
exception Objectclass_is_required
class scldapentry : Ldap_schemaparser.schema -> object .. end

Schema Aware Entry for Account Managment

A derivative of Ldap_ooclient.scldapentry which includes abstractions for managing user accounts in the directory. This class is experimantal, and may be drastically changed in the next version. As with all experimental code, use with caution. A few of its features.



type generator = {
   gen_name : string;
   required : string list;
   genfun : ldapentry_t -> string list;
}
The structure of a generator

type service = {
   svc_name : string;
   static_attrs : (string * string list) list;
   generate_attrs : string list;
   depends : string list;
}
The structure of a service

type generation_error =
| Missing_required of string list
| Generator_error of string
The type of error raised by attribute generators
exception No_generator of string
You've asked it to generate an attribute (in a service) which doesn't have a generator
exception Generation_failed of generation_error
Generator has failed because of some kind of error
exception No_service of string
The service you're talking about doesn't exist
exception Service_dep_unsatisfiable of string
A service which the one you tried to add depends on doesn't exists
exception Generator_dep_unsatisfiable of string * string
Your generator depends on an attribute which isn't in the schema
exception Cannot_sort_dependancies of string list
You have detached cycles in your generator dependancy lists
class ldapaccount : Ldap_schemaparser.schema -> (string, generator) Hashtbl.t -> (string, service) Hashtbl.t -> object .. end
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.ldapaccount.html0000644000175000017500000002235610444405446024070 0ustar gildorgildor Ldap_ooclient.ldapaccount
Previous  Up  

Class Ldap_ooclient.ldapaccount


class ldapaccount : Ldap_schemaparser.schema -> (string, generator) Hashtbl.t -> (string, service) Hashtbl.t -> object .. end

Account Manipulation Methods

method add_service : string -> unit
add the named service to the object, this also adds all the services depended upon by the named service.
method delete_service : string -> unit
Delete the named service. This will also delete all services which depend on it, either directly or indirectly
method adapt_service : service -> service
Run service through the delta engine to find out what changes would actually be applied to this object
method service_exists : string -> bool
Tests whether the named service is satisfied by the current entry. A service is satisfied if no changes would result from adding it to the entry.
method services_present : string list
Return a list of all the named services which are satisfied by the current entry.
method add_generate : string -> unit
add the named attribute to the list of attributes to be generated
method delete_generate : string -> unit
Delete the named attribute from the list of attributes to generate
method generate : unit
Run the generation functions on the list of attributes to be generated, saving the results in the entry. You must run this method in order to run any generators at all.

Inherited Methods

Unless explicitly stated, these methods do exactly the same thing as in Ldap_ooclient.scldapentry
method add : op_lst -> unit
Missing attributes may be marked for generation.
method attributes : string list
method changes : (Ldap_types.modify_optype * string * string list) list
method changetype : changetype
method delete : op_lst -> unit
method dn : string
method diff : ldapentry_t ->
       (Ldap_types.modify_optype * string * string list) list
method exists : string -> bool
method flush_changes : unit
method get_value : string -> string list
If a missing attribute is marked for generation its value will be "generate" instead of "required"
method is_allowed : string -> bool
method is_missing : string -> bool
method list_allowed : Setstr.elt list
method list_missing : Setstr.elt list
method list_present : Setstr.elt list
method modify : (Ldap_types.modify_optype * string * string list) list -> unit
method of_entry : ?scflavor:scflavor -> ldapentry -> unit
method print : unit
Deprecated.Missing required attributes which will be generated are shown as "attrname: generate" instead of "attrname: required"
method replace : op_lst -> unit
method set_changetype : changetype -> unit
method set_dn : string -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.ldapadvisorytxcon.html0000644000175000017500000001734110444405446025346 0ustar gildorgildor Ldap_ooclient.ldapadvisorytxcon
Previous  Up  Next

Class Ldap_ooclient.ldapadvisorytxcon


class ldapadvisorytxcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> string -> string -> string -> object .. end
A subclass of ldapcon which implements an experimental interface to draft_zeilenga_ldap_txn. A draft standard for multi object transactions over the ldap protocol. This class can only implement advisory transactions because it must depend on the advisory locking mechanisms for the transactions to be consistant. You use this class by calling begin_txn to get a transaction id, and then associating a set of ldapentry objects with the transaction by calling associate_entry_with_txn. You are then free to modify those entries in any way you like, and when you are done, you can either call commit_txn, or rollback_txn. Commit will commit the changes of all the entries associated with the transaction to the database. For other writers which obey advisory locking the commit operation is atomic. For readers which are willing to obey advisory locking is atomic. If the commit fails, a full rollback occurrs, including all changes made to the directory. For example in a set of N entries in a transaction, if the modificiation of the nth entry fails to commit, then the modifications to all the previous entries, which have already been made in the directory, are undone. It is important to note that if advisory locking is not obeyed, rollback may not be successful. Rollback undoes all the changes you've made in memory, and unlocks all the objects in the transaction. After a transaction object has been commited or rolled back it is considered "dead", and cannot be used again.
method add : ldapentry -> unit
method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
method delete : string -> unit
method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit
method modrdn : string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
method rawschema : ldapentry
method schema : Ldap_schemaparser.schema
method search : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool -> ?base:string -> string -> ldapentry list
method search_a : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       ?base:string -> string -> ?abandon:bool -> unit -> ldapentry
method unbind : unit
method update_entry : ldapentry -> unit
method begin_txn : txn
method associate_entry : txn -> ldapentry_t -> unit
method associate_entries : txn -> ldapentry_t list -> unit
method disassociate_entry : txn -> ldapentry_t -> unit
method disassociate_entries : txn -> ldapentry_t list -> unit
method commit_txn : txn -> unit
method rollback_txn : txn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.ldapcon.html0000644000175000017500000003234610444405446023213 0ustar gildorgildor Ldap_ooclient.ldapcon
Previous  Up  Next

Class Ldap_ooclient.ldapcon


class ldapcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> object .. end
This class abstracts a connection to an LDAP server (or servers), an instance will be connected to the server you specify and can be used to perform operations on that server.

Example

new ldapcon ~connect_timeout:5 ~version:3 ["ldap://first.ldap.server";"ldap://second.ldap.server"].

In addition to specifying multiple urls, if DNS names are given, and those names are bound to multiple addresses, then all possible addresses will be tried.

Example

new ldapcon ["ldaps://rrldap.csun.edu"]

is equivelant to

new ldapcon ["ldap://130.166.1.30";"ldap://130.166.1.31";"ldap://130.166.1.32"]

This means that if any host in the rr fails, the ldapcon will transparently move on to the next host, and you will never know the difference.
Raises LDAP_Failure All methods raise Ldap_types.LDAP_Failure on error

connect_timeout : Default 1, an integer which specifies how long to wait for any given server in the list to respond before trying the next one. After all the servers have been tried for connect_timeout seconds LDAP_Failure (`SERVER_DOWN, ...) will be raised.
referral_policy : In a future version of ocamldap this will be used to specify what you would like to do in the event of a referral. Currently it does nothing and is ignored see Ldap_ooclient.referral_policy.
version : The protocol version to use, the default is 3, the other recognized value is 2.

Authentication

method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
bind to the database using dn.

Simple Bind Example

ldap#bind ~cred:"password" "cn=foo,ou=people,ou=auth,o=bar"

To bind anonymously, omit ~cred, and leave dn blank eg.

Example

ldap#bind ""

cred : The credentials to provide for binding. Default "".
meth : The method to use when binding See Ldap_funclient.authmethod the default is `SIMPLE. If `SASL is used then dn and ~cred Are interperted according to the chosen SASL mechanism. SASL binds have not been tested extensively.
method unbind : unit
Deauthenticate and close the connection to the server

Searching

method search : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       ?base:string ->
       ?sizelimit:Int32.t ->
       ?timelimit:Int32.t -> string -> ldapentry list
Search the directory syncronously for an entry which matches the search criteria.

Example

ldap#search ~base:"dc=foo,dc=bar" ~attrs:["cn"] "uid=*"

scope : Default `SUBTREE, defines the scope of the search. see Ldap_types.search_scope
attrs : Default [] (means all attributes)
attrsonly : Default false If true, asks the server to return only the attribute names, not their values.
base : Default "", The search base, which is the dn of the object from which you want to start your search. Only that object, and it's children will be included in the search. Further controlled by ~scope.
sizelimit : The max number of entries to return from the search (in number of entries)
timelimit : The time limit (in seconds) to allow the search to run for. Default 0l, which means there is no user specified time limit, the server may still impose one.
method search_a : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       ?base:string ->
       ?sizelimit:Int32.t ->
       ?timelimit:Int32.t ->
       string -> ?abandon:bool -> unit -> ldapentry
Search the directory asyncronously, otherwise the same as search.
method rawschema : ldapentry
Fetch the raw (unparsed) schema from the directory using the standard mechanism (requires protocol version 3)
method schema : Ldap_schemaparser.schema
Fetch and parse the schema from the directory via the standard mechanism (requires version 3). Return a structured representation of the schema indexed by canonical name, and oid.

Making Modifications

method add : ldapentry -> unit
add an entry to the database
method delete : string -> unit
Delete the object named by dn from the database
method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit
Modify the entry named by dn, applying mods

Example

ldap#modify "uid=foo,ou=people,dc=bar,dc=baz" [(`DELETE, "cn", ["foo";"bar"])]

method update_entry : ldapentry -> unit
Syncronize changes made locally to an ldapentry with the directory.
method modrdn : string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
Modify the rdn of the object named by dn, if the protocol version is 3 you may additionally change the superior, the rdn will be changed to the attribute represented (as a string) by newrdn,

Example With New Superior

ldap#modrdn ~newsup:(Some "o=csun") "cn=bob,ou=people,o=org" "uid=bperson"

After this example "cn=bob,ou=people,o=org" will end up as "uid=bperson,o=csun".

deleteoldrdn : Default true, delete the old rdn value as part of the modrdn.
newsup : Default None, only valid when the protocol version is 3, change the object's location in the tree, making its superior equal to the specified object.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.ldapentry.html0000644000175000017500000001605710444405446023576 0ustar gildorgildor Ldap_ooclient.ldapentry
 Up  Next

Class Ldap_ooclient.ldapentry


class ldapentry : object .. end
this object represents a remote object within local memory. It records all local changes made to it (if it's changetype is set to `MODIFY), and can commit them to the server at a later time via Ldap_ooclient.ldapcon.update_entry.
method add : op_lst -> unit
add values to an attribute (or create a new attribute). Does not change the server until you update
method attributes : string list
return a list of the type (name) of all the attributes present on the object
method changes : (Ldap_types.modify_optype * string * string list) list
return a list of changes made to the object in a the format of a modify operation. For example, you can apply the changes to another ldapentry object using the Ldap_ooclient.ldapentry.modify method
method changetype : changetype
return the changetype of the object
method delete : op_lst -> unit
delete attributes from the object, does not change the directory until you update
method dn : string
return the dn of the object
method diff : ldapentry_t ->
       (Ldap_types.modify_optype * string * string list) list
given an ldapentry, return the differences between the current entry and the specified entry in the form of a modify operation which would make the specified entry the same as the current entry.
method exists : string -> bool
query whether the attribute type (name) exists in the object
method flush_changes : unit
clear all accumulated changes
method get_value : string -> string list
get the value of an attribute
Raises Not_found If the attribute does not exist.
method modify : (Ldap_types.modify_optype * string * string list) list -> unit
Apply modifications to object in memory, does not change the database until you update using Ldap_ooclient.ldapcon.update_entry
method print : unit
Deprecated.print an ldif like representation of the object to stdout, see Ldif_oo for standards compliant ldif. Usefull for toplevel sessions.
method replace : op_lst -> unit
replace values in the object, does not change the database until you call update
method set_changetype : changetype -> unit
set the changetype of the object
method set_dn : string -> unit
set the dn of the object
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html0000644000175000017500000001120710444405446024111 0ustar gildorgildor Ldap_ooclient.ldapentry_t
 Up  

Class type Ldap_ooclient.ldapentry_t


class type ldapentry_t = object .. end
The base type of an ldap entry represented in memory.
method add : op_lst -> unit
method attributes : string list
method changes : (Ldap_types.modify_optype * string * string list) list
method changetype : changetype
method delete : op_lst -> unit
method dn : string
method diff : ldapentry_t ->
       (Ldap_types.modify_optype * string * string list) list
method exists : string -> bool
method flush_changes : unit
method get_value : string -> string list
method modify : (Ldap_types.modify_optype * string * string list) list -> unit
method print : unit
method replace : op_lst -> unit
method set_changetype : changetype -> unit
method set_dn : string -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.mutex.html0000644000175000017500000000537710444405446022741 0ustar gildorgildor Ldap_ooclient.mutex
Previous  Up  Next

Class Ldap_ooclient.mutex


class mutex : string list -> string -> string -> string -> object .. end
new mutex ldapurls binddn bindpw mutexdn
method lock : unit
lock the mutex. This WILL block if the mutex is already locked

unlock the mutex

method unlock : unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.mutex_t.html0000644000175000017500000000523110444405446023251 0ustar gildorgildor Ldap_ooclient.mutex_t
Previous  Up  Next

Class type Ldap_ooclient.mutex_t


class type mutex_t = object .. end
the class type of a single mutex, used for performing advisory locking of some action
method lock : unit
method unlock : unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.object_lock_table.html0000644000175000017500000000577410444405446025225 0ustar gildorgildor Ldap_ooclient.object_lock_table
Previous  Up  Next

Class Ldap_ooclient.object_lock_table


class object_lock_table : string list -> string -> string -> string -> object .. end
new object_lock_table ldapurls binddn bindpw mutexdn
method lock : Ldap_types.dn -> unit
lock the specified dn, if it is already locked, then block until the lock can be aquired

unlock the specified dn, if it is not locked do nothing

method unlock : Ldap_types.dn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.object_lock_table_t.html0000644000175000017500000000531710444405446025541 0ustar gildorgildor Ldap_ooclient.object_lock_table_t
Previous  Up  

Class type Ldap_ooclient.object_lock_table_t


class type object_lock_table_t = object .. end
the class type of an object lock table which allows for advisory locking of objects by dn
method lock : Ldap_types.dn -> unit
method unlock : Ldap_types.dn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.OrdOid.html0000644000175000017500000000526510444405446022753 0ustar gildorgildor Ldap_ooclient.OrdOid
 Up  Next

Module Ldap_ooclient.OrdOid


module OrdOid: sig .. end
an ordered oid type, for placing oids in sets
type t = Ldap_schemaparser.Oid.t 
val compare : t -> t -> int
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.OrdStr.html0000644000175000017500000000410510444405446023000 0ustar gildorgildor Ldap_ooclient.OrdStr
 Up  Next

Module Ldap_ooclient.OrdStr


module OrdStr: sig .. end
type t = Ldap_schemaparser.Oid.t 
val compare : Ldap_schemaparser.Oid.t -> Ldap_schemaparser.Oid.t -> int
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.scldapentry.html0000644000175000017500000003017210444405446024116 0ustar gildorgildor Ldap_ooclient.scldapentry
Previous  Up  Next

Class Ldap_ooclient.scldapentry


class scldapentry : Ldap_schemaparser.schema -> object .. end

New Methods

method is_allowed : string -> bool
Returns true if the attributed specified is allowed by the current set of objectclasses present on the entry.
method is_missing : string -> bool
Returns true if the attribute specified is a must, but is not currently present.
method list_allowed : Setstr.elt list
Return a list of all attributes allowed on the entry (by oid)
method list_missing : Setstr.elt list
Return a list of all missing attributes (by oid)
method list_present : Setstr.elt list
Return a list of all present attributes. In contrast to the attributes method, this method ignores missing required attributes and just returns those attributes which are actually present.
method of_entry : ?scflavor:scflavor -> ldapentry -> unit
Given an Ldap_ooclient.ldapentry copy all of it's data into the current object, and perform a schema check.
scflavor : Default Pessimistic The schema checking bias, see Ldap_ooclient.scflavor

Inherited Methods

method add : op_lst -> unit
Add values to the entry, just as Ldap_ooclient.ldapentry.add, However, after the add is complete the schema checker is run in Optimistic mode. see Ldap_ooclient.scflavor
method delete : op_lst -> unit
Same as Ldap_ooclient.ldapentry.add, except that the schema checker is run in Pessimistic mode after the operation is complete. see Ldap_ooclient.scflavor
method replace : op_lst -> unit
Same as Ldap_ooclient.ldapentry.replace except that once the replace has completed the schema checker is run again in Optimistic mode. See Ldap_ooclient.scflavor
method attributes : string list
Same as Ldap_ooclient.ldapentry.attributes, except that the returned list contains attributes which may not yet exist on the entry. For example musts which are not yet present will be listed.
method exists : string -> bool
Same as Ldap_ooclient.ldapentry.exists except that it refrences attributes which may not yet exist. For example musts which are not yet present.
method get_value : string -> string list
Same as Ldap_ooclient.ldapentry.get_value, except that attributes which do not yet exists may be referenced. For example a must which has not yet been satisfied will return ["required"] when get_value is called on it.
method modify : (Ldap_types.modify_optype * string * string list) list -> unit
Same as Ldap_ooclient.ldapentry.modify except that the schema checker is run in Pessimistic mode after the modification is applied. see Ldap_ooclient.scflavor.
method changes : (Ldap_types.modify_optype * string * string list) list
Same as Ldap_ooclient.ldapentry.changes except that changes made by the schema checker may also be listed.
method changetype : changetype
Same as Ldap_ooclient.ldapentry.changetype
method dn : string
Same as Ldap_ooclient.ldapentry.dn
method flush_changes : unit
Same as Ldap_ooclient.ldapentry.flush_changes
method diff : ldapentry_t ->
       (Ldap_types.modify_optype * string * string list) list
Same as Ldap_ooclient.ldapentry.diff
method print : unit
Deprecated.Same as Ldap_ooclient.ldapentry.print, except that it prints attributes which may not yet be present on the object. For example, if the object has unsatisfied musts, it will print "attrname: required" for that attribute.
method set_changetype : changetype -> unit
Same as Ldap_ooclient.ldapentry.set_changetype
method set_dn : string -> unit
Same as Ldap_ooclient.ldapentry.set_dn
ocamldap-2.1.8/doc/ocamldap/html/Ldap_ooclient.Setstr.html0000644000175000017500000001775510444405446023066 0ustar gildorgildor Ldap_ooclient.Setstr
Previous  Up  

Module Ldap_ooclient.Setstr


module Setstr: sig .. end
Deprecated.the name is historical, and may be changed
A set of Oids
type elt = Ldap_ooclient.OrdOid.t 
type t = Set.Make(OrdOid).t 
val empty : t
val is_empty : t -> bool
val mem : elt -> t -> bool
val add : elt -> t -> t
val singleton : elt -> t
val remove : elt -> t -> t
val union : t -> t -> t
val inter : t -> t -> t
val diff : t -> t -> t
val compare : t -> t -> int
val equal : t -> t -> bool
val subset : t -> t -> bool
val iter : (elt -> unit) -> t -> unit
val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
val for_all : (elt -> bool) -> t -> bool
val exists : (elt -> bool) -> t -> bool
val filter : (elt -> bool) ->
       t -> t
val partition : (elt -> bool) ->
       t -> t * t
val cardinal : t -> int
val elements : t -> elt list
val min_elt : t -> elt
val max_elt : t -> elt
val choose : t -> elt
val split : elt ->
       t ->
       t * bool * t
ocamldap-2.1.8/doc/ocamldap/html/Ldap_protocol.html0000644000175000017500000000741210444405446021615 0ustar gildorgildor Ldap_protocol
Previous  Up  Next

Module Ldap_protocol


module Ldap_protocol: sig .. end
an implementation of the ldap wire protocol
val encode_resultcode : Ldap_types.ldap_resultcode -> int
return the int asociated with the specified result code
val decode_resultcode : int -> Ldap_types.ldap_resultcode
return the result code for the specified int, error codes which do not map to a code defined within the standard (or any of our own internal ones) will be represented as (`UNKNOWN_ERROR of int), where int is the unknown error code.
val encode_ldapmessage : Ldap_types.ldap_message -> string
encode a value of type ldap_message using lber and return a string which is ready to be put on the wire
val decode_ldapmessage : Lber.readbyte -> Ldap_types.ldap_message
decode an ldap_message from the wire, and build/return a structure of type ldap_message
ocamldap-2.1.8/doc/ocamldap/html/Ldap_schemaparser.html0000644000175000017500000003201210444405446022423 0ustar gildorgildor Ldap_schemaparser
Previous  Up  Next

Module Ldap_schemaparser


module Ldap_schemaparser: sig .. end
A library for parsing rfc2252 schemas as returned by directory servers
module Oid: sig .. end
val format_oid : Oid.t -> unit
module Lcstring: sig .. end
val format_lcstring : Lcstring.t -> unit

type octype =
| Abstract
| Structural
| Auxiliary

type objectclass = {
   oc_name : string list;
   oc_oid : Oid.t;
   oc_desc : string;
   oc_obsolete : bool;
   oc_sup : Lcstring.t list;
   oc_must : Lcstring.t list;
   oc_may : Lcstring.t list;
   oc_type : octype;
   oc_xattr : string list;
}
The type representing an objectclass definition

type attribute = {
   at_name : string list;
   at_desc : string;
   at_oid : Oid.t;
   at_equality : string;
   at_ordering : string;
   at_substr : Oid.t;
   at_syntax : Oid.t;
   at_length : Int64.t;
   at_obsolete : bool;
   at_single_value : bool;
   at_collective : bool;
   at_no_user_modification : bool;
   at_usage : string;
   at_sup : Lcstring.t list;
   at_xattr : string list;
}
The type representing an attribute definition

type schema = {
   objectclasses : (Lcstring.t, objectclass) Hashtbl.t;
   objectclasses_byoid : (Oid.t, objectclass) Hashtbl.t;
   attributes : (Lcstring.t, attribute) Hashtbl.t;
   attributes_byoid : (Oid.t, attribute) Hashtbl.t;
}
The type representing the whole schema. Consists of hashtbls indexed by two useful keys. For both attributes and objectclasses there exists a hashtbl indexed by OID, and one indexed by lower case canonical name. There exist functions in Ldap_ooclient to look up attributes and objectclasses by non canonical names if that is necessary for you to do. see attrToOid, and ocToOid. They will find the oid of an attribute or objectclass given any name, not just the canonical one. Not that this is somewhat (like several orders of magnitude) slower than lookups by canonical name.
val schema_print_depth : int Pervasives.ref
This reference controls the dept of printing for the schema in the toplevel. The default is 10 keys from each table will be printed. OID tables are not currently printed.
val format_schema : schema -> unit
A formatter for the schema, prints the structure, and expands the hashtbls to show the keys. The number of keys printed is controled by schema_print_depth.
exception Parse_error_oc of Lexing.lexbuf * objectclass * string
exception Parse_error_at of Lexing.lexbuf * attribute * string
exception Syntax_error_oc of Lexing.lexbuf * objectclass * string
exception Syntax_error_at of Lexing.lexbuf * attribute * string
val readSchema : string list -> string list -> schema
readSchema attribute_list objectclass_list, parse the schema into a schema type given a list of attribute definition lines, and objectclass definition lines.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_schemaparser.Lcstring.html0000644000175000017500000000566010444405446024220 0ustar gildorgildor Ldap_schemaparser.Lcstring
Previous  Up  

Module Ldap_schemaparser.Lcstring


module Lcstring: sig .. end
type t 
val of_string : string -> t
val to_string : t -> string
val compare : t -> t -> int
ocamldap-2.1.8/doc/ocamldap/html/Ldap_schemaparser.Oid.html0000644000175000017500000000560510444405446023145 0ustar gildorgildor Ldap_schemaparser.Oid
 Up  Next

Module Ldap_schemaparser.Oid


module Oid: sig .. end
type t 
val of_string : string -> t
val to_string : t -> string
val compare : t -> t -> int
ocamldap-2.1.8/doc/ocamldap/html/Ldap_toplevel.html0000644000175000017500000001173110444405446021605 0ustar gildorgildor Ldap_toplevel
Previous  Up  Next

Module Ldap_toplevel


module Ldap_toplevel: sig .. end
Functions which resemble the command line tools which many users are familar with, useful in the interactive environment
val ldapsearch : ?s:Ldap_types.search_scope ->
       ?a:string list ->
       ?b:string ->
       ?d:string -> ?w:string -> h:string -> string -> Ldap_ooclient.ldapentry list
connect to the specified host and perform a search.
s : The scope of the search, default `SUBTREE
b : The base of the search The final argument is the search filter
d : The dn of the object you with to bind as, default anonymous
w : The credentials of the object you wish to bind as, default anonymous
h : The ldapurl which names the host and port to connect to
val ldapmodify : h:string ->
       d:string ->
       w:string ->
       (string * (Ldap_types.modify_optype * string * string list) list) list ->
       unit
connect to the specified host and perform one or more modifications.
h : The ldapurl which names the host and port to connect to
d : The dn of the object you with to bind as, default anonymous
w : The credentials of the object you wish to bind as, default anonymous The final argument is a list of (dn, modification) pairs which you want to apply
val ldapadd : h:string -> d:string -> w:string -> Ldap_ooclient.ldapentry list -> unit
connect to the specified host and add the specified objects.
h : The ldapurl which names the host and port to connect to
d : The dn of the object you with to bind as, default anonymous
w : The credentials of the object you wish to bind as, default anonymous The final argument is a list of objects you wish to add
ocamldap-2.1.8/doc/ocamldap/html/Ldap_txooclient.html0000644000175000017500000000726610444405446022153 0ustar gildorgildor Ldap_txooclient
Previous  Up  

Module Ldap_txooclient


module Ldap_txooclient: sig .. end
the abstract type of a transaction
type txn
the abstract type of a transaction
exception Txn_commit_failure of string * exn * Ldap_ooclient.ldapentry_t list option
raised when a commit fails, contains a list of entries which were not rolled back successfully only if rollback failed as well, otherwise None
exception Txn_rollback_failure of string * exn
raised when an explicit rollback fails
class ldapadvisorytxcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> string -> string -> string -> object .. end
A subclass of ldapcon which implements an experimental interface to draft_zeilenga_ldap_txn.
ocamldap-2.1.8/doc/ocamldap/html/Ldap_txooclient.ldapadvisorytxcon.html0000644000175000017500000001755610444405446025732 0ustar gildorgildor Ldap_txooclient.ldapadvisorytxcon
 Up  

Class Ldap_txooclient.ldapadvisorytxcon


class ldapadvisorytxcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> string -> string -> string -> object .. end
A subclass of ldapcon which implements an experimental interface to draft_zeilenga_ldap_txn. A draft standard for multi object transactions over the ldap protocol. This class can only implement advisory transactions because it must depend on the advisory locking mechanisms for the transactions to be consistant. You use this class by calling begin_txn to get a transaction id, and then associating a set of ldapentry objects with the transaction by calling associate_entry_with_txn. You are then free to modify those entries in any way you like, and when you are done, you can either call commit_txn, or rollback_txn. Commit will commit the changes of all the entries associated with the transaction to the database. For other writers which obey advisory locking the commit operation is atomic. For readers which are willing to obey advisory locking is atomic. If the commit fails, a full rollback occurrs, including all changes made to the directory. For example in a set of N entries in a transaction, if the modificiation of the nth entry fails to commit, then the modifications to all the previous entries, which have already been made in the directory, are undone. It is important to note that if advisory locking is not obeyed, rollback may not be successful. Rollback undoes all the changes you've made in memory, and unlocks all the objects in the transaction. After a transaction object has been commited or rolled back it is considered "dead", and cannot be used again.
method add : Ldap_ooclient.ldapentry -> unit
method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
method delete : string -> unit
method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit
method modrdn : string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
method rawschema : Ldap_ooclient.ldapentry
method schema : Ldap_schemaparser.schema
method search : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       ?base:string ->
       ?sizelimit:Int32.t ->
       ?timelimit:Int32.t -> string -> Ldap_ooclient.ldapentry list
method search_a : ?scope:Ldap_types.search_scope ->
       ?attrs:string list ->
       ?attrsonly:bool ->
       ?base:string ->
       ?sizelimit:Int32.t ->
       ?timelimit:Int32.t ->
       string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
method unbind : unit
method update_entry : Ldap_ooclient.ldapentry -> unit
method begin_txn : txn
method associate_entry : txn -> Ldap_ooclient.ldapentry_t -> unit
method associate_entries : txn -> Ldap_ooclient.ldapentry_t list -> unit
method disassociate_entry : txn -> Ldap_ooclient.ldapentry_t -> unit
method disassociate_entries : txn -> Ldap_ooclient.ldapentry_t list -> unit
method commit_txn : txn -> unit
method rollback_txn : txn -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldap_types.html0000644000175000017500000007743110444405446021130 0ustar gildorgildor Ldap_types
Previous  Up  Next

Module Ldap_types


module Ldap_types: sig .. end
Common data types used by ocamldap. Most of these types are taken from the ASN.1 specification for LDAP as defined in rfc2251
See also rfc2251
exception LDAP_Encoder of string
An encoding error has occurred, the argument contains a description of the error This is likely a bug, so it should be reported
exception LDAP_Decoder of string
A decoding error has occurred, the argument contains a description of the error. This MAY be a bug, but it may also be that the server you are talking to is non standard. Please report these right away in any case.
type ldap_resultcode = [ `ADMINLIMIT_EXCEEDED
       | `AFFECTS_MULTIPLE_DSAS
       | `ALIAS_DEREF_PROBLEM
       | `ALIAS_PROBLEM
       | `ALREADY_EXISTS
       | `AUTH_METHOD_NOT_SUPPORTED
       | `AUTH_UNKNOWN
       | `BUSY
       | `CLIENT_LOOP
       | `COMPARE_FALSE
       | `COMPARE_TRUE
       | `CONFIDENTIALITY_REQUIRED
       | `CONNECT_ERROR
       | `CONSTRAINT_VIOLATION
       | `CONTROL_NOT_FOUND
       | `DECODING_ERROR
       | `ENCODING_ERROR
       | `FILTER_ERROR
       | `INAPPROPRIATE_AUTH
       | `INAPPROPRIATE_MATCHING
       | `INSUFFICIENT_ACCESS
       | `INVALID_CREDENTIALS
       | `INVALID_DN_SYNTAX
       | `INVALID_SYNTAX
       | `IS_LEAF
       | `LOCAL_ERROR
       | `LOOP_DETECT
       | `MORE_RESULTS_TO_RETURN
       | `NAMING_VIOLATION
       | `NOT_ALLOWED_ON_NONLEAF
       | `NOT_ALLOWED_ON_RDN
       | `NOT_SUPPORTED
       | `NO_MEMORY
       | `NO_OBJECT_CLASS_MODS
       | `NO_RESULTS_RETURNED
       | `NO_SUCH_ATTRIBUTE
       | `NO_SUCH_OBJECT
       | `OBJECT_CLASS_VIOLATION
       | `OPERATIONS_ERROR
       | `OTHER
       | `PARAM_ERROR
       | `PROTOCOL_ERROR
       | `REFERRAL
       | `REFERRAL_LIMIT_EXCEEDED
       | `SASL_BIND_IN_PROGRESS
       | `SERVER_DOWN
       | `SIZELIMIT_EXCEEDED
       | `STRONG_AUTH_REQUIRED
       | `SUCCESS
       | `TIMELIMIT_EXCEEDED
       | `TIMEOUT
       | `TYPE_OR_VALUE_EXISTS
       | `UNAVAILABLE
       | `UNAVAILABLE_CRITICAL_EXTENSION
       | `UNDEFINED_TYPE
       | `UNKNOWN_ERROR of int
       | `UNWILLING_TO_PERFORM
       | `USER_CANCELLED ]

type ldap_result = {
   result_code : ldap_resultcode;
   matched_dn : string;
   error_message : string;
   ldap_referral : string list option;
}
type ldap_ext_return = {
   ext_matched_dn : string;
   ext_referral : string list option;
}
extended information to return with the LDAP_Failure exception. Contains the remaining values which are defined by the protocol ext_matched_dn: the matched dn. Commonly set by `NO_SUCH_OBJECT. ext_referral: a list of ldapurls returned by the server when you attempted to do a write operation. If you use Ldap_ooclient with referrals set to follow you will never see this
exception LDAP_Failure of ldap_resultcode * string * ldap_ext_return
The exception raised to indicate all types of failure in the higher level libraries Ldap_funclient, and Ldap_ooclient. example LDAP_Failure (`NO_SUCH_OBJECT, "no such object", {ext_matched_dn=Some "o=csun";ext_referral=None})

type saslCredentials = {
   sasl_mechanism : string;
   sasl_credentials : string option;
}
type authentication =
| Simple of string
| Sasl of saslCredentials

type bind_request = {
   bind_version : int;
   bind_name : string;
   bind_authentication : authentication;
}
type bind_response = {
   bind_result : ldap_result;
   bind_serverSaslCredentials : string option;
}
type attribute = {
   attr_type : string;
   attr_vals : string list;
} 
type dn = attribute list

type search_result_entry = {
   sr_dn : string;
   sr_attributes : attribute list;
}
the type used to encode and decode a search entry. Also the type returned by search_s and search_a in Ldap_funclient
type search_scope = [ `BASE | `ONELEVEL | `SUBTREE ]
a type defining the scope of a search filter
type alias_deref = [ `DEREFALWAYS | `DEREFFINDINGBASE | `DEREFINSEARCHING | `NEVERDEREFALIASES ]

type attribute_value_assertion = {
   attributeDesc : string;
   assertionValue : string;
}
type matching_rule_assertion = {
   matchingRule : string option;
   ruletype : string option;
   matchValue : string;
   dnAttributes : bool;
}
type substring_component = {
   substr_initial : string list;
   substr_any : string list;
   substr_final : string list;
}
type substring_filter = {
   attrtype : string;
   substrings : substring_component;
} 
type filter = [ `And of filter list
       | `ApproxMatch of attribute_value_assertion
       | `EqualityMatch of attribute_value_assertion
       | `ExtensibleMatch of matching_rule_assertion
       | `GreaterOrEqual of attribute_value_assertion
       | `LessOrEqual of attribute_value_assertion
       | `Not of filter
       | `Or of filter list
       | `Present of string
       | `Substrings of substring_filter ]

type search_request = {
   baseObject : string;
   scope : search_scope;
   derefAliases : alias_deref;
   sizeLimit : int32;
   timeLimit : int32;
   typesOnly : bool;
   filter : filter;
   s_attributes : string list;
} 
type modify_optype = [ `ADD | `DELETE | `REPLACE ]

type modify_op = {
   mod_op : modify_optype;
   mod_value : attribute;
}
type modify_request = {
   mod_dn : string;
   modification : modify_op list;
}
type modify_dn_request = {
   modn_dn : string;
   modn_newrdn : string;
   modn_deleteoldrdn : bool;
   modn_newSuperior : string option;
}
type compare_request = {
   cmp_dn : string;
   cmp_ava : attribute_value_assertion;
}
type extended_request = {
   ext_requestName : string;
   ext_requestValue : string option;
}
type extended_response = {
   ext_result : ldap_result;
   ext_responseName : string option;
   ext_response : string option;
}
type protocol_op =
| Bind_request of bind_request
| Bind_response of bind_response
| Unbind_request
| Search_request of search_request
| Search_result_entry of search_result_entry
| Search_result_reference of string list
| Search_result_done of ldap_result
| Modify_request of modify_request
| Modify_response of ldap_result
| Add_request of search_result_entry
| Add_response of ldap_result
| Delete_request of string
| Delete_response of ldap_result
| Modify_dn_request of modify_dn_request
| Modify_dn_response of ldap_result
| Compare_request of compare_request
| Compare_response of ldap_result
| Abandon_request of Int32.t
| Extended_request of extended_request
| Extended_response of extended_response

type ldap_control = {
   controlType : string;
   criticality : bool;
   controlValue : string option;
} 
type ldap_controls = ldap_control list

type ldap_message = {
   messageID : Int32.t;
   protocolOp : protocol_op;
   controls : ldap_controls option;
} 
type con_mech = [ `PLAIN | `SSL ]

type ldap_url = {
   url_mech : con_mech;
   url_host : string option;
   url_port : string option;
   url_dn : string option;
   url_attributes : string list option;
   url_scope : search_scope option;
   url_filter : filter option;
   url_ext : (bool * string * string) list option;
} 
type ldap_grouping_type = [ `LDAP_GROUP_TXN ]
see draft-zeilenga-ldap-grouping-xx Ldap grouping is a way of telling the server that a set of ldap operations is related, its most interesting application is transactions across multiple objects. This draft is not yet implemented by any present day ldap server
type ldap_grouping_cookie
a cookie that is sent with every ldap operation which is part of a group
ocamldap-2.1.8/doc/ocamldap/html/Ldap_url.html0000644000175000017500000000605510444405446020560 0ustar gildorgildor Ldap_url
Previous  Up  Next

Module Ldap_url


module Ldap_url: sig .. end
a library for parsing a subset of the ldapurl syntax
exception Invalid_ldap_url of int * string
will be raised in the event of a parse or type error. The integer is the location of the error, measured in charachters from the left, and the string is a description of the error. The current lexer does not correctly set the charachter location, however future lexers will.
val of_string : string -> Ldap_types.ldap_url
internalize the url contained in the string argument
ocamldap-2.1.8/doc/ocamldap/html/Ldif_changerec_oo.change.html0000644000175000017500000000607410444405446023615 0ustar gildorgildor Ldif_changerec_oo.change
 Up  

Class Ldif_changerec_oo.change


class change : ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object .. end
method read_changerec : Ldap_ooclient.changerec
method of_string : string -> Ldap_ooclient.changerec
method to_string : Ldap_ooclient.changerec -> string
method write_changerec : Ldap_ooclient.changerec -> unit
ocamldap-2.1.8/doc/ocamldap/html/Ldif_changerec_oo.html0000644000175000017500000000740510444405446022370 0ustar gildorgildor Ldif_changerec_oo
Previous  Up  Next

Module Ldif_changerec_oo


module Ldif_changerec_oo: sig .. end
an object oriented interface to the ldif parser
exception Invalid_changerec of string
an exception raised when there is a parse error
exception End_of_changerecs
raised at the end of the change records
val iter : ('a -> unit) -> < read_changerec : 'a; .. > -> unit
Ldif_changerec.iter f change, iterate accross all change entries in the specified change object, applying f to each one
val fold : ('a -> 'b -> 'a) -> < read_changerec : 'b; .. > -> 'a -> 'a
Ldif_changerec.fold f change value, for each change entry en in the change object fold computes f (... (f (f value e1) e2) ...) en
class change : ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object .. end
ocamldap-2.1.8/doc/ocamldap/html/Ldif_oo.html0000644000175000017500000001056310444405446020370 0ustar gildorgildor Ldif_oo
Previous  Up  Next

Module Ldif_oo


module Ldif_oo: sig .. end
an object oriented interface to the ldif parser
val iter : ('a -> unit) -> < read_entry : 'a; .. > -> unit
Ldif_oo.iter f ldif, iterate accross all ldif entries in the specified ldif object, applying f to each one
val fold : ('a -> 'b -> 'a) -> < read_entry : 'b; .. > -> 'a -> 'a
Ldif_oo.fold f ldif value, for each ldif entry en in the ldif object fold computes f (... (f (f value e1) e2) ...) en
val entry2ldif : ?ext:bool ->
       Buffer.t ->
       < attributes : string list; dn : string; get_value : string -> string list;
         .. > ->
       Buffer.t
if you need a fast, low level interface to to_string, this function will write ldif directly into a buffer. Setting ext to true (defaul false) will write extended ldif. Extended ldif should be parsed using the Ldif_changerec_oo module.
val read_ldif_file : string -> Ldap_ooclient.ldapentry list
read all the entries in the named ldif file and return them in a list
val write_ldif_file : string -> Ldap_ooclient.ldapentry list -> unit
write all the entries in the given list to the named file in ldif format
class ldif : ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object .. end
ocamldap-2.1.8/doc/ocamldap/html/Ldif_oo.ldif.html0000644000175000017500000000572410444405446021310 0ustar gildorgildor Ldif_oo.ldif
 Up  

Class Ldif_oo.ldif


class ldif : ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object .. end
method read_entry : Ldap_ooclient.ldapentry
method of_string : string -> Ldap_ooclient.ldapentry
method to_string : Ldap_ooclient.ldapentry -> string
method write_entry : Ldap_ooclient.ldapentry -> unit
ocamldap-2.1.8/doc/ocamldap/html/style.css0000644000175000017500000000433110444405446017775 0ustar gildorgildora:visited {color : #416DFF; text-decoration : none; } a:link {color : #416DFF; text-decoration : none;} a:hover {color : Red; text-decoration : none; background-color: #5FFF88} a:active {color : Red; text-decoration : underline; } .keyword { font-weight : bold ; color : Red } .keywordsign { color : #C04600 } .superscript { font-size : 4 } .subscript { font-size : 4 } .comment { color : Green } .constructor { color : Blue } .type { color : #5C6585 } .string { color : Maroon } .warning { color : Red ; font-weight : bold } .info { margin-left : 3em; margin-right : 3em } .param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em } .code { color : #465F91 ; } h1 { font-size : 20pt ; text-align: center; } h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; } h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; } h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; } h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; } h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #C0FFFF ; padding: 2px; } div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; } div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; } div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; } .typetable { border-style : hidden } .indextable { border-style : hidden } .paramstable { border-style : hidden ; padding: 5pt 5pt} body { background-color : White } tr { background-color : White } td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;} pre { margin-bottom: 4px } div.sig_block {margin-left: 2em}ocamldap-2.1.8/doc/ocamldap/html/type_Lber.html0000644000175000017500000002634010444405446020742 0ustar gildorgildor Lber sig
  exception Decoding_error of string
  exception Encoding_error of string
  type readbyte_error =
      End_of_stream
    | Transport_error
    | Peek_error
    | Request_too_large
    | Not_implemented
  exception Readbyte_error of Lber.readbyte_error
  type readbyte = ?peek:bool -> int -> string
  type writebyte = char -> unit
  type ber_class = Universal | Application | Context_specific | Private
  type ber_length = Definite of int | Indefinite
  type ber_val_header = {
    ber_class : Lber.ber_class;
    ber_primitive : bool;
    ber_tag : int;
    ber_length : Lber.ber_length;
  }
  val readbyte_of_string : string -> Lber.readbyte
  val readbyte_of_ber_element :
    Lber.ber_length -> Lber.readbyte -> Lber.readbyte
  val readbyte_of_fd : Unix.file_descr -> Lber.readbyte
  val readbyte_of_ssl : Ssl.socket -> Lber.readbyte
  val decode_ber_header : ?peek:bool -> Lber.readbyte -> Lber.ber_val_header
  val encode_ber_header : Lber.ber_val_header -> string
  val read_contents :
    ?peek:bool -> Lber.readbyte -> Lber.ber_length -> string
  val decode_ber_bool :
    ?peek:bool ->
    ?cls:Lber.ber_class ->
    ?tag:int -> ?contents:string option -> Lber.readbyte -> bool
  val encode_ber_bool : ?cls:Lber.ber_class -> ?tag:int -> bool -> string
  val decode_ber_int32 :
    ?peek:bool ->
    ?cls:Lber.ber_class ->
    ?tag:int -> ?contents:string option -> Lber.readbyte -> int32
  val encode_ber_int32 : ?cls:Lber.ber_class -> ?tag:int -> int32 -> string
  val decode_ber_enum :
    ?peek:bool ->
    ?cls:Lber.ber_class ->
    ?tag:int -> ?contents:string option -> Lber.readbyte -> int32
  val encode_ber_enum : ?cls:Lber.ber_class -> ?tag:int -> int32 -> string
  val decode_ber_octetstring :
    ?peek:bool ->
    ?cls:Lber.ber_class ->
    ?tag:int -> ?contents:string option -> Lber.readbyte -> string
  val encode_ber_octetstring :
    ?cls:Lber.ber_class -> ?tag:int -> string -> string
  val decode_ber_null :
    ?peek:bool ->
    ?cls:Lber.ber_class ->
    ?tag:int -> ?contents:string option -> Lber.readbyte -> unit
  val encode_ber_null : ?cls:Lber.ber_class -> ?tag:int -> unit -> string
  val encode_berval_list :
    ?buf:Buffer.t -> ('a -> string) -> 'a list -> string
  val decode_berval_list :
    ?lst:'a list -> (Lber.readbyte -> 'a) -> Lber.readbyte -> 'a list
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_dn.html0000644000175000017500000000510510444405446021413 0ustar gildorgildor Ldap_dn sig
  exception Invalid_dn of int * string
  val of_string : string -> Ldap_types.dn
  val to_string : Ldap_types.dn -> string
  val escape_value : string -> string
  val canonical_dn : string -> string
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_error.html0000644000175000017500000002073410444405446022150 0ustar gildorgildor Ldap_error sig
  val err2string :
    [> `ADMINLIMIT_EXCEEDED
     | `ALIAS_DEREF_PROBLEM
     | `ALIAS_PROBLEM
     | `ALREADY_EXISTS
     | `AUTH_METHOD_NOT_SUPPORTED
     | `BUSY
     | `COMPARE_FALSE
     | `COMPARE_TRUE
     | `CONFIDENTIALITY_REQUIRED
     | `CONSTRAINT_VIOLATION
     | `INAPPROPRIATE_AUTH
     | `INAPPROPRIATE_MATCHING
     | `INSUFFICIENT_ACCESS
     | `INVALID_CREDENTIALS
     | `INVALID_DN_SYNTAX
     | `INVALID_SYNTAX
     | `LOCAL_ERROR
     | `LOOP_DETECT
     | `NAMING_VIOLATION
     | `NOT_ALLOWED_ON_NONLEAF
     | `NOT_ALLOWED_ON_RDN
     | `NO_OBJECT_CLASS_MODS
     | `NO_SUCH_ATTRIBUTE
     | `NO_SUCH_OBJECT
     | `OBJECT_CLASS_VIOLATION
     | `OPERATIONS_ERROR
     | `OTHER
     | `PROTOCOL_ERROR
     | `REFERRAL
     | `SASL_BIND_IN_PROGRESS
     | `SERVER_DOWN
     | `SIZELIMIT_EXCEEDED
     | `STRONG_AUTH_REQUIRED
     | `SUCCESS
     | `TIMELIMIT_EXCEEDED
     | `TYPE_OR_VALUE_EXISTS
     | `UNAVAILABLE
     | `UNAVAILABLE_CRITICAL_EXTENSION
     | `UNDEFINED_TYPE
     | `UNWILLING_TO_PERFORM ] ->
    string
  val ldap_strerror : string -> exn -> string
  val ldap_perror : string -> exn -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_filter.html0000644000175000017500000000471610444405446022306 0ustar gildorgildor Ldap_filter sig
  exception Invalid_filter of int * string
  val of_string : string -> Ldap_types.filter
  val to_string : Ldap_types.filter -> string
  val escape_filterstring : string -> string
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_funclient.html0000644000175000017500000002201010444405446022773 0ustar gildorgildor Ldap_funclient sig
  type msgid
  type conn
  type modattr = Ldap_types.modify_optype * string * string list
  type result = Ldap_types.search_result_entry list
  type entry = Ldap_types.search_result_entry
  type authmethod = [ `SASL | `SIMPLE ]
  type search_result =
    [ `Entry of Ldap_funclient.entry | `Referral of string list ]
  val init :
    ?connect_timeout:int ->
    ?version:int -> string list -> Ldap_funclient.conn
  val unbind : Ldap_funclient.conn -> unit
  val bind_s :
    ?who:string ->
    ?cred:string -> ?auth_method:[> `SIMPLE ] -> Ldap_funclient.conn -> unit
  val search :
    ?base:string ->
    ?scope:Ldap_types.search_scope ->
    ?aliasderef:Ldap_types.alias_deref ->
    ?sizelimit:int32 ->
    ?timelimit:int32 ->
    ?attrs:string list ->
    ?attrsonly:bool -> Ldap_funclient.conn -> string -> Ldap_funclient.msgid
  val get_search_entry :
    Ldap_funclient.conn ->
    Ldap_funclient.msgid ->
    [> `Entry of Ldap_types.search_result_entry | `Referral of string list ]
  val abandon : Ldap_funclient.conn -> Ldap_funclient.msgid -> unit
  val search_s :
    ?base:string ->
    ?scope:Ldap_types.search_scope ->
    ?aliasderef:Ldap_types.alias_deref ->
    ?sizelimit:int32 ->
    ?timelimit:int32 ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    Ldap_funclient.conn ->
    string ->
    [> `Entry of Ldap_types.search_result_entry | `Referral of string list ]
    list
  val add_s : Ldap_funclient.conn -> Ldap_funclient.entry -> unit
  val delete_s : Ldap_funclient.conn -> dn:string -> unit
  val modify_s :
    Ldap_funclient.conn ->
    dn:string ->
    mods:(Ldap_types.modify_optype * string * string list) list -> unit
  val modrdn_s :
    ?deleteoldrdn:bool ->
    ?newsup:'a option ->
    Ldap_funclient.conn -> dn:string -> newdn:string -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_funserver.html0000644000175000017500000002041710444405446023034 0ustar gildorgildor Ldap_funserver sig
  exception Server_error of string
  type connection_id = int
  type backendInfo = {
    bi_op_bind :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_unbind :
      (Ldap_funserver.connection_id -> Ldap_types.ldap_message -> unit)
      option;
    bi_op_search :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> unit -> Ldap_types.ldap_message)
      option;
    bi_op_compare :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_modify :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_modrdn :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_add :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_delete :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_op_abandon :
      (Ldap_funserver.connection_id -> Ldap_types.ldap_message -> unit)
      option;
    bi_op_extended :
      (Ldap_funserver.connection_id ->
       Ldap_types.ldap_message -> Ldap_types.ldap_message)
      option;
    bi_init : (unit -> unit) option;
    bi_close : (unit -> unit) option;
  }
  type log_level = [ `CONNECTION | `ERROR | `GENERAL | `OPERATIONS | `TRACE ]
  type server_info
  val init :
    ?log:(Ldap_funserver.log_level -> string -> unit) ->
    ?port:int -> Ldap_funserver.backendInfo -> Ldap_funserver.server_info
  val shutdown : Ldap_funserver.server_info -> unit
  val run : Ldap_funserver.server_info -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_mutex.html0000644000175000017500000001135410444405446022157 0ustar gildorgildor Ldap_mutex sig
  exception Ldap_mutex of string * exn
  class type mutex_t = object method lock : unit method unlock : unit end
  class type object_lock_table_t =
    object
      method lock : Ldap_types.dn -> unit
      method unlock : Ldap_types.dn -> unit
    end
  class mutex :
    string list ->
    string ->
    string -> string -> object method lock : unit method unlock : unit end
  val apply_with_mutex : Ldap_mutex.mutex -> (unit -> 'a) -> 'a
  class object_lock_table :
    string list ->
    string ->
    string ->
    string ->
    object
      method lock : Ldap_types.dn -> unit
      method unlock : Ldap_types.dn -> unit
    end
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_mutex.mutex.html0000644000175000017500000000423110444405446023314 0ustar gildorgildor Ldap_mutex.mutex string list ->
string ->
string -> string -> object method lock : unit method unlock : unit endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_mutex.mutex_t.html0000644000175000017500000000366310444405446023647 0ustar gildorgildor Ldap_mutex.mutex_t object method lock : unit method unlock : unit endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_mutex.object_lock_table.html0000644000175000017500000000457010444405446025605 0ustar gildorgildor Ldap_mutex.object_lock_table string list ->
string ->
string ->
string ->
object
  method lock : Ldap_types.dn -> unit
  method unlock : Ldap_types.dn -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_mutex.object_lock_table_t.html0000644000175000017500000000422410444405446026124 0ustar gildorgildor Ldap_mutex.object_lock_table_t object
  method lock : Ldap_types.dn -> unit
  method unlock : Ldap_types.dn -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.html0000644000175000017500000013707110444405446022636 0ustar gildorgildor Ldap_ooclient sig
  type op = string * string list
  type op_lst = Ldap_ooclient.op list
  type referral_policy = [ `FOLLOW | `RETURN ]
  type changetype = [ `ADD | `DELETE | `MODDN | `MODIFY | `MODRDN ]
  class type ldapentry_t =
    object
      method add : Ldap_ooclient.op_lst -> unit
      method attributes : string list
      method changes : (Ldap_types.modify_optype * string * string list) list
      method changetype : Ldap_ooclient.changetype
      method delete : Ldap_ooclient.op_lst -> unit
      method diff :
        Ldap_ooclient.ldapentry_t ->
        (Ldap_types.modify_optype * string * string list) list
      method dn : string
      method exists : string -> bool
      method flush_changes : unit
      method get_value : string -> string list
      method modify :
        (Ldap_types.modify_optype * string * string list) list -> unit
      method print : unit
      method replace : Ldap_ooclient.op_lst -> unit
      method set_changetype : Ldap_ooclient.changetype -> unit
      method set_dn : string -> unit
    end
  class ldapentry :
    object
      method add : Ldap_ooclient.op_lst -> unit
      method attributes : string list
      method changes : (Ldap_types.modify_optype * string * string list) list
      method changetype : Ldap_ooclient.changetype
      method delete : Ldap_ooclient.op_lst -> unit
      method diff :
        Ldap_ooclient.ldapentry_t ->
        (Ldap_types.modify_optype * string * string list) list
      method dn : string
      method exists : string -> bool
      method flush_changes : unit
      method get_value : string -> string list
      method modify :
        (Ldap_types.modify_optype * string * string list) list -> unit
      method print : unit
      method replace : Ldap_ooclient.op_lst -> unit
      method set_changetype : Ldap_ooclient.changetype -> unit
      method set_dn : string -> unit
    end
  val format_entry :
    < attributes : string list; dn : string;
      get_value : string -> string list; .. > ->
    unit
  val format_entries :
    < attributes : string list; dn : string;
      get_value : string -> string list; .. >
    list -> unit
  type changerec =
    [ `Addition of Ldap_ooclient.ldapentry
    | `Delete of string
    | `Modification of
        string * (Ldap_types.modify_optype * string * string list) list
    | `Modrdn of string * int * string ]
  val to_entry :
    [< `Entry of Ldap_types.search_result_entry | `Referral of string list ] ->
    Ldap_ooclient.ldapentry
  val of_entry : Ldap_ooclient.ldapentry -> Ldap_types.search_result_entry
  class ldapcon :
    ?connect_timeout:int ->
    ?referral_policy:[> `RETURN ] ->
    ?version:int ->
    string list ->
    object
      method add : Ldap_ooclient.ldapentry -> unit
      method bind :
        ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
      method delete : string -> unit
      method modify :
        string ->
        (Ldap_types.modify_optype * string * string list) list -> unit
      method modrdn :
        string ->
        ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
      method rawschema : Ldap_ooclient.ldapentry
      method schema : Ldap_schemaparser.schema
      method search :
        ?scope:Ldap_types.search_scope ->
        ?attrs:string list ->
        ?attrsonly:bool ->
        ?base:string ->
        ?sizelimit:Int32.t ->
        ?timelimit:Int32.t -> string -> Ldap_ooclient.ldapentry list
      method search_a :
        ?scope:Ldap_types.search_scope ->
        ?attrs:string list ->
        ?attrsonly:bool ->
        ?base:string ->
        ?sizelimit:Int32.t ->
        ?timelimit:Int32.t ->
        string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
      method unbind : unit
      method update_entry : Ldap_ooclient.ldapentry -> unit
    end
  val iter :
    (Ldap_ooclient.ldapentry -> unit) ->
    (?abandon:bool -> unit -> Ldap_ooclient.ldapentry) -> unit
  val rev_map :
    (Ldap_ooclient.ldapentry -> 'a) ->
    (?abandon:bool -> unit -> Ldap_ooclient.ldapentry) -> 'a list
  val map :
    (Ldap_ooclient.ldapentry -> 'a) ->
    (?abandon:bool -> unit -> Ldap_ooclient.ldapentry) -> 'a list
  val fold :
    (Ldap_ooclient.ldapentry -> 'a -> 'a) ->
    'a -> (?abandon:bool -> unit -> Ldap_ooclient.ldapentry) -> 'a
  module OrdOid :
    sig
      type t = Ldap_schemaparser.Oid.t
      val compare : Ldap_ooclient.OrdOid.t -> Ldap_ooclient.OrdOid.t -> int
    end
  module Setstr :
    sig
      type elt = Ldap_ooclient.OrdOid.t
      type t = Set.Make(OrdOid).t
      val empty : Ldap_ooclient.Setstr.t
      val is_empty : Ldap_ooclient.Setstr.t -> bool
      val mem : Ldap_ooclient.Setstr.elt -> Ldap_ooclient.Setstr.t -> bool
      val add :
        Ldap_ooclient.Setstr.elt ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val singleton : Ldap_ooclient.Setstr.elt -> Ldap_ooclient.Setstr.t
      val remove :
        Ldap_ooclient.Setstr.elt ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val union :
        Ldap_ooclient.Setstr.t ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val inter :
        Ldap_ooclient.Setstr.t ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val diff :
        Ldap_ooclient.Setstr.t ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val compare : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> int
      val equal : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> bool
      val subset : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> bool
      val iter :
        (Ldap_ooclient.Setstr.elt -> unit) -> Ldap_ooclient.Setstr.t -> unit
      val fold :
        (Ldap_ooclient.Setstr.elt -> 'a -> 'a) ->
        Ldap_ooclient.Setstr.t -> 'a -> 'a
      val for_all :
        (Ldap_ooclient.Setstr.elt -> bool) -> Ldap_ooclient.Setstr.t -> bool
      val exists :
        (Ldap_ooclient.Setstr.elt -> bool) -> Ldap_ooclient.Setstr.t -> bool
      val filter :
        (Ldap_ooclient.Setstr.elt -> bool) ->
        Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
      val partition :
        (Ldap_ooclient.Setstr.elt -> bool) ->
        Ldap_ooclient.Setstr.t ->
        Ldap_ooclient.Setstr.t * Ldap_ooclient.Setstr.t
      val cardinal : Ldap_ooclient.Setstr.t -> int
      val elements : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt list
      val min_elt : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
      val max_elt : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
      val choose : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
      val split :
        Ldap_ooclient.Setstr.elt ->
        Ldap_ooclient.Setstr.t ->
        Ldap_ooclient.Setstr.t * bool * Ldap_ooclient.Setstr.t
    end
  type scflavor = Optimistic | Pessimistic
  val attrToOid :
    Ldap_schemaparser.schema ->
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t
  val oidToAttr :
    Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string
  val ocToOid :
    Ldap_schemaparser.schema ->
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t
  val oidToOc : Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string
  val getOc :
    Ldap_schemaparser.schema ->
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.objectclass
  val getAttr :
    Ldap_schemaparser.schema ->
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.attribute
  val equateAttrs :
    Ldap_schemaparser.schema ->
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Lcstring.t -> bool
  exception Invalid_objectclass of string
  exception Invalid_attribute of string
  exception Single_value of string
  exception Objectclass_is_required
  class scldapentry :
    Ldap_schemaparser.schema ->
    object
      method add : Ldap_ooclient.op_lst -> unit
      method attributes : string list
      method changes : (Ldap_types.modify_optype * string * string list) list
      method changetype : Ldap_ooclient.changetype
      method delete : Ldap_ooclient.op_lst -> unit
      method diff :
        Ldap_ooclient.ldapentry_t ->
        (Ldap_types.modify_optype * string * string list) list
      method dn : string
      method exists : string -> bool
      method flush_changes : unit
      method get_value : string -> string list
      method is_allowed : string -> bool
      method is_missing : string -> bool
      method list_allowed : Ldap_ooclient.Setstr.elt list
      method list_missing : Ldap_ooclient.Setstr.elt list
      method list_present : Ldap_ooclient.Setstr.elt list
      method modify :
        (Ldap_types.modify_optype * string * string list) list -> unit
      method of_entry :
        ?scflavor:Ldap_ooclient.scflavor -> Ldap_ooclient.ldapentry -> unit
      method print : unit
      method replace : Ldap_ooclient.op_lst -> unit
      method set_changetype : Ldap_ooclient.changetype -> unit
      method set_dn : string -> unit
    end
  type generator = {
    gen_name : string;
    required : string list;
    genfun : Ldap_ooclient.ldapentry_t -> string list;
  }
  type service = {
    svc_name : string;
    static_attrs : (string * string list) list;
    generate_attrs : string list;
    depends : string list;
  }
  type generation_error =
      Missing_required of string list
    | Generator_error of string
  exception No_generator of string
  exception Generation_failed of Ldap_ooclient.generation_error
  exception No_service of string
  exception Service_dep_unsatisfiable of string
  exception Generator_dep_unsatisfiable of string * string
  exception Cannot_sort_dependancies of string list
  class ldapaccount :
    Ldap_schemaparser.schema ->
    (string, Ldap_ooclient.generator) Hashtbl.t ->
    (string, Ldap_ooclient.service) Hashtbl.t ->
    object
      method adapt_service : Ldap_ooclient.service -> Ldap_ooclient.service
      method add : Ldap_ooclient.op_lst -> unit
      method add_generate : string -> unit
      method add_service : string -> unit
      method attributes : string list
      method changes : (Ldap_types.modify_optype * string * string list) list
      method changetype : Ldap_ooclient.changetype
      method delete : Ldap_ooclient.op_lst -> unit
      method delete_generate : string -> unit
      method delete_service : string -> unit
      method diff :
        Ldap_ooclient.ldapentry_t ->
        (Ldap_types.modify_optype * string * string list) list
      method dn : string
      method exists : string -> bool
      method flush_changes : unit
      method generate : unit
      method get_value : string -> string list
      method is_allowed : string -> bool
      method is_missing : string -> bool
      method list_allowed : Ldap_ooclient.Setstr.elt list
      method list_missing : Ldap_ooclient.Setstr.elt list
      method list_present : Ldap_ooclient.Setstr.elt list
      method modify :
        (Ldap_types.modify_optype * string * string list) list -> unit
      method of_entry :
        ?scflavor:Ldap_ooclient.scflavor -> Ldap_ooclient.ldapentry -> unit
      method print : unit
      method replace : Ldap_ooclient.op_lst -> unit
      method service_exists : string -> bool
      method services_present : string list
      method set_changetype : Ldap_ooclient.changetype -> unit
      method set_dn : string -> unit
    end
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.ldapaccount.html0000644000175000017500000001561410444405446025130 0ustar gildorgildor Ldap_ooclient.ldapaccount Ldap_schemaparser.schema ->
(string, Ldap_ooclient.generator) Hashtbl.t ->
(string, Ldap_ooclient.service) Hashtbl.t ->
object
  method adapt_service : Ldap_ooclient.service -> Ldap_ooclient.service
  method add : Ldap_ooclient.op_lst -> unit
  method add_generate : string -> unit
  method add_service : string -> unit
  method attributes : string list
  method changes : (Ldap_types.modify_optype * string * string list) list
  method changetype : Ldap_ooclient.changetype
  method delete : Ldap_ooclient.op_lst -> unit
  method delete_generate : string -> unit
  method delete_service : string -> unit
  method diff :
    Ldap_ooclient.ldapentry_t ->
    (Ldap_types.modify_optype * string * string list) list
  method dn : string
  method exists : string -> bool
  method flush_changes : unit
  method generate : unit
  method get_value : string -> string list
  method is_allowed : string -> bool
  method is_missing : string -> bool
  method list_allowed : Ldap_ooclient.Setstr.elt list
  method list_missing : Ldap_ooclient.Setstr.elt list
  method list_present : Ldap_ooclient.Setstr.elt list
  method modify :
    (Ldap_types.modify_optype * string * string list) list -> unit
  method of_entry :
    ?scflavor:Ldap_ooclient.scflavor -> Ldap_ooclient.ldapentry -> unit
  method print : unit
  method replace : Ldap_ooclient.op_lst -> unit
  method service_exists : string -> bool
  method services_present : string list
  method set_changetype : Ldap_ooclient.changetype -> unit
  method set_dn : string -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.ldapadvisorytxcon.html0000644000175000017500000001621410444405446026405 0ustar gildorgildor Ldap_ooclient.ldapadvisorytxcon ?connect_timeout:int ->
?referral_policy:[> `RETURN ] ->
?version:int ->
string list ->
string ->
string ->
string ->
object
  method add : Ldap_ooclient.ldapentry -> unit
  method associate_entries :
    Ldap_ooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
  method associate_entry :
    Ldap_ooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
  method begin_txn : Ldap_ooclient.txn
  method bind :
    ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
  method commit_txn : Ldap_ooclient.txn -> unit
  method delete : string -> unit
  method disassociate_entries :
    Ldap_ooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
  method disassociate_entry :
    Ldap_ooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
  method modify :
    string -> (Ldap_types.modify_optype * string * string list) list -> unit
  method modrdn :
    string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
  method rawschema : Ldap_ooclient.ldapentry
  method rollback_txn : Ldap_ooclient.txn -> unit
  method schema : Ldap_schemaparser.schema
  method search :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool -> ?base:string -> string -> Ldap_ooclient.ldapentry list
  method search_a :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    ?base:string ->
    string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
  method unbind : unit
  method update_entry : Ldap_ooclient.ldapentry -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html0000644000175000017500000001342510444405446024251 0ustar gildorgildor Ldap_ooclient.ldapcon ?connect_timeout:int ->
?referral_policy:[> `RETURN ] ->
?version:int ->
string list ->
object
  method add : Ldap_ooclient.ldapentry -> unit
  method bind :
    ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
  method delete : string -> unit
  method modify :
    string -> (Ldap_types.modify_optype * string * string list) list -> unit
  method modrdn :
    string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
  method rawschema : Ldap_ooclient.ldapentry
  method schema : Ldap_schemaparser.schema
  method search :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    ?base:string ->
    ?sizelimit:Int32.t ->
    ?timelimit:Int32.t -> string -> Ldap_ooclient.ldapentry list
  method search_a :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    ?base:string ->
    ?sizelimit:Int32.t ->
    ?timelimit:Int32.t ->
    string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
  method unbind : unit
  method update_entry : Ldap_ooclient.ldapentry -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.ldapentry.html0000644000175000017500000001031710444405446024630 0ustar gildorgildor Ldap_ooclient.ldapentry object
  method add : Ldap_ooclient.op_lst -> unit
  method attributes : string list
  method changes : (Ldap_types.modify_optype * string * string list) list
  method changetype : Ldap_ooclient.changetype
  method delete : Ldap_ooclient.op_lst -> unit
  method diff :
    Ldap_ooclient.ldapentry_t ->
    (Ldap_types.modify_optype * string * string list) list
  method dn : string
  method exists : string -> bool
  method flush_changes : unit
  method get_value : string -> string list
  method modify :
    (Ldap_types.modify_optype * string * string list) list -> unit
  method print : unit
  method replace : Ldap_ooclient.op_lst -> unit
  method set_changetype : Ldap_ooclient.changetype -> unit
  method set_dn : string -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.ldapentry_t.html0000644000175000017500000001032110444405446025146 0ustar gildorgildor Ldap_ooclient.ldapentry_t object
  method add : Ldap_ooclient.op_lst -> unit
  method attributes : string list
  method changes : (Ldap_types.modify_optype * string * string list) list
  method changetype : Ldap_ooclient.changetype
  method delete : Ldap_ooclient.op_lst -> unit
  method diff :
    Ldap_ooclient.ldapentry_t ->
    (Ldap_types.modify_optype * string * string list) list
  method dn : string
  method exists : string -> bool
  method flush_changes : unit
  method get_value : string -> string list
  method modify :
    (Ldap_types.modify_optype * string * string list) list -> unit
  method print : unit
  method replace : Ldap_ooclient.op_lst -> unit
  method set_changetype : Ldap_ooclient.changetype -> unit
  method set_dn : string -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.mutex.html0000644000175000017500000000412310444405446023766 0ustar gildorgildor Ldap_ooclient.mutex string list ->
string ->
string -> string -> object method lock : unit method unlock : unit endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html0000644000175000017500000000355510444405446024321 0ustar gildorgildor Ldap_ooclient.mutex_t object method lock : unit method unlock : unit endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table.html0000644000175000017500000000446210444405446026257 0ustar gildorgildor Ldap_ooclient.object_lock_table string list ->
string ->
string ->
string ->
object
  method lock : Ldap_types.dn -> unit
  method unlock : Ldap_types.dn -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table_t.html0000644000175000017500000000411610444405446026576 0ustar gildorgildor Ldap_ooclient.object_lock_table_t object
  method lock : Ldap_types.dn -> unit
  method unlock : Ldap_types.dn -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html0000644000175000017500000000445010444405446024007 0ustar gildorgildor Ldap_ooclient.OrdOid sig
  type t = Ldap_schemaparser.Oid.t
  val compare : Ldap_ooclient.OrdOid.t -> Ldap_ooclient.OrdOid.t -> int
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html0000644000175000017500000000351310444405446024043 0ustar gildorgildor Ldap_ooclient.OrdStr sig
  type t = Ldap_schemaparser.Oid.t
  val compare : Ldap_schemaparser.Oid.t -> Ldap_schemaparser.Oid.t -> int
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.scldapentry.html0000644000175000017500000001270110444405446025155 0ustar gildorgildor Ldap_ooclient.scldapentry Ldap_schemaparser.schema ->
object
  method add : Ldap_ooclient.op_lst -> unit
  method attributes : string list
  method changes : (Ldap_types.modify_optype * string * string list) list
  method changetype : Ldap_ooclient.changetype
  method delete : Ldap_ooclient.op_lst -> unit
  method diff :
    Ldap_ooclient.ldapentry_t ->
    (Ldap_types.modify_optype * string * string list) list
  method dn : string
  method exists : string -> bool
  method flush_changes : unit
  method get_value : string -> string list
  method is_allowed : string -> bool
  method is_missing : string -> bool
  method list_allowed : Ldap_ooclient.Setstr.elt list
  method list_missing : Ldap_ooclient.Setstr.elt list
  method list_present : Ldap_ooclient.Setstr.elt list
  method modify :
    (Ldap_types.modify_optype * string * string list) list -> unit
  method of_entry :
    ?scflavor:Ldap_ooclient.scflavor -> Ldap_ooclient.ldapentry -> unit
  method print : unit
  method replace : Ldap_ooclient.op_lst -> unit
  method set_changetype : Ldap_ooclient.changetype -> unit
  method set_dn : string -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_ooclient.Setstr.html0000644000175000017500000002724210444405446024117 0ustar gildorgildor Ldap_ooclient.Setstr sig
  type elt = Ldap_ooclient.OrdOid.t
  type t = Set.Make(OrdOid).t
  val empty : Ldap_ooclient.Setstr.t
  val is_empty : Ldap_ooclient.Setstr.t -> bool
  val mem : Ldap_ooclient.Setstr.elt -> Ldap_ooclient.Setstr.t -> bool
  val add :
    Ldap_ooclient.Setstr.elt ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val singleton : Ldap_ooclient.Setstr.elt -> Ldap_ooclient.Setstr.t
  val remove :
    Ldap_ooclient.Setstr.elt ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val union :
    Ldap_ooclient.Setstr.t ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val inter :
    Ldap_ooclient.Setstr.t ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val diff :
    Ldap_ooclient.Setstr.t ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val compare : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> int
  val equal : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> bool
  val subset : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t -> bool
  val iter :
    (Ldap_ooclient.Setstr.elt -> unit) -> Ldap_ooclient.Setstr.t -> unit
  val fold :
    (Ldap_ooclient.Setstr.elt -> 'a -> 'a) ->
    Ldap_ooclient.Setstr.t -> 'a -> 'a
  val for_all :
    (Ldap_ooclient.Setstr.elt -> bool) -> Ldap_ooclient.Setstr.t -> bool
  val exists :
    (Ldap_ooclient.Setstr.elt -> bool) -> Ldap_ooclient.Setstr.t -> bool
  val filter :
    (Ldap_ooclient.Setstr.elt -> bool) ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t
  val partition :
    (Ldap_ooclient.Setstr.elt -> bool) ->
    Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.t * Ldap_ooclient.Setstr.t
  val cardinal : Ldap_ooclient.Setstr.t -> int
  val elements : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt list
  val min_elt : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
  val max_elt : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
  val choose : Ldap_ooclient.Setstr.t -> Ldap_ooclient.Setstr.elt
  val split :
    Ldap_ooclient.Setstr.elt ->
    Ldap_ooclient.Setstr.t ->
    Ldap_ooclient.Setstr.t * bool * Ldap_ooclient.Setstr.t
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_protocol.html0000644000175000017500000000513610444405446022657 0ustar gildorgildor Ldap_protocol sig
  val encode_resultcode : Ldap_types.ldap_resultcode -> int
  val decode_resultcode : int -> Ldap_types.ldap_resultcode
  val encode_ldapmessage : Ldap_types.ldap_message -> string
  val decode_ldapmessage : Lber.readbyte -> Ldap_types.ldap_message
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_schemaparser.html0000644000175000017500000002510710444405446023473 0ustar gildorgildor Ldap_schemaparser sig
  module Oid :
    sig
      type t
      val of_string : string -> Ldap_schemaparser.Oid.t
      val to_string : Ldap_schemaparser.Oid.t -> string
      val compare : Ldap_schemaparser.Oid.t -> Ldap_schemaparser.Oid.t -> int
    end
  val format_oid : Ldap_schemaparser.Oid.t -> unit
  module Lcstring :
    sig
      type t
      val of_string : string -> Ldap_schemaparser.Lcstring.t
      val to_string : Ldap_schemaparser.Lcstring.t -> string
      val compare :
        Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Lcstring.t -> int
    end
  val format_lcstring : Ldap_schemaparser.Lcstring.t -> unit
  type octype = Abstract | Structural | Auxiliary
  type objectclass = {
    oc_name : string list;
    oc_oid : Ldap_schemaparser.Oid.t;
    oc_desc : string;
    oc_obsolete : bool;
    oc_sup : Ldap_schemaparser.Lcstring.t list;
    oc_must : Ldap_schemaparser.Lcstring.t list;
    oc_may : Ldap_schemaparser.Lcstring.t list;
    oc_type : Ldap_schemaparser.octype;
    oc_xattr : string list;
  }
  type attribute = {
    at_name : string list;
    at_desc : string;
    at_oid : Ldap_schemaparser.Oid.t;
    at_equality : string;
    at_ordering : string;
    at_substr : Ldap_schemaparser.Oid.t;
    at_syntax : Ldap_schemaparser.Oid.t;
    at_length : Int64.t;
    at_obsolete : bool;
    at_single_value : bool;
    at_collective : bool;
    at_no_user_modification : bool;
    at_usage : string;
    at_sup : Ldap_schemaparser.Lcstring.t list;
    at_xattr : string list;
  }
  type schema = {
    objectclasses :
      (Ldap_schemaparser.Lcstring.t, Ldap_schemaparser.objectclass) Hashtbl.t;
    objectclasses_byoid :
      (Ldap_schemaparser.Oid.t, Ldap_schemaparser.objectclass) Hashtbl.t;
    attributes :
      (Ldap_schemaparser.Lcstring.t, Ldap_schemaparser.attribute) Hashtbl.t;
    attributes_byoid :
      (Ldap_schemaparser.Oid.t, Ldap_schemaparser.attribute) Hashtbl.t;
  }
  val schema_print_depth : int Pervasives.ref
  val format_schema : Ldap_schemaparser.schema -> unit
  exception Parse_error_oc of Lexing.lexbuf * Ldap_schemaparser.objectclass *
              string
  exception Parse_error_at of Lexing.lexbuf * Ldap_schemaparser.attribute *
              string
  exception Syntax_error_oc of Lexing.lexbuf *
              Ldap_schemaparser.objectclass * string
  exception Syntax_error_at of Lexing.lexbuf * Ldap_schemaparser.attribute *
              string
  val readSchema : string list -> string list -> Ldap_schemaparser.schema
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_schemaparser.Lcstring.html0000644000175000017500000000526110444405446025256 0ustar gildorgildor Ldap_schemaparser.Lcstring sig
  type t
  val of_string : string -> Ldap_schemaparser.Lcstring.t
  val to_string : Ldap_schemaparser.Lcstring.t -> string
  val compare :
    Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Lcstring.t -> int
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_schemaparser.Oid.html0000644000175000017500000000520110444405446024176 0ustar gildorgildor Ldap_schemaparser.Oid sig
  type t
  val of_string : string -> Ldap_schemaparser.Oid.t
  val to_string : Ldap_schemaparser.Oid.t -> string
  val compare : Ldap_schemaparser.Oid.t -> Ldap_schemaparser.Oid.t -> int
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_toplevel.html0000644000175000017500000000667110444405446022655 0ustar gildorgildor Ldap_toplevel sig
  val ldapsearch :
    ?s:Ldap_types.search_scope ->
    ?a:string list ->
    ?b:string ->
    ?d:string ->
    ?w:string -> h:string -> string -> Ldap_ooclient.ldapentry list
  val ldapmodify :
    h:string ->
    d:string ->
    w:string ->
    (string * (Ldap_types.modify_optype * string * string list) list) list ->
    unit
  val ldapadd :
    h:string -> d:string -> w:string -> Ldap_ooclient.ldapentry list -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_txooclient.html0000644000175000017500000002321210444405446023201 0ustar gildorgildor Ldap_txooclient sig
  type txn
  exception Txn_commit_failure of string * exn *
              Ldap_ooclient.ldapentry_t list option
  exception Txn_rollback_failure of string * exn
  class ldapadvisorytxcon :
    ?connect_timeout:int ->
    ?referral_policy:[> `RETURN ] ->
    ?version:int ->
    string list ->
    string ->
    string ->
    string ->
    object
      method add : Ldap_ooclient.ldapentry -> unit
      method associate_entries :
        Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
      method associate_entry :
        Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
      method begin_txn : Ldap_txooclient.txn
      method bind :
        ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
      method commit_txn : Ldap_txooclient.txn -> unit
      method delete : string -> unit
      method disassociate_entries :
        Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
      method disassociate_entry :
        Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
      method modify :
        string ->
        (Ldap_types.modify_optype * string * string list) list -> unit
      method modrdn :
        string ->
        ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
      method rawschema : Ldap_ooclient.ldapentry
      method rollback_txn : Ldap_txooclient.txn -> unit
      method schema : Ldap_schemaparser.schema
      method search :
        ?scope:Ldap_types.search_scope ->
        ?attrs:string list ->
        ?attrsonly:bool ->
        ?base:string ->
        ?sizelimit:Int32.t ->
        ?timelimit:Int32.t -> string -> Ldap_ooclient.ldapentry list
      method search_a :
        ?scope:Ldap_types.search_scope ->
        ?attrs:string list ->
        ?attrsonly:bool ->
        ?base:string ->
        ?sizelimit:Int32.t ->
        ?timelimit:Int32.t ->
        string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
      method unbind : unit
      method update_entry : Ldap_ooclient.ldapentry -> unit
    end
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_txooclient.ldapadvisorytxcon.html0000644000175000017500000001735410444405446026767 0ustar gildorgildor Ldap_txooclient.ldapadvisorytxcon ?connect_timeout:int ->
?referral_policy:[> `RETURN ] ->
?version:int ->
string list ->
string ->
string ->
string ->
object
  method add : Ldap_ooclient.ldapentry -> unit
  method associate_entries :
    Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
  method associate_entry :
    Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
  method begin_txn : Ldap_txooclient.txn
  method bind :
    ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit
  method commit_txn : Ldap_txooclient.txn -> unit
  method delete : string -> unit
  method disassociate_entries :
    Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t list -> unit
  method disassociate_entry :
    Ldap_txooclient.txn -> Ldap_ooclient.ldapentry_t -> unit
  method modify :
    string -> (Ldap_types.modify_optype * string * string list) list -> unit
  method modrdn :
    string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit
  method rawschema : Ldap_ooclient.ldapentry
  method rollback_txn : Ldap_txooclient.txn -> unit
  method schema : Ldap_schemaparser.schema
  method search :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    ?base:string ->
    ?sizelimit:Int32.t ->
    ?timelimit:Int32.t -> string -> Ldap_ooclient.ldapentry list
  method search_a :
    ?scope:Ldap_types.search_scope ->
    ?attrs:string list ->
    ?attrsonly:bool ->
    ?base:string ->
    ?sizelimit:Int32.t ->
    ?timelimit:Int32.t ->
    string -> ?abandon:bool -> unit -> Ldap_ooclient.ldapentry
  method unbind : unit
  method update_entry : Ldap_ooclient.ldapentry -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_types.html0000644000175000017500000006660410444405446022171 0ustar gildorgildor Ldap_types sig
  exception LDAP_Encoder of string
  exception LDAP_Decoder of string
  type ldap_resultcode =
    [ `ADMINLIMIT_EXCEEDED
    | `AFFECTS_MULTIPLE_DSAS
    | `ALIAS_DEREF_PROBLEM
    | `ALIAS_PROBLEM
    | `ALREADY_EXISTS
    | `AUTH_METHOD_NOT_SUPPORTED
    | `AUTH_UNKNOWN
    | `BUSY
    | `CLIENT_LOOP
    | `COMPARE_FALSE
    | `COMPARE_TRUE
    | `CONFIDENTIALITY_REQUIRED
    | `CONNECT_ERROR
    | `CONSTRAINT_VIOLATION
    | `CONTROL_NOT_FOUND
    | `DECODING_ERROR
    | `ENCODING_ERROR
    | `FILTER_ERROR
    | `INAPPROPRIATE_AUTH
    | `INAPPROPRIATE_MATCHING
    | `INSUFFICIENT_ACCESS
    | `INVALID_CREDENTIALS
    | `INVALID_DN_SYNTAX
    | `INVALID_SYNTAX
    | `IS_LEAF
    | `LOCAL_ERROR
    | `LOOP_DETECT
    | `MORE_RESULTS_TO_RETURN
    | `NAMING_VIOLATION
    | `NOT_ALLOWED_ON_NONLEAF
    | `NOT_ALLOWED_ON_RDN
    | `NOT_SUPPORTED
    | `NO_MEMORY
    | `NO_OBJECT_CLASS_MODS
    | `NO_RESULTS_RETURNED
    | `NO_SUCH_ATTRIBUTE
    | `NO_SUCH_OBJECT
    | `OBJECT_CLASS_VIOLATION
    | `OPERATIONS_ERROR
    | `OTHER
    | `PARAM_ERROR
    | `PROTOCOL_ERROR
    | `REFERRAL
    | `REFERRAL_LIMIT_EXCEEDED
    | `SASL_BIND_IN_PROGRESS
    | `SERVER_DOWN
    | `SIZELIMIT_EXCEEDED
    | `STRONG_AUTH_REQUIRED
    | `SUCCESS
    | `TIMELIMIT_EXCEEDED
    | `TIMEOUT
    | `TYPE_OR_VALUE_EXISTS
    | `UNAVAILABLE
    | `UNAVAILABLE_CRITICAL_EXTENSION
    | `UNDEFINED_TYPE
    | `UNKNOWN_ERROR of int
    | `UNWILLING_TO_PERFORM
    | `USER_CANCELLED ]
  type ldap_result = {
    result_code : Ldap_types.ldap_resultcode;
    matched_dn : string;
    error_message : string;
    ldap_referral : string list option;
  }
  type ldap_ext_return = {
    ext_matched_dn : string;
    ext_referral : string list option;
  }
  exception LDAP_Failure of Ldap_types.ldap_resultcode * string *
              Ldap_types.ldap_ext_return
  type saslCredentials = {
    sasl_mechanism : string;
    sasl_credentials : string option;
  }
  type authentication = Simple of string | Sasl of Ldap_types.saslCredentials
  type bind_request = {
    bind_version : int;
    bind_name : string;
    bind_authentication : Ldap_types.authentication;
  }
  type bind_response = {
    bind_result : Ldap_types.ldap_result;
    bind_serverSaslCredentials : string option;
  }
  type attribute = { attr_type : string; attr_vals : string list; }
  type dn = Ldap_types.attribute list
  type search_result_entry = {
    sr_dn : string;
    sr_attributes : Ldap_types.attribute list;
  }
  type search_scope = [ `BASE | `ONELEVEL | `SUBTREE ]
  type alias_deref =
    [ `DEREFALWAYS
    | `DEREFFINDINGBASE
    | `DEREFINSEARCHING
    | `NEVERDEREFALIASES ]
  type attribute_value_assertion = {
    attributeDesc : string;
    assertionValue : string;
  }
  type matching_rule_assertion = {
    matchingRule : string option;
    ruletype : string option;
    matchValue : string;
    dnAttributes : bool;
  }
  type substring_component = {
    substr_initial : string list;
    substr_any : string list;
    substr_final : string list;
  }
  type substring_filter = {
    attrtype : string;
    substrings : Ldap_types.substring_component;
  }
  type filter =
    [ `And of Ldap_types.filter list
    | `ApproxMatch of Ldap_types.attribute_value_assertion
    | `EqualityMatch of Ldap_types.attribute_value_assertion
    | `ExtensibleMatch of Ldap_types.matching_rule_assertion
    | `GreaterOrEqual of Ldap_types.attribute_value_assertion
    | `LessOrEqual of Ldap_types.attribute_value_assertion
    | `Not of Ldap_types.filter
    | `Or of Ldap_types.filter list
    | `Present of string
    | `Substrings of Ldap_types.substring_filter ]
  type search_request = {
    baseObject : string;
    scope : Ldap_types.search_scope;
    derefAliases : Ldap_types.alias_deref;
    sizeLimit : int32;
    timeLimit : int32;
    typesOnly : bool;
    filter : Ldap_types.filter;
    s_attributes : string list;
  }
  type modify_optype = [ `ADD | `DELETE | `REPLACE ]
  type modify_op = {
    mod_op : Ldap_types.modify_optype;
    mod_value : Ldap_types.attribute;
  }
  type modify_request = {
    mod_dn : string;
    modification : Ldap_types.modify_op list;
  }
  type modify_dn_request = {
    modn_dn : string;
    modn_newrdn : string;
    modn_deleteoldrdn : bool;
    modn_newSuperior : string option;
  }
  type compare_request = {
    cmp_dn : string;
    cmp_ava : Ldap_types.attribute_value_assertion;
  }
  type extended_request = {
    ext_requestName : string;
    ext_requestValue : string option;
  }
  type extended_response = {
    ext_result : Ldap_types.ldap_result;
    ext_responseName : string option;
    ext_response : string option;
  }
  type protocol_op =
      Bind_request of Ldap_types.bind_request
    | Bind_response of Ldap_types.bind_response
    | Unbind_request
    | Search_request of Ldap_types.search_request
    | Search_result_entry of Ldap_types.search_result_entry
    | Search_result_reference of string list
    | Search_result_done of Ldap_types.ldap_result
    | Modify_request of Ldap_types.modify_request
    | Modify_response of Ldap_types.ldap_result
    | Add_request of Ldap_types.search_result_entry
    | Add_response of Ldap_types.ldap_result
    | Delete_request of string
    | Delete_response of Ldap_types.ldap_result
    | Modify_dn_request of Ldap_types.modify_dn_request
    | Modify_dn_response of Ldap_types.ldap_result
    | Compare_request of Ldap_types.compare_request
    | Compare_response of Ldap_types.ldap_result
    | Abandon_request of Int32.t
    | Extended_request of Ldap_types.extended_request
    | Extended_response of Ldap_types.extended_response
  type ldap_control = {
    controlType : string;
    criticality : bool;
    controlValue : string option;
  }
  type ldap_controls = Ldap_types.ldap_control list
  type ldap_message = {
    messageID : Int32.t;
    protocolOp : Ldap_types.protocol_op;
    controls : Ldap_types.ldap_controls option;
  }
  type con_mech = [ `PLAIN | `SSL ]
  type ldap_url = {
    url_mech : Ldap_types.con_mech;
    url_host : string option;
    url_port : string option;
    url_dn : string option;
    url_attributes : string list option;
    url_scope : Ldap_types.search_scope option;
    url_filter : Ldap_types.filter option;
    url_ext : (bool * string * string) list option;
  }
  type ldap_grouping_type = [ `LDAP_GROUP_TXN ]
  type ldap_grouping_cookie
endocamldap-2.1.8/doc/ocamldap/html/type_Ldap_url.html0000644000175000017500000000420310444405446021612 0ustar gildorgildor Ldap_url sig
  exception Invalid_ldap_url of int * string
  val of_string : string -> Ldap_types.ldap_url
endocamldap-2.1.8/doc/ocamldap/html/type_Ldif_changerec_oo.change.html0000644000175000017500000000542210444405446024652 0ustar gildorgildor Ldif_changerec_oo.change ?in_ch:Pervasives.in_channel ->
?out_ch:Pervasives.out_channel ->
unit ->
object
  method of_string : string -> Ldap_ooclient.changerec
  method read_changerec : Ldap_ooclient.changerec
  method to_string : Ldap_ooclient.changerec -> string
  method write_changerec : Ldap_ooclient.changerec -> unit
endocamldap-2.1.8/doc/ocamldap/html/type_Ldif_changerec_oo.html0000644000175000017500000001046610444405446023432 0ustar gildorgildor Ldif_changerec_oo sig
  exception Invalid_changerec of string
  exception End_of_changerecs
  val iter : ('a -> unit) -> < read_changerec : 'a; .. > -> unit
  val fold : ('a -> 'b -> 'a) -> < read_changerec : 'b; .. > -> 'a -> 'a
  class change :
    ?in_ch:Pervasives.in_channel ->
    ?out_ch:Pervasives.out_channel ->
    unit ->
    object
      method of_string : string -> Ldap_ooclient.changerec
      method read_changerec : Ldap_ooclient.changerec
      method to_string : Ldap_ooclient.changerec -> string
      method write_changerec : Ldap_ooclient.changerec -> unit
    end
endocamldap-2.1.8/doc/ocamldap/html/type_Ldif_oo.html0000644000175000017500000001213510444405446021426 0ustar gildorgildor Ldif_oo sig
  val iter : ('a -> unit) -> < read_entry : 'a; .. > -> unit
  val fold : ('a -> 'b -> 'a) -> < read_entry : 'b; .. > -> 'a -> 'a
  val entry2ldif :
    ?ext:bool ->
    Buffer.t ->
    < attributes : string list; dn : string;
      get_value : string -> string list; .. > ->
    Buffer.t
  val read_ldif_file : string -> Ldap_ooclient.ldapentry list
  val write_ldif_file : string -> Ldap_ooclient.ldapentry list -> unit
  class ldif :
    ?in_ch:Pervasives.in_channel ->
    ?out_ch:Pervasives.out_channel ->
    unit ->
    object
      method of_string : string -> Ldap_ooclient.ldapentry
      method read_entry : Ldap_ooclient.ldapentry
      method to_string : Ldap_ooclient.ldapentry -> string
      method write_entry : Ldap_ooclient.ldapentry -> unit
    end
endocamldap-2.1.8/doc/ocamldap/html/type_Ldif_oo.ldif.html0000644000175000017500000000537610444405446022354 0ustar gildorgildor Ldif_oo.ldif ?in_ch:Pervasives.in_channel ->
?out_ch:Pervasives.out_channel ->
unit ->
object
  method of_string : string -> Ldap_ooclient.ldapentry
  method read_entry : Ldap_ooclient.ldapentry
  method to_string : Ldap_ooclient.ldapentry -> string
  method write_entry : Ldap_ooclient.ldapentry -> unit
endocamldap-2.1.8/INSTALL0000644000175000017500000000040710444405447013664 0ustar gildorgildor* To build the ocamldap library (bytecode and native): * To only build byte code, omit 'make opt' make make opt * To install the library make install * To uninstall the library make uninstall * To build Documentation make documentation ocamldap-2.1.8/lber.ml0000644000175000017500000006221210444405447014113 0ustar gildorgildor(* these are the Basic Encoding Rules, standardized by the ITU-T in X.690 all comments containing "sec. x.x.x.x" are section numbers referring to sections in x.690 Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) exception Decoding_error of string exception Encoding_error of string type readbyte_error = End_of_stream | Transport_error | Peek_error | Request_too_large | Not_implemented exception Readbyte_error of readbyte_error (* our sole interface with the data is to read and write a byte. the user of the encodeing functions herin will pass a function of the type readbyte, or writebyte to us when the encoding function is called. We will use that function to get or set raw data *) type readbyte = ?peek:bool -> int -> string type writebyte = (char -> unit) (* note on syntax. In this program I use some somewhat little used, but very useful syntatic notations for numbers in Ocaml. eg. 0b11000000, the 0b indicates a binary number, everything after it is the number. eg. 0b1100_0000, the _ has no meaning, it is just a seperator, however, seperating the nibbles in this way makes binary numbers very readable *) (* X.690 sec. 8.1.1 structure of an encoding *) type ber_class = Universal | Application | Context_specific | Private type ber_length = Definite of int | Indefinite (* all the meta info about a ber value *) type ber_val_header = {ber_class: ber_class; ber_primitive: bool; ber_tag: int; ber_length: ber_length} (* readbyte implementations. A readbyte is a higher order function which creates functions which provide a uniform way for decoding functions to read data without having to know anything about where it comes from. To OO people it can essentially be viewed as a functional version of a class, it exposes "methods", and hides data and code. the Lber module includes several readbyte implementations, which allow the decoding functions to read data from sockets, SSL sockets, other readbyte classes (with imposed read barriers), and from simple strings. *) (* return a readbyte implementation which uses another readbyte, but allows setting a read boundry. Useful for constructing views of the octet stream which end at the end of a ber structure. This is essential for reading certian structures because length is only encoded in the toplevel in order to save space. This function is the secret of Ocamldap's performance. *) let readbyte_of_ber_element limit (rb:readbyte) = let peek_counter = ref 1 and byte_counter = ref 0 in match limit with Definite limit -> let f ?(peek=false) length = if not peek then if !byte_counter + length <= limit then ( peek_counter := 1; byte_counter := !byte_counter + length; rb length ) else raise (Readbyte_error End_of_stream) else if !peek_counter + length <= limit && !byte_counter < limit then ( peek_counter := !peek_counter + length; rb ~peek:true length ) else raise (Readbyte_error End_of_stream) in f | Indefinite -> (* let peek_saw_eoc_octets = ref false and saw_eoc_octets = ref false and eoc_buf = String.create 1 and eoc_buf_len = ref 0 in let f ?(peek=false) length = if !eoc_buf_len = 0 then if peek && !peek_saw_eoc_octets then raise (Readbyte_error End_of_stream) else if !saw_eoc_octets then raise (Readbyte_error End_of_stream) else let b = rb ~peek:peek 1 in if (int_of_char b) = 0b0000_0000 then let b1 = rb ~peek:peek 1 in if (int_of_char b1) = 0b0000_0000 then ((if peek then peek_saw_eoc_octets := true else saw_eoc_octets := true); raise (Readbyte_error End_of_stream)) else (eoc_buf.[0] <- b1; eoc_buf_len := 1; String.make 1 b) else String.make 1 b else (eoc_buf_len := 0; eoc_buf) in f *) raise (Readbyte_error Not_implemented) (* return a readbyte implementation which works using a string *) let readbyte_of_string octets = (* let strm = Stream.of_string octets in let peek_counter = ref 1 in let limit = ref 0 in let f ?(peek=false) length = let rec last lst = match lst with h :: [] -> h | h :: t -> last t | [] -> failwith "readbyte bug in \"last\" function!" in if not peek then ( peek_counter := 1; (* reset the peek counter when we really read a byte *) try String.make 1 (Stream.next strm) with Stream.Failure -> raise (Readbyte_error End_of_stream) ) else let elts = (Stream.npeek !peek_counter strm) in if List.length elts = !peek_counter then (peek_counter := !peek_counter + 1; (String.make 1 (last elts))) else raise (Readbyte_error End_of_stream) (* if there are not enough elements in the stream, fail *) in f *) raise (Readbyte_error Not_implemented) let readbyte_of_readfun rfun = let bufsize = 16384 in (* must be this for ssl *) let buf = String.create (bufsize * 2) in let buf_len = ref 0 in let buf_pos = ref 0 in let peek_pos = ref 0 in let peek_buf_len = ref 0 in let read buf off len = try rfun buf off len with exn -> raise (Readbyte_error Transport_error) in let read_at_least_nbytes buf off len nbytes = let total = ref 0 in while !total < nbytes do let rd = read buf (!total + off) (len - !total) in if rd <= 0 then raise (Readbyte_error Transport_error); total := !total + rd; done; !total in let rec rb ?(peek=false) length = if length <= 0 then raise (Invalid_argument "Readbyte.length"); if length > bufsize then ( if length > Sys.max_string_length then raise (Readbyte_error Request_too_large); let result = String.create length in let total = ref 0 in while !total < length do let nbytes_to_read = if length - !total < bufsize then length - !total else bufsize in let iresult = rb ~peek nbytes_to_read in String.blit iresult 0 result !total nbytes_to_read; total := !total + nbytes_to_read done; result ) else if not peek then ( if length <= !buf_len - !buf_pos then ( let result = String.sub buf !buf_pos length in buf_pos := !buf_pos + length; peek_pos := !buf_pos; result ) else ( let result = String.create length in let nbytes_really_in_buffer = (!buf_len - !buf_pos) + !peek_buf_len in let nbytes_in_buffer = if nbytes_really_in_buffer > length then length else nbytes_really_in_buffer in let nbytes_to_read = length - nbytes_in_buffer in if nbytes_in_buffer > 0 then String.blit buf !buf_pos result 0 nbytes_in_buffer; if nbytes_to_read > 0 then ( let nbytes_read = read_at_least_nbytes buf 0 bufsize nbytes_to_read in String.blit buf 0 result nbytes_in_buffer nbytes_to_read; buf_pos := nbytes_to_read; buf_len := nbytes_read; peek_pos := !buf_pos; peek_buf_len := 0; result ) else ( String.blit buf 0 buf (!buf_pos + length) (nbytes_really_in_buffer - length); buf_len := (nbytes_really_in_buffer - length); buf_pos := 0; peek_pos := !buf_pos; peek_buf_len := 0; result ) ) ) (* if not peek *) else ( if length <= (!buf_len + !peek_buf_len) - !peek_pos then ( let result = String.sub buf !peek_pos length in peek_pos := !peek_pos + length; result ) else ( if length + !peek_pos > 2 * bufsize then raise (Readbyte_error Peek_error); let result = String.create length in let nbytes_in_buffer = (!buf_len + !peek_buf_len) - !peek_pos in let nbytes_to_read = length - nbytes_in_buffer in let read_start_pos = !peek_pos + nbytes_in_buffer in String.blit buf !peek_pos result 0 nbytes_in_buffer; let nbytes_read = read_at_least_nbytes buf read_start_pos (bufsize - (!buf_len + !peek_buf_len)) nbytes_to_read in String.blit buf read_start_pos result nbytes_in_buffer nbytes_read; peek_buf_len := !peek_buf_len + nbytes_read; peek_pos := !peek_pos + length; result ) ) in rb (* a readbyte implementation which reads from an FD. It implements a peek buffer, so it can garentee that it will work with readbyte_of_ber_element, even with blocking fds. *) let readbyte_of_fd fd = readbyte_of_readfun (fun buf off len -> try Unix.read fd buf off len with exn -> (try Unix.close fd with _ -> ());raise exn) (* a readbyte implementation which reads from an SSL socket. It is otherwise the same as rb_of_fd *) let readbyte_of_ssl fd = readbyte_of_readfun (fun buf off len -> try Ssl.read fd buf off len with exn -> (try Ssl.shutdown fd with _ -> ());raise exn) let decode_ber_length ?(peek=false) (readbyte:readbyte) = (* sec. 8.1.3.3, the definite length form *) let octet = int_of_char (readbyte ~peek:peek 1).[0] in if octet = 0b1111_1111 then (* sec/ 8.1.3.5c *) raise (Decoding_error "illegal initial length octet") else if octet = 0b1000_0000 then (* sec. 8.1.3.6 indefinite form *) Indefinite else if octet land 0b1000_0000 = 0b0000_0000 then (* sec. 8.1.3.4, definite length, short form *) Definite (octet land 0b0111_1111) else (* sec. 8.1.3.5, definite length, long form *) let rec decode_multioctet_length (readbyte:readbyte) numoctets remainingoctets value = if numoctets > 4 then raise (Decoding_error "length cannot be represented"); if remainingoctets = 0 then Definite value else let octet = int_of_char (readbyte ~peek:peek 1).[0] in if ((numoctets = 4) && (remainingoctets = 4) && (octet land 0b1000_0000 = 0b1000_0000)) (* we have only 31 bits *) then raise (Decoding_error "length cannot be represented") else decode_multioctet_length readbyte numoctets (remainingoctets - 1) (value + (octet lsl ((numoctets - (numoctets - remainingoctets) - 1) * 8))) in let numoctets = octet land 0b0111_1111 in decode_multioctet_length readbyte numoctets numoctets 0 let decode_ber_header ?(peek=false) (readbyte:readbyte) = let leading_octet = int_of_char (readbyte ~peek:peek 1).[0] in let ber_tag = (* sec. 8.1.2.2c *) if leading_octet land 0b0001_1111 = 0b0001_1111 then (* sec. 8.1.2.4 multi octet tag encoding *) let rec decode_multioctet_tag (readbyte:readbyte) tag_value = let octet = int_of_char (readbyte ~peek:peek 1).[0] in if octet land 0b1000_0000 = 0b0000_0000 then tag_value + (octet land 0b0111_1111) else decode_multioctet_tag readbyte (tag_value + (octet land 0b0111_1111)) in decode_multioctet_tag readbyte 0 else (* sec. 8.1.2.2 single octet tag encoding *) leading_octet land 0b0001_1111 in let ber_length = decode_ber_length ~peek:peek readbyte in {ber_class = (* sec. 8.1.2.2a table 1 *) (match leading_octet land 0b1100_0000 with 0b0000_0000 -> Universal | 0b0100_0000 -> Application | 0b1000_0000 -> Context_specific | 0b1100_0000 -> Private | _ -> raise (Decoding_error "ber_class, decoder bug")); ber_primitive = (* sec. 8.1.2.5 *) (match leading_octet land 0b0100_0000 with 0b0100_0000 -> false (* value is constructed *) | 0b0000_0000 -> true | _ -> raise (Decoding_error "ber_primitive, decoder bug")); (* value is primative *) ber_tag = ber_tag; ber_length = ber_length} let encode_ber_header {ber_class=cls;ber_primitive=pri;ber_tag=tag;ber_length=len} = let buf = Buffer.create 3 in let rec encode_multioctet_tag tag buf = if tag > 127 then (Buffer.add_char buf (char_of_int 255); encode_multioctet_tag (tag - 127) buf) else Buffer.add_char buf (char_of_int tag) in let rec long_form_length len buf = (* sec 8.1.3.5 encode the length in up to 1 + 4 octets *) if len < 255 then (* fits in 8 bits? *) (Buffer.add_char buf (char_of_int 0b1000_0001); (* long form with one octet *) Buffer.add_char buf (char_of_int len)) else if len < 65535 then (* fits in 16 bits? *) (Buffer.add_char buf (char_of_int 0b1000_0010); (* long form with two octets *) Buffer.add_char buf (char_of_int ((len land 0b11111111_00000000) lsr 8)); Buffer.add_char buf (char_of_int (len land 0b00000000_11111111))) else if len < 16777215 then (* fits in 24 bits? *) (Buffer.add_char buf (char_of_int 0b1000_0011); (* long form in three octets *) Buffer.add_char buf (char_of_int ((len land 0b11111111_00000000_00000000) lsr 16)); Buffer.add_char buf (char_of_int ((len land 0b00000000_11111111_00000000) lsr 8)); Buffer.add_char buf (char_of_int (len land 0b00000000_00000000_11111111))) else (* can't currently encode anything bigger than 31 bits *) (Buffer.add_char buf (char_of_int 0b1000_0100); Buffer.add_char buf (char_of_int ((len land 0b00111111_00000000_00000000_00000000) lsr 24)); Buffer.add_char buf (char_of_int ((len land 0b00000000_11111111_00000000_00000000) lsr 16)); Buffer.add_char buf (char_of_int ((len land 0b00000000_00000000_11111111_00000000) lsr 8)); Buffer.add_char buf (char_of_int (len land 0b00000000_00000000_00000000_11111111))); in Buffer.add_char buf (* deal with the header *) (char_of_int ((match cls with Universal -> 0b0000_0000 | Application -> 0b0100_0000 | Context_specific -> 0b1000_0000 | Private -> 0b1100_0000) lor (if pri then 0b0000_0000 else 0b0010_0000) lor (if tag > 31 then 0b0001_1111 else tag))); if tag > 31 then encode_multioctet_tag tag buf; (match len with (* deal with the length *) Definite len -> if len < 127 then Buffer.add_char buf (char_of_int len) else long_form_length len buf; | Indefinite -> raise (Encoding_error "indefinite length encoding not implemented")); Buffer.contents buf let read_contents ?(peek=false) (readbyte:readbyte) len = let rec readuntileoc (readbyte:readbyte) buf = let octet1 = (readbyte ~peek 1).[0] in if (int_of_char octet1) = 0b0000_0000 then let octet2 = (readbyte ~peek 1).[0] in if (int_of_char octet2) = 0b0000_0000 then Buffer.contents buf else (Buffer.add_char buf octet1;Buffer.add_char buf octet2; readuntileoc readbyte buf) else (Buffer.add_char buf octet1;readuntileoc readbyte buf) in match len with Definite n -> if n = 0 then "" else readbyte ~peek n | Indefinite -> readuntileoc readbyte (Buffer.create 5) let decode_ber_end_of_contents ?(peek=false) (readbyte:readbyte) = if not (((int_of_char (readbyte ~peek 1).[0]) = 0) && (int_of_char (readbyte ~peek 1).[0]) = 0) then raise (Decoding_error "missing end of contents octets") (* sec. 8.2 *) let decode_ber_bool ?(peek=false) ?(cls=Universal) ?(tag=1) ?(contents=None) (readbyte:readbyte) = let decode_ber_bool' contents = if (int_of_char contents.[0]) = 0 then false else true in match contents with None -> (match decode_ber_header ~peek:peek readbyte with {ber_class=c;ber_tag=t;ber_length=bool_length} when c=cls && t=tag -> decode_ber_bool' (read_contents ~peek:peek readbyte bool_length) | _ -> raise (Decoding_error "expected bool")) | Some contents -> decode_ber_bool' contents let encode_ber_bool ?(cls=Universal) ?(tag=1) value = let buf = Buffer.create 3 in Buffer.add_string buf (encode_ber_header {ber_class=cls;ber_primitive=true;ber_tag=tag;ber_length=Definite 1}); Buffer.add_char buf (if value then char_of_int 1 else char_of_int 0); Buffer.contents buf (* sec 8.3 *) let decode_ber_int32 ?(peek=false) ?(cls=Universal) ?(tag=2) ?(contents=None) (readbyte:readbyte) = let decode_ber_int32' contents = let length = String.length contents in if length > 5 then raise (Decoding_error "integer overflow, use bigger decode function?") else if length > 0 then let c i = Int32.of_int (int_of_char i) in let rec convert octets l i v = if i <= l then convert octets l (i + 1) (Int32.logor v (Int32.shift_left (c octets.[i]) (8 * (l - i)))) else v in let v = convert contents (length - 1) 0 0l in if (Int32.logand (c contents.[0]) 0b10000000l) = 0b10000000l then (* the number should be negative, fix it. For a less than 4 byte encoding, we need to set all the bits left of the data to 1. This operation will have no effect on a 4 byte encoding *) (Int32.logor (Int32.shift_left (-1l) (length * 8)) v) else v else raise (Decoding_error "integer, no contents octets") (* sec 8.3.1 *) in match contents with None -> (* we have not yet read the header, and unpacked the contents *) (match decode_ber_header ~peek:peek readbyte with {ber_class=c;ber_tag=t;ber_length=int_length} when c=cls && t=tag -> decode_ber_int32' (read_contents ~peek:peek readbyte int_length) | _ -> raise (Decoding_error "expected int")) | Some contents -> decode_ber_int32' contents (* we already have the contents *) let encode_ber_int32 ?(cls=Universal) ?(tag=2) value = let to_char i = char_of_int (Int32.to_int i) in let encode_positive_int32 value = let buf = Buffer.create 4 in (if value < 0b01111111l then (* fits in 7 bits + sign bit? *) Buffer.add_char buf (to_char value) (* byte one, MSB *) else if value < 0b01111111_11111111l then (* fits in 15 bits + sign bit? *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.shift_right (Int32.logand value 0b01111111_00000000l) 8)); Buffer.add_char buf (* byte two *) (to_char (Int32.logand value 0b00000000_11111111l))) else if value < 0b01111111_11111111_11111111l then (* fits in 23 bits + sign bit? *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.shift_right (Int32.logand value 0b01111111_00000000_00000000l) 16)); Buffer.add_char buf (* byte two *) (to_char (Int32.shift_right (Int32.logand value 0b00000000_11111111_00000000l) 8)); Buffer.add_char buf (* byte three *) (to_char (Int32.logand value 0b00000000_00000000_11111111l))) else (* use 31 bits + sign bit *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.shift_right (Int32.logand value 0b01111111_00000000_00000000_00000000l) 24)); Buffer.add_char buf (* byte two *) (to_char (Int32.shift_right (Int32.logand value 0b00000000_11111111_00000000_00000000l) 16)); Buffer.add_char buf (* byte three *) (to_char (Int32.shift_right (Int32.logand value 0b00000000_00000000_11111111_00000000l) 8)); Buffer.add_char buf (* byte four *) (to_char (Int32.logand value 0b00000000_00000000_00000000_11111111l)))); buf in let encode_negative_int32 value = let buf = Buffer.create 4 in (* We must manually set the sign bit for the first octet of the encoding. So we must turn the real sign bit off, and set the first bit of the first octet in the encoded stream, because it will become the sign bit on the other side. *) (if value > 0b11111111_11111111_11111111_10000000l then (* fits in 7 bits + sign bit *) Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.logor (* flip what WILL be the sign bit in the encoded byte ON *) 0b1000_0000l (Int32.logand (* flip the sign bit for the WHOLE word OFF *) 0b00000000_00000000_00000000_1111111l value))) else if value > 0b11111111_11111111_10000000_00000000l then (* fits in 15 bits + sign bit *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.logor (* flip what WILL be the sign bit in the encoded byte ON *) 0b1000_0000l (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_00000000_11111111_00000000l value) 8))); Buffer.add_char buf (to_char (Int32.logand 0b00000000_00000000_00000000_11111111l value))) (* byte two *) else if value > 0b11111111_10000000_00000000_00000000l then (* fits in 23 bits + sign bit *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.logor (* flip what WILL be the sign bit in the encoded byte ON *) 0b1000_0000l (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_11111111_00000000_00000000l value) 16))); Buffer.add_char buf (* byte two *) (to_char (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_00000000_11111111_00000000l value) 8)); Buffer.add_char buf (* byte three *) (to_char (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_00000000_00000000_11111111l value))) else (* fits in 31 bits + sign bit *) (Buffer.add_char buf (* byte one, MSB *) (to_char (Int32.logor (* flip what WILL be the sign bit in the encoded byte ON *) 0b1000_0000l (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b01111111_00000000_00000000_00000000l value) 24))); Buffer.add_char buf (* byte two *) (to_char (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_11111111_00000000_00000000l value) 16)); Buffer.add_char buf (* byte three *) (to_char (Int32.shift_right (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_00000000_11111111_00000000l value) 8)); Buffer.add_char buf (* byte four *) (to_char (Int32.logand (* this mask also accomplishes flipping the sign bit OFF *) 0b00000000_00000000_00000000_11111111l value)))); buf in let buf = if value < 0l then (* if its less than zero we must encode differently *) encode_negative_int32 value else encode_positive_int32 value in let buf1 = Buffer.create 5 in Buffer.add_string buf1 (encode_ber_header {ber_class=cls; ber_tag=tag; ber_primitive=true; ber_length=Definite (Buffer.length buf)}); Buffer.add_buffer buf1 buf; Buffer.contents buf1 (* sec. 8.4 *) let decode_ber_enum ?(peek=false) ?(cls=Universal) ?(tag=10) ?(contents=None) (readbyte:readbyte) = decode_ber_int32 ~peek:peek ~cls:cls ~tag:tag ~contents:contents readbyte let encode_ber_enum ?(cls=Universal) ?(tag=10) value = encode_ber_int32 ~cls:cls ~tag:tag value (* sec 8.7 *) let decode_ber_octetstring ?(peek=false) ?(cls=Universal) ?(tag=4) ?(contents=None) (readbyte:readbyte) = match contents with None -> (* have not yet read the header, or unpacked the contents *) (match decode_ber_header readbyte with {ber_class=c;ber_tag=t;ber_length=octetstring_length} when c=cls && t=tag -> read_contents ~peek readbyte octetstring_length | _ -> raise (Decoding_error "expected octetstring")) | Some contents -> contents let encode_ber_octetstring ?(cls=Universal) ?(tag=4) string = let len = String.length string in let buf = Buffer.create (len + 3) in Buffer.add_string buf (encode_ber_header {ber_class=cls; ber_tag=tag; ber_primitive=true; ber_length=Definite len}); Buffer.add_string buf string; Buffer.contents buf let encode_ber_null ?(cls=Universal) ?(tag=5) () = encode_ber_header {ber_class=cls; ber_tag=tag; ber_primitive=true; ber_length=Definite 0} let decode_ber_null ?(peek=false) ?(cls=Universal) ?(tag=5) ?(contents=None) (readbyte:readbyte) = let decode_ber_null' contents = () in match contents with None -> (match decode_ber_header ~peek:peek readbyte with {ber_class=c; ber_tag=t; ber_length=l} when c=cls && t=tag && l=Definite 0 -> decode_ber_null' None | _ -> raise (Decoding_error "expected null")) | Some contents -> decode_ber_null' contents let rec encode_berval_list ?(buf=Buffer.create 50) efun lst = match lst with hd :: [] -> Buffer.add_string buf (efun hd); Buffer.contents buf | hd :: tl -> (encode_berval_list ~buf:(Buffer.add_string buf (efun hd);buf) efun tl) | [] -> Buffer.contents buf let rec decode_berval_list ?(lst=[]) dfun (readbyte:readbyte) = try decode_berval_list ~lst:((dfun readbyte) :: lst) dfun readbyte with Readbyte_error End_of_stream -> lst ocamldap-2.1.8/lber.mli0000644000175000017500000001562110444405447014266 0ustar gildorgildor(* This library implements the subset of the basic encoding rules necessary to implement the ldap protocol. See ITU-T X.680 and X.690 for a description of ASN.1, and the basic encoding rules. Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** This library implements the subset of ber *) exception Decoding_error of string exception Encoding_error of string type readbyte_error = End_of_stream | Transport_error | Peek_error | Request_too_large | Not_implemented exception Readbyte_error of readbyte_error type readbyte = ?peek:bool -> int -> string type writebyte = char -> unit type ber_class = Universal | Application | Context_specific | Private type ber_length = Definite of int | Indefinite type ber_val_header = { ber_class : ber_class; ber_primitive : bool; ber_tag : int; ber_length : ber_length; } (** return a readbyte function for a string, currently not implemented *) val readbyte_of_string : string -> readbyte (** return a readbyte implementation which uses another readbyte, but allows setting a read boundry. Useful for constructing views of the octet stream which end at the end of a ber structure. This is essential for reading certian structures because length is only encoded in the toplevel in order to save space. Currently only implemented for definite lengths. @raise Readbyte_error in the event of a an io error, or the end of file *) val readbyte_of_ber_element : ber_length -> readbyte -> readbyte (** a readbyte implementation which reads from an FD. It implements a peek buffer, so it can garentee that it will work with rb_of_ber_element, even with blocking fds. @raise Readbyte_error in the event of a an io error, or the end of file *) val readbyte_of_fd: Unix.file_descr -> readbyte (** a readbyte implementation which reads from an SSL socket. It is otherwise the same as readbyte_of_fd. @raise Readbyte_error in the event of a an io error, or the end of file *) val readbyte_of_ssl: Ssl.socket -> readbyte (** decoding and encoding of the ber header *) val decode_ber_header : ?peek:bool -> readbyte -> ber_val_header val encode_ber_header : ber_val_header -> string (** reads the contents octets *) val read_contents : ?peek:bool -> readbyte -> ber_length -> string (** ENCODING and DECODING Functions Explanation of optional arguments: The optional arguments are there to deal with a number of situations, cls, and tag are for context specific or application situations where it is expected that the value will not be marked with the class and tag defined in X.680. Contents is there for akward situations which arise because of the choice structure. Normally the decode functions will always read the header for you, however with the choice structure this is impossible. In this case you should read the header manually, determine which decode function to call, unpack the contents with read_contents, and send them in the contents optional. If contents is not None, then readbyte will never be called, and no attempt will be made to read the header or length. *) (** Encoding/Decoding of the boolean primative ASN.1 type. Encode function encodes a valid ber type, including the header and length octets. *) val decode_ber_bool : ?peek:bool -> ?cls:ber_class -> ?tag:int -> ?contents:string option -> readbyte -> bool val encode_ber_bool : ?cls:ber_class -> ?tag:int -> bool -> string (** Encoding/Decoding of the integer primative ASN.1 type. Note, in this library, integers are represented as 32 bit values. In ASN.1 there is no practical limit to the size of an integer, later on, this library may provide an encoder/decoder to Int64, and Bigints, however for now, this will have to do. Encode function encodes a valid ber type, including the header and length octets *) val decode_ber_int32 : ?peek:bool -> ?cls:ber_class -> ?tag:int -> ?contents:string option -> readbyte -> int32 val encode_ber_int32 : ?cls:ber_class -> ?tag:int -> int32 -> string (** Encoding/Decoding of enum primative ASN.1 type. Enums are simply integers, the same drawbacks apply as for decode_ber_int32. Encode function encodes a valid ber type, including the header and length octets *) val decode_ber_enum : ?peek:bool -> ?cls:ber_class -> ?tag:int -> ?contents:string option -> readbyte -> int32 val encode_ber_enum : ?cls:ber_class -> ?tag:int -> int32 -> string (** Encoding/Decoding of octetstring ASN.1 types. The Nested or "segmented" version of the octetstring encoding described in X.690 is not yet supported. Encode function encodes a valid ber type, including the header and length octets *) val decode_ber_octetstring : ?peek:bool -> ?cls:ber_class -> ?tag:int -> ?contents:string option -> readbyte -> string val encode_ber_octetstring : ?cls:ber_class -> ?tag:int -> string -> string (** Encoding/Decoding of Null ASN.1 type. Almost useful as an assertion-type operation *) val decode_ber_null : ?peek: bool -> ?cls:ber_class -> ?tag:int -> ?contents:string option -> readbyte -> unit val encode_ber_null : ?cls:ber_class -> ?tag:int -> unit -> string (** this function is for encoding lists of bervals, a common case. you pass it a list of things to encode, and an encoding function, and it will apply the encoding function to each element in the list, storing the resulting encoding in a buffer (which you may either pass in or not) *) val encode_berval_list : ?buf:Buffer.t -> ('a -> string) -> 'a list -> string (** this is the reverse of the above, it takes a readbyte structure, and returns a list of decoded elements, processed according to the decoder function you pass in. Note, that you MUST pass a readbyte structure built with readbyte_of_string, OR, your reabyte function must raise Stream.Failure when you reach the end of input. Otherwise this function will explode. That said, it is usually not practical to pass anything but a readbyte created by readbyte_of_string so this should not be a huge problem. *) val decode_berval_list : ?lst:'a list -> (readbyte -> 'a) -> readbyte -> 'a list ocamldap-2.1.8/lber_tests.ml0000644000175000017500000000273610444405447015342 0ustar gildorgildoropen Lber let encode_decode_int32 i = let e_i32 = encode_ber_int32 i in let rb = readbyte_of_string e_i32 in decode_ber_int32 rb let rec test_positive_encode_decode_int32 i = if i < Int32.max_int then let result = try encode_decode_int32 i with exn -> print_endline ("unhandled exception: " ^ (Printexc.to_string exn) ^ " with int: " ^ (Int32.to_string i)); exit 0 in if result <> i then failwith ("I encode: " ^ (Int32.to_string i) ^ " and I get: " ^ (Int32.to_string result)) else ((if Int32.rem i 1000000l = 0l then print_endline ("i:" ^ (Int32.to_string i))); test_positive_encode_decode_int32 (Int32.succ i)) let rec test_negative_encode_decode_int32 i = if i > Int32.min_int then let result = try encode_decode_int32 i with exn -> print_endline ("unhandled exception: " ^ (Printexc.to_string exn) ^ " with int: " ^ (Int32.to_string i)); exit 0 in if result <> i then failwith ("I encode: " ^ (Int32.to_string i) ^ " and I get: " ^ (Int32.to_string result)) else ((if Int32.rem i (-1000000l) = 0l then print_endline ("i:" ^ (Int32.to_string i))); test_negative_encode_decode_int32 (Int32.pred i)) let main () = (* print_endline "testing integer encoder/decoder with positive numbers"; test_positive_encode_decode_int32 0l; *) print_endline "testing integer encoder/decoder with negative numbers"; test_negative_encode_decode_int32 0l ;; main () ocamldap-2.1.8/ldap_dn.ml0000644000175000017500000000746310444405447014577 0ustar gildorgildor(* Utility functions for operating on dns Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_dnparser open Ldap_dnlexer open Printf exception Invalid_dn of int * string let of_string dn_string = let lexbuf = Lexing.from_string dn_string in try Ldap_dnparser.dn lexdn lexbuf with Parsing.Parse_error -> raise (Invalid_dn (lexbuf.Lexing.lex_curr_pos, "parse error")) | Failure msg -> raise (Invalid_dn (lexbuf.Lexing.lex_curr_pos, msg)) let hexpair_of_char c = let hexify i = match i with 0 -> '0' | 1 -> '1' | 2 -> '2' | 3 -> '3' | 4 -> '4' | 5 -> '5' | 6 -> '6' | 7 -> '7' | 8 -> '8' | 9 -> '9' | 10 -> 'a' | 11 -> 'b' | 12 -> 'c' | 13 -> 'd' | 14 -> 'e' | 15 -> 'f' | n -> raise (Invalid_argument ("invalid hex digit: " ^ (string_of_int n))) in let i = int_of_char c in let buf = String.create 2 in buf.[0] <- hexify ((lsr) i 4); buf.[1] <- hexify ((land) i 0b0000_1111); buf let escape_value valu = let strm = Stream.of_string valu in let buf = Buffer.create ((String.length valu) + 10) in let rec escape strm buf = try match Stream.next strm with (',' | '=' | '+' | '<' | '>' | '#' | ';' | '\\' | '"') as c -> Buffer.add_char buf '\\'; Buffer.add_char buf c; escape strm buf | ' ' -> if Stream.peek strm = None then begin Buffer.add_string buf "\\ "; escape strm buf end else begin Buffer.add_char buf ' '; escape strm buf end | c -> if (int_of_char c) < (int_of_char ' ') || (int_of_char c) > (int_of_char '~') then begin Buffer.add_string buf ("\\" ^ (hexpair_of_char c)); escape strm buf end else begin Buffer.add_char buf c;escape strm buf end with Stream.Failure -> Buffer.contents buf in match Stream.peek strm with Some ' ' -> Buffer.add_string buf "\\ "; Stream.junk strm; escape strm buf | Some c -> escape strm buf | None -> "" let to_string dn = let dn_to_strcomponents dn = List.map (fun {attr_type=attr;attr_vals=vals} -> let rec string_values s attr vals = match vals with valu :: [] -> sprintf "%s%s=%s" s attr (escape_value valu) | valu :: tl -> string_values (sprintf "%s%s=%s+" s attr (escape_value valu)) attr tl | [] -> s in if List.length vals = 0 then raise (Invalid_dn (0, "invalid dn structure. no attribute " ^ "value specified for attribute: " ^ attr)) else string_values "" attr vals) dn in let rec components_to_dn s comps = match comps with comp :: [] -> sprintf "%s%s" s comp | comp :: tl -> components_to_dn (sprintf "%s%s," s comp) tl | [] -> s in components_to_dn "" (dn_to_strcomponents dn) let canonical_dn dn = String.lowercase (to_string (of_string dn)) ocamldap-2.1.8/ldap_dn.mli0000644000175000017500000000456210444405447014745 0ustar gildorgildor(* Utility functions for operating on dns Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_dnparser (** operations on ldap dns *) (** raised when something goes wrong with conversion to or from a string. The integer argument is the charachter which the lexer was looking at then the failure ocurred. In the case of to_string the integer argument will always be zero. *) exception Invalid_dn of int * string (** Given a string representation of a dn, return a structured representation. unescapes any escape sequences present. *) val of_string : string -> Ldap_types.dn (** Given a structural representation of a dn, return a string representation. Performs all the necessary escaping to correctly represent any structured representation. *) val to_string : Ldap_types.dn -> string (** Escape a string which you intend to be part of a VALUE in the dn. Do not use on the whole dn, just an attribute value. It is NOT necessary to use this if you intend to call to_string on your dn. It will be done for you as part of the conversion process. This function is exposed for the case where you find it easier to manipulate the dn via a regular expression, or other string based means, and you find it necessary to escape values. *) val escape_value : string -> string (** returns the canonical dn. A simple string compare can tell you accurately whether two canonical dns are equal or not. *) val canonical_dn : string -> string ocamldap-2.1.8/ldap_dnlexer.mll0000644000175000017500000000443710444405447016011 0ustar gildorgildor(* lexer for rfc2252 format schemas Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { open Ldap_dnparser } let whsp = [ '\t' ' ' ]* let alpha = [ 'a' - 'z' 'A' - 'Z' ] let digit = [ '0' - '9' ] let hexchar = [ '0' - '9' 'A' - 'F' 'a' - 'f' ] let keychar = [ 'a' - 'z' 'A' - 'Z' '0' - '9' '-' ] let attributetype = (alpha keychar*) as attribute let oid = [ '0' - '9' '.' ]+ let special = [ ',' '=' '+' '<' '>' '#' ';' ] let quotechar = [^ '\\' '"' ] let hexpair = hexchar hexchar let hexstring = hexpair + let stringchar = [^ '\\' '"' ] # special let pair = '\\' (special | ' ' | '\\' | '"' | hexpair) (* According to the rfc this is the set of possible values for an attribute value We don't implement it directly, instead we split each one into a seperate token to make unescaping easier string = (stringchar | pair)* | '#' hexstring | '"' (quotechar | pair)* '"' *) rule lexdn = parse whsp '=' whsp {Equals} | whsp '+' whsp {Plus} | whsp (',' | ';') whsp {Comma} | oid {Oid (Lexing.lexeme lexbuf)} | attributetype {AttributeType (Lexing.lexeme lexbuf)} | stringchar* ([^ ' '] # special) {String (Lexing.lexeme lexbuf)} | (stringchar | pair)* (pair | ([^ ' '] # special)) {StringWithPair (Lexing.lexeme lexbuf)} | '#' hexstring {HexString (Lexing.lexeme lexbuf)} | '"' (quotechar | pair)* '"' {QuoteString (Lexing.lexeme lexbuf)} | eof {End_of_input} ocamldap-2.1.8/ldap_dnparser.mly0000644000175000017500000000725210444405447016201 0ustar gildorgildor/* a parser for rfc2254 ldap filters Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ %{ open Ldap_dnlexer open Ldap_types let unhex hex = match hex with '0' -> 0 | '1' -> 1 | '2' -> 2 | '3' -> 3 | '4' -> 4 | '5' -> 5 | '6' -> 6 | '7' -> 7 | '8' -> 8 | '9' -> 9 | 'a' -> 10 | 'b' -> 11 | 'c' -> 12 | 'd' -> 13 | 'e' -> 14 | 'f' -> 15 | _ -> failwith "invalid hex digit" let unescape_hexpair hex1 hex2 = (char_of_int ((lor) ((lsl) (unhex hex1) 4) (unhex hex2))) let unescape_stringwithpair s = let strm = Stream.of_string s in let buf = Buffer.create (String.length s) in let rec unescape strm buf = try match Stream.next strm with '\\' -> (match Stream.next strm with (',' | '=' | '+' | '<' | '>' | '#' | ';' | '\\' | '"' | ' ') as c -> Buffer.add_char buf c; unescape strm buf | ('0' .. '9' | 'A' .. 'F' | 'a' .. 'f') as hex1 -> let hex2 = Stream.next strm in Buffer.add_char buf (unescape_hexpair hex1 hex2); unescape strm buf | _ -> failwith "invalid escape sequence") | c -> Buffer.add_char buf c;unescape strm buf with Stream.Failure -> Buffer.contents buf in unescape strm buf let unescape_quotestring s = unescape_stringwithpair (String.sub s 1 ((String.length s) - 2)) let unescape_hexstring s = let strm = Stream.of_string s in let buf = Buffer.create (String.length s) in let rec unescape strm buf = try let hex1 = Stream.next strm in let hex2 = Stream.next strm in Buffer.add_char buf (unescape_hexpair hex1 hex2); unescape strm buf with Stream.Failure -> Buffer.contents buf in match Stream.next strm with '#' -> unescape strm buf | _ -> failwith "invalid hexstring" %} %token Equals Plus Comma End_of_input %token AttributeType %token Oid %token String %token StringWithPair %token HexString %token QuoteString %type dn %start dn %% attrval: AttributeType {$1} | Oid {$1} | String {$1} | StringWithPair {unescape_stringwithpair $1} | HexString {unescape_hexstring $1} | QuoteString {unescape_quotestring $1} ; attrname: AttributeType {$1} | Oid {$1} ; dn: attrname Equals attrval Plus dn {match $5 with {attr_type=attr_name;attr_vals=vals} :: tl -> if $1 = attr_name then {attr_type=attr_name;attr_vals=($3 :: vals)} :: tl else failwith ("invalid multivalued rdn, expected: " ^ $1) | [] -> [{attr_type=$1;attr_vals=[$3]}]} | attrname Equals attrval Comma dn {{attr_type=$1;attr_vals=[$3]} :: $5} | attrname Equals attrval End_of_input {[{attr_type=$1;attr_vals=[$3]}]} | End_of_input {[]} ; ocamldap-2.1.8/ldap_error.ml0000644000175000017500000000512610444405447015321 0ustar gildorgildoropen Ldap_types let err2string code = match code with `SUCCESS -> "`SUCCESS" | `OPERATIONS_ERROR -> "`OPERATIONS_ERROR" | `PROTOCOL_ERROR -> "`PROTOCOL_ERROR" | `TIMELIMIT_EXCEEDED -> "`TIMELIMIT_EXCEEDED" | `SIZELIMIT_EXCEEDED -> "`SIZELIMIT_EXCEEDED" | `COMPARE_FALSE -> "`COMPARE_FALSE" | `COMPARE_TRUE -> "`COMPARE_TRUE" | `AUTH_METHOD_NOT_SUPPORTED -> "`AUTH_METHOD_NOT_SUPPORTED" | `STRONG_AUTH_REQUIRED -> "`STRONG_AUTH_REQUIRED" | `REFERRAL -> "`REFERRAL" | `ADMINLIMIT_EXCEEDED -> "`ADMINLIMIT_EXCEEDED" | `UNAVAILABLE_CRITICAL_EXTENSION -> "`UNAVAILABLE_CRITICAL_EXTENSION" | `CONFIDENTIALITY_REQUIRED -> "`CONFIDENTIALITY_REQUIRED" | `SASL_BIND_IN_PROGRESS -> "`SASL_BIND_IN_PROGRESS" | `NO_SUCH_ATTRIBUTE -> "`NO_SUCH_ATTRIBUTE" | `UNDEFINED_TYPE -> "`UNDEFINED_TYPE" | `INAPPROPRIATE_MATCHING -> "`INAPPROPRIATE_MATCHING" | `CONSTRAINT_VIOLATION -> "`CONSTRAINT_VIOLATION" | `TYPE_OR_VALUE_EXISTS -> "`TYPE_OR_VALUE_EXISTS" | `INVALID_SYNTAX -> "`INVALID_SYNTAX" | `NO_SUCH_OBJECT -> "`NO_SUCH_OBJECT" | `ALIAS_PROBLEM -> "`ALIAS_PROBLEM" | `INVALID_DN_SYNTAX -> "`INVALID_DN_SYNTAX" | `ALIAS_DEREF_PROBLEM -> "`ALIAS_DEREF_PROBLEM" | `INAPPROPRIATE_AUTH -> "`INAPPROPRIATE_AUTH" | `INVALID_CREDENTIALS -> "`INVALID_CREDENTIALS" | `INSUFFICIENT_ACCESS -> "`INSUFFICIENT_ACCESS" | `BUSY -> "`BUSY" | `UNAVAILABLE -> "`UNAVAILABLE" | `UNWILLING_TO_PERFORM -> "`UNWILLING_TO_PERFORM" | `LOOP_DETECT -> "`LOOP_DETECT" | `NAMING_VIOLATION -> "`NAMING_VIOLATION" | `OBJECT_CLASS_VIOLATION -> "`OBJECT_CLASS_VIOLATION" | `NOT_ALLOWED_ON_NONLEAF -> "`NOT_ALLOWED_ON_NONLEAF" | `NOT_ALLOWED_ON_RDN -> "`NOT_ALLOWED_ON_RDN" | `ALREADY_EXISTS -> "`ALREADY_EXISTS" | `NO_OBJECT_CLASS_MODS -> "`NO_OBJECT_CLASS_MODS" | `LOCAL_ERROR -> "`LOCAL_ERROR" | `SERVER_DOWN -> "`SERVER_DOWN" | `OTHER -> "`OTHER" | _ -> raise (LDAP_Decoder "invalid error code") let ldap_strerror msg ldaperror = match ldaperror with LDAP_Failure (code, error, {ext_matched_dn=mdn;ext_referral=refs}) -> "LDAP_Failure (" ^ (String.concat ", " [(err2string code); "\"" ^ (String.concat ": " (List.filter (function "" -> false | _ -> true) [error; msg])) ^ "\""; "{ext_matched_dn = " ^ "\"" ^ mdn ^ "\"; ext_referral = " ^ (match refs with Some lst -> "[" ^ (String.concat "; " lst) ^ "]" | None -> "None") ^ "})"]) | _ -> failwith "not an ldap error" let ldap_perror error ldaperror = prerr_endline (ldap_strerror error ldaperror) ocamldap-2.1.8/ldap_error.mli0000644000175000017500000000244110444405447015467 0ustar gildorgildoropen Ldap_types (** given an ldap error code return a string describing it *) val err2string : [> `ADMINLIMIT_EXCEEDED | `ALIAS_DEREF_PROBLEM | `ALIAS_PROBLEM | `ALREADY_EXISTS | `AUTH_METHOD_NOT_SUPPORTED | `BUSY | `COMPARE_FALSE | `COMPARE_TRUE | `CONFIDENTIALITY_REQUIRED | `CONSTRAINT_VIOLATION | `INAPPROPRIATE_AUTH | `INAPPROPRIATE_MATCHING | `INSUFFICIENT_ACCESS | `INVALID_CREDENTIALS | `INVALID_DN_SYNTAX | `INVALID_SYNTAX | `LOCAL_ERROR | `LOOP_DETECT | `NAMING_VIOLATION | `NOT_ALLOWED_ON_NONLEAF | `NOT_ALLOWED_ON_RDN | `NO_OBJECT_CLASS_MODS | `NO_SUCH_ATTRIBUTE | `NO_SUCH_OBJECT | `OBJECT_CLASS_VIOLATION | `OPERATIONS_ERROR | `OTHER | `PROTOCOL_ERROR | `REFERRAL | `SASL_BIND_IN_PROGRESS | `SERVER_DOWN | `SIZELIMIT_EXCEEDED | `STRONG_AUTH_REQUIRED | `SUCCESS | `TIMELIMIT_EXCEEDED | `TYPE_OR_VALUE_EXISTS | `UNAVAILABLE | `UNAVAILABLE_CRITICAL_EXTENSION | `UNDEFINED_TYPE | `UNWILLING_TO_PERFORM ] -> string (** return a string with a human readable description of an LDAP_Failure exception *) val ldap_strerror : string -> exn -> string (** print to stderr a string with a human readable description of an LDAP_Failure exception *) val ldap_perror : string -> exn -> unit ocamldap-2.1.8/ldap_filter.ml0000644000175000017500000001260010444405447015450 0ustar gildorgildor(* Ldap filter parser driver. Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_filterparser open Ldap_filterlexer open Str exception Invalid_filter of int * string (* escape a string to be put in a string representation of a search filter *) let star_rex = Pcre.regexp ~study:true "\\*" let lparen_rex = Pcre.regexp ~study:true "\\(" let rparen_rex = Pcre.regexp ~study:true "\\)" let backslash_rex = Pcre.regexp ~study:true "\\Q\\\\E" let null_rex = Pcre.regexp ~study:true "\\000" let escape_filterstring s = (Pcre.qreplace ~rex:star_rex ~templ:"\\2a" (Pcre.qreplace ~rex:lparen_rex ~templ:"\\28" (Pcre.qreplace ~rex:rparen_rex ~templ:"\\29" (Pcre.qreplace ~rex:null_rex ~templ:"\\00" (Pcre.qreplace ~rex:backslash_rex ~templ:"\\5c" s))))) let of_string f = let lxbuf = Lexing.from_string f in try filter_and_eof lexfilter lxbuf with Parsing.Parse_error -> raise (Invalid_filter (lxbuf.Lexing.lex_curr_pos, "parse error")) | Failure msg -> raise (Invalid_filter (lxbuf.Lexing.lex_curr_pos, msg)) let double_star_rex = regexp "\\*\\*" let to_string (f:filter) = let rec to_string' buf f = match f with `And lst -> Buffer.add_string buf "(&"; List.iter (fun f_component -> to_string' buf f_component) lst; Buffer.add_char buf ')' | `Or lst -> Buffer.add_string buf "(|"; List.iter (fun f_component -> to_string' buf f_component) lst; Buffer.add_char buf ')' | `Not f_component -> Buffer.add_string buf "(!"; to_string' buf f_component; Buffer.add_char buf ')' | `EqualityMatch {attributeDesc=attrname;assertionValue=valu} -> Buffer.add_char buf '('; Buffer.add_string buf attrname; Buffer.add_char buf '='; Buffer.add_string buf (escape_filterstring valu); Buffer.add_char buf ')' | `Substrings {attrtype=attrname; substrings={substr_initial=initial; substr_any=any; substr_final=final}} -> Buffer.add_char buf '('; Buffer.add_string buf attrname; Buffer.add_char buf '='; Buffer.add_string buf (global_replace double_star_rex "*" ((match initial with [s] -> (escape_filterstring s) ^ "*" | [] -> "" | _ -> raise (Invalid_filter (0, "multiple substring components cannot be represented"))) ^ (match any with [] -> "" | lst -> List.fold_left (fun f s -> f ^ "*" ^ (escape_filterstring s) ^ "*") "" lst) ^ (match final with [s] -> "*" ^ (escape_filterstring s) | [] -> "" | _ -> raise (Invalid_filter (0, "multiple substring components cannot be represented"))))); Buffer.add_char buf ')'; | `GreaterOrEqual {attributeDesc=attrname;assertionValue=valu} -> Buffer.add_char buf '('; Buffer.add_string buf attrname; Buffer.add_string buf ">="; Buffer.add_string buf (escape_filterstring valu); Buffer.add_char buf ')' | `LessOrEqual {attributeDesc=attrname;assertionValue=valu} -> Buffer.add_char buf '('; Buffer.add_string buf attrname; Buffer.add_string buf "<="; Buffer.add_string buf (escape_filterstring valu); Buffer.add_char buf ')' | `ApproxMatch {attributeDesc=attrname;assertionValue=valu} -> Buffer.add_char buf '('; Buffer.add_string buf attrname; Buffer.add_string buf "~="; Buffer.add_string buf (escape_filterstring valu); Buffer.add_char buf ')' | `Present attr -> Buffer.add_char buf '('; Buffer.add_string buf attr; Buffer.add_string buf "=*"; Buffer.add_char buf ')' | `ExtensibleMatch {matchingRule=rul;ruletype=rtype; matchValue=matchval;dnAttributes=dnattrs} -> Buffer.add_char buf '('; (match rtype with Some attrname -> Buffer.add_string buf attrname; (if dnattrs then Buffer.add_string buf ":dn"); (match rul with Some r -> Buffer.add_char buf ':'; Buffer.add_string buf r | None -> ()); Buffer.add_string buf ":="; Buffer.add_string buf (escape_filterstring matchval) | None -> ((if dnattrs then Buffer.add_string buf ":dn"); (match rul with Some r -> Buffer.add_char buf ':'; Buffer.add_string buf r; Buffer.add_string buf ":="; Buffer.add_string buf (escape_filterstring matchval) | None -> raise (Invalid_filter (0, "matchingRule is required if type is unspecified"))))); Buffer.add_char buf ')' in let buf = Buffer.create 100 in to_string' buf f; Buffer.contents buf ocamldap-2.1.8/ldap_filter.mli0000644000175000017500000000444310444405447015627 0ustar gildorgildor(** operations on ldap search filters Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** raised when something goes wrong in to_string or of_string. The integer argument is, in the case of of_string, the position in the string at which the error occurred. It has no meaning in to_string, and may take any value. *) exception Invalid_filter of int * string (** turn the string representation into the internal representation defined in ldap_types.ml. This representation is suitable for sending on the wire, and can also have all sorts of operations performed on it. play around with it in the toplevel to get a feel for it *) val of_string : string -> Ldap_types.filter (** turn an internal representaion of a filter into a string representaion compliant with rfc2254*) val to_string : Ldap_types.filter -> string (** escape a string which is intended to be the VALUE of an attribute assertion in a filter. Do not use this on a whole filter, it will destroy all the meta chars. Use it only on the VALUE part of the assertion. It is NOT necessary to use this function if you intend to call to_string, escaping will be done for you in that case. This function is exposed because you may want to manipulate a filter with a regular expression, or other string means, and you may find it necessary to escape values manually in that case. *) val escape_filterstring : string -> string ocamldap-2.1.8/ldap_filterlexer.mll0000644000175000017500000000676310444405447016701 0ustar gildorgildor(* a lexer for rfc2254 human readable search filters Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { open Ldap_filterparser open Ldap_types let star = Pcre.regexp ~study:true "\\*" let substr_proto = {substr_initial=[];substr_any=[];substr_final=[]} let to_substr v = let substrs = Pcre.split ~rex:star v in (if v.[0] = '*' then (* pcre puts the empty string on the front of the list if the delimeter is the first char in the string *) let substrs = List.tl substrs in if v.[(String.length v) - 1] = '*' then {substr_proto with substr_any=substrs} else {substr_initial=[]; substr_final=[(List.hd (List.rev substrs))]; substr_any=(try List.rev (List.tl (List.rev substrs)) with _ -> [])} else if v.[(String.length v) - 1] = '*' then {substr_initial=(try [List.hd substrs] with _ -> []); substr_any=(try List.tl substrs with _ -> []); substr_final=[]} else {substr_initial=(try [List.hd substrs] with _ -> []); substr_final=(try [List.hd (List.rev substrs)] with _ -> []); substr_any=(try (List.rev (List.tl (List.rev (List.tl substrs)))) with _ -> [])}) } let lparen = '(' let rparen = ')' let andop = '&' let orop = '|' let notop = '!' let equalop = '=' let colonequalop = ":=" let approxop = '~' equalop let gteop = '>' equalop let lteop = '<' equalop let star = '*' let attr = [ '0' - '9' 'a' - 'z' 'A' - 'Z' ] + let hexdigit = [ '0' - '9' 'a' - 'f' 'A' - 'F' ] let escape = '\\' hexdigit hexdigit let value = escape | ( [ '\t' ' ' '!' - '~' ] # [ '(' ')' '&' '|' '*' ] ) let values = value + let colon = ':' let oid = ( [ '0' - '9' '.' ] + as oid) let dn = colon "dn" let matchingrule = colon oid let extendedmatchattr = (attr as a) matchingrule let extendeddnattr = (attr as a) dn (matchingrule)? let substrany = star (values star) + let substr = substrany | values substrany | substrany values | values substrany values | values star | star values | values star values rule lexfilter = parse lparen {LPAREN} | rparen {RPAREN} | andop {AND} | orop {OR} | notop {NOT} | (attr as a) equalop (substr as v) {ATTREQUALSUB (a, to_substr v)} | (attr as a) equalop star {ATTRPRESENT a} | (attr as a) equalop (values as v) {ATTREQUAL (a, v)} | (attr as a) gteop (values as v) {ATTRGTE (a, v)} | (attr as a) lteop (values as v) {ATTRLTE (a, v)} | (attr as a) approxop (values as v) {ATTRAPPROX (a, v)} | extendedmatchattr colonequalop (values as v) {ATTREXTENDEDMATCH (a, oid, v)} | extendeddnattr colonequalop (values as v) {ATTREXTENDEDDN (a, oid, v)} | eof {EOF} ocamldap-2.1.8/ldap_filterparser.mly0000644000175000017500000000644210444405447017065 0ustar gildorgildor/* a parser for rfc2254 ldap filters Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ %{ open Ldap_filterlexer open Ldap_types let star_escape_rex = Pcre.regexp ~study:true ("\\" ^ "\\2a") let lparen_escape_rex = Pcre.regexp ~study:true ("\\" ^ "\\28") let rparen_escape_rex = Pcre.regexp ~study:true ("\\" ^ "\\29") let backslash_escape_rex = Pcre.regexp ~study:true ("\\" ^ "\\5c") let null_escape_rex = Pcre.regexp ~study:true ("\\" ^ "\\00") let unescape s = (Pcre.qreplace ~rex:star_escape_rex ~templ:"*" (Pcre.qreplace ~rex:lparen_escape_rex ~templ:"(" (Pcre.qreplace ~rex:rparen_escape_rex ~templ:")" (Pcre.qreplace ~rex:null_escape_rex ~templ:"\000" (Pcre.qreplace ~rex:backslash_escape_rex ~templ:"\\" s))))) %} %token WHSP LPAREN RPAREN AND OR NOT EOF %token ATTREQUAL %token ATTREQUALSUB %token ATTRGTE %token ATTRLTE %token ATTRAPPROX %token ATTRPRESENT %token ATTREXTENDEDMATCH %token ATTREXTENDEDDN %start filter_and_eof %type filter_and_eof %% filterlist: filterlist filter {$2 :: $1} | filter {[$1]} ; filter: LPAREN AND filterlist RPAREN {`And $3} | LPAREN OR filterlist RPAREN {`Or $3} | LPAREN NOT filter RPAREN {`Not $3} | LPAREN filter RPAREN {$2} | ATTREQUALSUB {`Substrings {attrtype=(fst $1);substrings=(snd $1)}} | ATTREQUAL {`EqualityMatch {attributeDesc=(fst $1);assertionValue=(unescape (snd $1))}} | ATTRGTE {`GreaterOrEqual {attributeDesc=(fst $1);assertionValue=(unescape (snd $1))}} | ATTRLTE {`LessOrEqual {attributeDesc=(fst $1);assertionValue=(unescape (snd $1))}} | ATTRPRESENT {`Present $1} | ATTRAPPROX {`ApproxMatch {attributeDesc=(fst $1);assertionValue=(unescape (snd $1))}} | ATTREXTENDEDMATCH {let (a, oid, v) = $1 in `ExtensibleMatch {matchingRule=(Some (unescape oid)); ruletype=(Some (unescape a)); matchValue=(unescape v); dnAttributes=false}} | ATTREXTENDEDDN {let (a, oid, v) = $1 in `ExtensibleMatch {matchingRule=(match oid with Some s -> Some (unescape s) | None -> None); ruletype=(Some (unescape a)); matchValue=(unescape v); dnAttributes=true}} ; /* used to enforce EOF at the end of the filter */ filter_and_eof: filter EOF {$1} ; ocamldap-2.1.8/ldap_funclient.ml0000644000175000017500000003123310444405447016155 0ustar gildorgildor(* A functional client interface to ldap Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_protocol open Lber open Unix open Sys type msgid = Int32.t type ld_socket = Ssl of Ssl.socket | Plain of file_descr type conn = { mutable rb: readbyte; mutable socket: ld_socket; (* communications channel to the ldap server *) mutable current_msgid: Int32.t; (* the largest message id allocated so far *) pending_messages: (int32, ldap_message Queue.t) Hashtbl.t; protocol_version: int; } type attr = { attr_name: string; attr_values: string list } type modattr = modify_optype * string * string list type result = search_result_entry list type entry = search_result_entry type authmethod = [ `SIMPLE | `SASL ] type search_result = [ `Entry of entry | `Referral of (string list) ] let ext_res = {ext_matched_dn=""; ext_referral=None} let _ = Ssl.init () (* limits us to Int32.max_int active async operations at any one time *) let find_free_msgid con = let msgid = con.current_msgid in (if msgid = Int32.max_int then con.current_msgid <- 0l else con.current_msgid <- Int32.succ con.current_msgid); msgid (* allocate a message id from the free message id pool *) let allocate_messageid con = let msgid = find_free_msgid con in Hashtbl.replace con.pending_messages msgid (Queue.create ()); msgid let free_messageid con msgid = try Hashtbl.remove con.pending_messages msgid with Not_found -> raise (LDAP_Failure (`LOCAL_ERROR, "free_messageid: invalid msgid", ext_res)) (* send an ldapmessage *) let send_message con msg = let write ld_socket buf off len = match ld_socket with Ssl s -> (try Ssl.write s buf off len with Ssl.Write_error _ -> raise (Unix_error (EPIPE, "Ssl.write", ""))) | Plain s -> Unix.write s buf off len in let e_msg = encode_ldapmessage msg in let len = String.length e_msg in let written = ref 0 in try while !written < len do written := ((write con.socket e_msg !written (len - !written)) + !written) done with Unix_error (EBADF, _, _) | Unix_error (EPIPE, _, _) | Unix_error (ECONNRESET, _, _) | Unix_error (ECONNABORTED, _, _) | Sys_error _ -> (raise (LDAP_Failure (`SERVER_DOWN, "the connection object is invalid, data cannot be written", ext_res))) (* recieve an ldapmessage for a particular message id (messages for all other ids will be read and queued. They can be retreived later) *) let receive_message con msgid = let q_for_msgid con msgid = try Hashtbl.find con.pending_messages msgid with Not_found -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid message id", ext_res)) in let rec read_message con msgid = let msg = decode_ldapmessage con.rb in if msg.messageID = msgid then msg else (let q = q_for_msgid con msg.messageID in Queue.add msg q; read_message con msgid) in let q = q_for_msgid con msgid in try if Queue.is_empty q then read_message con msgid else Queue.take q with Readbyte_error Transport_error -> raise (LDAP_Failure (`SERVER_DOWN, "read error", ext_res)) | Readbyte_error End_of_stream -> raise (LDAP_Failure (`LOCAL_ERROR, "bug in ldap decoder detected", ext_res)) let init ?(connect_timeout = 1) ?(version = 3) hosts = if ((version < 2) || (version > 3)) then raise (LDAP_Failure (`LOCAL_ERROR, "invalid protocol version", ext_res)) else let fd = let addrs = (List.flatten (List.map (fun (mech, host, port) -> try (List.rev_map (fun addr -> (mech, addr, port)) (Array.to_list ((gethostbyname host).h_addr_list))) with Not_found -> []) (List.map (fun host -> (match Ldap_url.of_string host with {url_mech=mech;url_host=(Some host);url_port=(Some port)} -> (mech, host, int_of_string port) | {url_mech=mech;url_host=(Some host);url_port=None} -> (mech, host, 389) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid ldap url", ext_res)))) hosts))) in let rec open_con addrs = let previous_signal = ref Signal_default in match addrs with (mech, addr, port) :: tl -> (try if mech = `PLAIN then let s = socket PF_INET SOCK_STREAM 0 in try previous_signal := signal sigalrm (Signal_handle (fun _ -> failwith "timeout")); ignore (alarm connect_timeout); connect s (ADDR_INET (addr, port)); ignore (alarm 0); set_signal sigalrm !previous_signal; Plain s with exn -> close s;raise exn else (previous_signal := signal sigalrm (Signal_handle (fun _ -> failwith "timeout")); ignore (alarm connect_timeout); let ssl = Ssl (Ssl.open_connection Ssl.SSLv23 (ADDR_INET (addr, port))) in ignore (alarm 0); set_signal sigalrm !previous_signal; ssl) with Unix_error (ECONNREFUSED, _, _) | Unix_error (EHOSTDOWN, _, _) | Unix_error (EHOSTUNREACH, _, _) | Unix_error (ECONNRESET, _, _) | Unix_error (ECONNABORTED, _, _) | Ssl.Connection_error _ | Failure "timeout" -> ignore (alarm 0); set_signal sigalrm !previous_signal; open_con tl) | [] -> raise (LDAP_Failure (`SERVER_DOWN, "", ext_res)) in open_con addrs in {rb=(match fd with Ssl s -> Lber.readbyte_of_ssl s | Plain s -> Lber.readbyte_of_fd s); socket=fd; current_msgid=1l; pending_messages=(Hashtbl.create 3); protocol_version=version} (* sync auth_method types between the two files *) let bind_s ?(who = "") ?(cred = "") ?(auth_method = `SIMPLE) con = let msgid = allocate_messageid con in (try send_message con {messageID=msgid; protocolOp=Bind_request {bind_version=con.protocol_version; bind_name=who; bind_authentication=(Simple cred)}; controls=None}; match receive_message con msgid with {protocolOp=Bind_response {bind_result={result_code=`SUCCESS}}} -> () | {protocolOp=Bind_response {bind_result=res}} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid server response", ext_res)) with exn -> free_messageid con msgid;raise exn); free_messageid con msgid let search ?(base = "") ?(scope = `SUBTREE) ?(aliasderef=`NEVERDEREFALIASES) ?(sizelimit=0l) ?(timelimit=0l) ?(attrs = []) ?(attrsonly = false) con filter = let msgid = allocate_messageid con in try let e_filter = (try Ldap_filter.of_string filter with _ -> (raise (LDAP_Failure (`LOCAL_ERROR, "bad search filter", ext_res)))) in send_message con {messageID=msgid; protocolOp=Search_request {baseObject=base; scope=scope; derefAliases=aliasderef; sizeLimit=sizelimit; timeLimit=timelimit; typesOnly=attrsonly; filter=e_filter; s_attributes=attrs}; controls=None}; msgid with exn -> free_messageid con msgid;raise exn let get_search_entry con msgid = try match receive_message con msgid with {protocolOp=Search_result_entry e} -> `Entry e | {protocolOp=Search_result_reference r} -> `Referral r | {protocolOp=Search_result_done {result_code=`SUCCESS}} -> raise (LDAP_Failure (`SUCCESS, "success", ext_res)) | {protocolOp=Search_result_done res} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "unexpected search response", ext_res)) with exn -> free_messageid con msgid;raise exn let abandon con msgid = let my_msgid = allocate_messageid con in try free_messageid con msgid; send_message con {messageID=my_msgid; protocolOp=(Abandon_request msgid); controls=None} with exn -> free_messageid con my_msgid;raise exn let search_s ?(base = "") ?(scope = `SUBTREE) ?(aliasderef=`NEVERDEREFALIASES) ?(sizelimit=0l) ?(timelimit=0l) ?(attrs = []) ?(attrsonly = false) con filter = let msgid = search ~base:base ~scope:scope ~aliasderef:aliasderef ~sizelimit:sizelimit ~timelimit:timelimit ~attrs:attrs ~attrsonly:attrsonly con filter in let result = ref [] in (try while true do result := (get_search_entry con msgid) :: !result done with LDAP_Failure (`SUCCESS, _, _) -> () | LDAP_Failure (code, msg, ext) -> raise (LDAP_Failure (code, msg, ext)) | exn -> (try abandon con msgid with _ -> ());raise exn); free_messageid con msgid; !result let add_s con (entry: entry) = let msgid = allocate_messageid con in (try send_message con {messageID=msgid; protocolOp=Add_request entry; controls=None}; match receive_message con msgid with {protocolOp=Add_response {result_code=`SUCCESS}} -> () | {protocolOp=Add_response res} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid add response", ext_res)) with exn -> free_messageid con msgid;raise exn); free_messageid con msgid let delete_s con ~dn = let msgid = allocate_messageid con in (try send_message con {messageID=msgid; protocolOp=Delete_request dn; controls=None}; match receive_message con msgid with {protocolOp=Delete_response {result_code=`SUCCESS}} -> () | {protocolOp=Delete_response res} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid delete response", ext_res)) with exn -> free_messageid con msgid;raise exn); free_messageid con msgid let unbind con = try (match con.socket with Ssl s -> Ssl.shutdown s | Plain s -> close s) with _ -> () let modify_s con ~dn ~mods = let rec convertmods ?(converted=[]) mods = match mods with (op, attr, values) :: tl -> (convertmods ~converted:({mod_op=op; mod_value={attr_type=attr; attr_vals=values}} :: converted) tl) | [] -> converted in let msgid = allocate_messageid con in (try send_message con {messageID=msgid; protocolOp=Modify_request {mod_dn=dn; modification=convertmods mods}; controls=None}; match receive_message con msgid with {protocolOp=Modify_response {result_code=`SUCCESS}} -> () | {protocolOp=Modify_response res} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid modify response", ext_res)) with exn -> free_messageid con msgid;raise exn); free_messageid con msgid let modrdn_s ?(deleteoldrdn=true) ?(newsup=None) con ~dn ~newdn = let msgid = allocate_messageid con in (try send_message con {messageID=msgid; protocolOp=Modify_dn_request {modn_dn=dn; modn_newrdn=newdn; modn_deleteoldrdn=deleteoldrdn; modn_newSuperior=None}; controls=None}; match receive_message con msgid with {protocolOp=Modify_dn_response {result_code=`SUCCESS}} -> () | {protocolOp=Modify_dn_response res} -> raise (LDAP_Failure (res.result_code, res.error_message, {ext_matched_dn=res.matched_dn; ext_referral=res.ldap_referral})) | _ -> raise (LDAP_Failure (`LOCAL_ERROR, "invalid modify dn response", ext_res)) with exn -> free_messageid con msgid;raise exn); free_messageid con msgid let create_grouping_s groupingType value = () let end_grouping_s cookie value = () ocamldap-2.1.8/ldap_funclient.mli0000644000175000017500000001754010444405447016333 0ustar gildorgildor(* a functional interface to ldap Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** a functional ldap client interface *) open Unix open Ldap_types open Lber type msgid type conn type modattr = modify_optype * string * string list type result = Ldap_types.search_result_entry list type entry = Ldap_types.search_result_entry type authmethod = [ `SIMPLE | `SASL ] type search_result = [ `Entry of entry | `Referral of string list ] (** Initializes the conn data structure, and opens a connection to the server. init [["ldap://rrhost.example.com/";"ldap://backup.example.com:1389"]]. init is round robin dns aware, if dns returns multiple mappings it will try each one before finially failing. It also takes a list of hostnames, so you can specify backup servers to try. SSL and TLS are supported if selected at compile time. @param version the protocol version to use to connect, default is version 3. And actually, version 2 will probably not work correctly without some tweaking. @raise LDAP_Failure any failure to connect to the server will result in LDAP_Failure with the result_code set to `LOCAL_ERROR. @raise Failure May raise Failure "int_of_string" if you pass it a malformed url. May also raise various lexer errors under the same conditions. *) val init : ?connect_timeout:int -> ?version:int -> string list -> conn (** close the connection to the server. You may not use the conn after you have unbound, if you do you will get an exception. *) val unbind : conn -> unit (** authenticatite to the server. In this version only simple binds are supported, however the ldap_protocol.ml module DOES implement sasl binds. It would be fairly easy to support them here. We eventually will. @param who the dn to bind as @param cred the credentials to authenticate with. For `SIMPLE binds this is a password, but for `SASL binds it can be nearly anything. Perhaps a hash of the thumb print of your first born is sufficent. @param auth_method either `SIMPLE (the default) or `SASL @raise LDAP_Failure for bind errors such as `INVALID_CREDENTIALS @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val bind_s : ?who:string -> ?cred:string -> ?auth_method:[> `SIMPLE ] -> conn -> unit (** Search for the given entry with the specified base node and search scope, optionally limiting the returned attributes to those listed in 'attrs'. aliasderef sets the server's alias dereferencing policy, sizelimit is the number of entries to return, timelimit is the number of seconds to allow the search to run for, attrsonly tells the server not to return the values. This is the asyncronus version of search (it does not block) you will need to call the get_search_entry function below to actually get any data back. This function will return a msgid which you must use when you call get_search_entry. @param base The dn of the object in the tree to use as the base object, the search will only cover children of this object, and will be further governed by scope. @param scope The depth in the tree to look for the requested object. There are three possible values, `BASE, `ONELEVEL, and `SUBTREE. `BASE means to only search the base object, the search will return exactly 1 or 0 objects. `ONELEVEL means to search one level under the base, only immediate children of the base object will be considered. `SUBTREE means to search the entire tree under the base object. @param aliasderef Controls when aliases are dereferenced. @param sizelimit The maximum number of objects to return @param timelimit The maximum time, in seconds, that the search will be allowed to run before terminateing. @param attrs The list of attribute types (names) to include [[]] (the default) means all. @param attrsonly return only attribute types (names), not any of the values @raise LDAP_Failure for immediate errors (bad filter, etc) @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val search : ?base:string -> ?scope:Ldap_types.search_scope -> ?aliasderef:Ldap_types.alias_deref -> ?sizelimit:int32 -> ?timelimit:int32 -> ?attrs:string list -> ?attrsonly:bool -> conn -> string -> msgid (** fetch a search entry from the wire using the given msgid. The entry could be a search entry, OR it could be a referral structure. @raise LDAP_Failure for all results other than `SUCCESS (except referrals) @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val get_search_entry : conn -> msgid -> [> `Entry of Ldap_types.search_result_entry | `Referral of string list ] (** abandon the async request attached to msgid. @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val abandon : conn -> msgid -> unit (** This is the syncronus version of search. It blocks until the search is complete, and returns a list of objects. It is exactly the same in all other ways. *) val search_s : ?base:string -> ?scope:Ldap_types.search_scope -> ?aliasderef:Ldap_types.alias_deref -> ?sizelimit:int32 -> ?timelimit:int32 -> ?attrs:string list -> ?attrsonly:bool -> conn -> string -> [> `Entry of Ldap_types.search_result_entry | `Referral of string list ] list (** add entry to the directory @raise LDAP_Failure for all results other than `SUCCESS @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val add_s : conn -> entry -> unit (** delete the entry named by dn from the directory @raise LDAP_Failure for all results other than `SUCCESS @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val delete_s : conn -> dn:string -> unit (** apply the list of modifications to the named entry @param dn The dn of the object to modify @param mods The list of modifications to apply @raise LDAP_Failure for all results other than `SUCCESS @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val modify_s : conn -> dn:string -> mods:(Ldap_types.modify_optype * string * string list) list -> unit (** change the rdn, and optionally the superior entry of dn @param deleteoldrdn Delete the old rdn value, (default true) @param newsup The new superior dn of the object (default None) @param dn The dn of the object to modify @param newrdn The new rdn value (eg. cn=bob) @raise LDAP_Failure for all results other than `SUCCESS @raise Decoding_error for decoder errors (unlikely, probably a bug) @raise Encoding_error for encoder errors (unlikely, probably a bug) *) val modrdn_s : ?deleteoldrdn:bool -> ?newsup:'a option -> conn -> dn:string -> newdn:string -> unit ocamldap-2.1.8/ldap_funserver.ml0000644000175000017500000003416110444405447016210 0ustar gildorgildor(* Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Lber open Ldap_types open Ldap_protocol open Unix open Printf exception Server_error of string exception Finished type connection_id = int type backendInfo = { bi_op_bind : (connection_id -> ldap_message -> ldap_message) option; bi_op_unbind : (connection_id -> ldap_message -> unit) option; bi_op_search : (connection_id -> ldap_message -> (unit -> ldap_message)) option; bi_op_compare : (connection_id -> ldap_message -> ldap_message) option; bi_op_modify : (connection_id -> ldap_message -> ldap_message) option; bi_op_modrdn : (connection_id -> ldap_message -> ldap_message) option; bi_op_add : (connection_id -> ldap_message -> ldap_message) option; bi_op_delete : (connection_id -> ldap_message -> ldap_message) option; bi_op_abandon : (connection_id -> ldap_message -> unit) option; bi_op_extended : (connection_id -> ldap_message -> ldap_message) option; bi_init : (unit -> unit) option; bi_close : (unit -> unit) option; } type log_level = [ `GENERAL | `CONNECTION | `OPERATIONS | `ERROR | `TRACE ] type msgid = int type opcnt = int type pending_operations = (unit -> unit) list type server_info = { si_listening_socket: file_descr; si_client_sockets: (file_descr, connection_id * opcnt * pending_operations * readbyte) Hashtbl.t; si_backend: backendInfo; si_log: (log_level -> string -> unit); mutable si_current_connection_id: int; } let allocate_connection_id si = if si.si_current_connection_id < max_int then (si.si_current_connection_id <- si.si_current_connection_id + 1; si.si_current_connection_id) else (si.si_current_connection_id <- 1;1) let log_result conn_id op_nr si msg = let log_search_result {result_code=err;error_message=text} = si.si_log `OPERATIONS (sprintf "conn=%d op=%d SEARCH RESULT tag=0 err=%d nentries=0 text=%s" conn_id op_nr (Ldap_protocol.encode_resultcode err) text) in let log_normal_result {result_code=err;error_message=text} = si.si_log `OPERATIONS (sprintf "conn=%d op=%d RESULT tag=0 err=%d text=%s" conn_id op_nr (Ldap_protocol.encode_resultcode err) text) in match msg.protocolOp with Bind_response {bind_result=result} | Modify_response result | Add_response result | Delete_response result | Modify_dn_response result | Compare_response result -> log_normal_result result | Search_result_done result -> log_search_result result | _ -> () let send_message si conn_id op_nr fd msg = let e_msg = encode_ldapmessage msg in let len = String.length e_msg in let written = ref 0 in try while !written < len do written := ((write fd e_msg !written (len - !written)) + !written) done; log_result conn_id op_nr si msg with Unix_error (_, _, _) -> (try close fd with _ -> ()); raise (Server_error "data cannot be written") let keys h = Hashtbl.fold (fun k v l -> k :: l) h [] let init ?(log=(fun _ _ -> ())) ?(port=389) bi = let s = let s = socket PF_INET SOCK_STREAM 0 in setsockopt s SO_REUSEADDR true; bind s (ADDR_INET (inet_addr_any, port)); listen s 500; s in (match bi.bi_init with Some f -> f () | None -> ()); {si_listening_socket=s; si_client_sockets=Hashtbl.create 10; si_current_connection_id=0; si_log=log; si_backend=bi} let shutdown si = (match si.si_backend.bi_close with Some f -> f () | None -> ()); close si.si_listening_socket; List.iter (fun fd -> close fd) (keys si.si_client_sockets); Hashtbl.clear si.si_client_sockets; si.si_log `GENERAL "stopped." let dispatch_request si conn_id op_nr rb fd = let bi = si.si_backend in let not_imp msg op = {messageID=msg.messageID; protocolOp=op; controls=None} in let not_implemented = {result_code=`OTHER; matched_dn=""; error_message="Not Implemented"; ldap_referral=None} in let message = decode_ldapmessage rb in match message with {protocolOp=Bind_request {bind_name=dn;bind_authentication=auth}} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d BIND dn=\"%s\" method=128" conn_id op_nr dn); si.si_log `OPERATIONS (sprintf "conn=%d op=%d BIND dn=\"%s\" mech=%s ssf=0" conn_id op_nr dn (match auth with Simple _ -> "SIMPLE" | Sasl _ -> "SASL")); (match bi.bi_op_bind with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Bind_response {bind_result=not_implemented; bind_serverSaslCredentials=None})); raise Finished)) | {protocolOp=Unbind_request} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d UNBIND" conn_id op_nr); (match bi.bi_op_unbind with Some f -> (fun () -> f conn_id message;raise Finished) | None -> (fun () -> raise Finished)) | {protocolOp=(Search_request {baseObject=base; scope=scope; derefAliases=deref; sizeLimit=sizelimit; timeLimit=timelimit; typesOnly=attrsonly; filter=filter; s_attributes=attrs})} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d SRCH base=\"%s\" scope=%d deref=%d filter=\"%s\"" conn_id op_nr base (match scope with `BASE -> 0 | `ONELEVEL -> 1 | `SUBTREE -> 2) (match deref with `NEVERDEREFALIASES -> 0 | `DEREFINSEARCHING -> 1 | `DEREFFINDINGBASE -> 2 | `DEREFALWAYS -> 3) (Ldap_filter.to_string filter)); (match attrs with [] -> () | lst -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d SRCH attr=%s" conn_id op_nr (List.fold_left (fun s attr -> if s = "" then attr else (attr ^ " " ^ s)) "" lst))); (match bi.bi_op_search with Some f -> let get_srch_result = f conn_id message in (fun () -> let msg = get_srch_result () in send_message si conn_id op_nr fd msg; match msg.protocolOp with Search_result_done _ -> raise Finished | _ -> ()) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Search_result_done not_implemented)); raise Finished)) | {protocolOp=Modify_request {mod_dn=modify;modification=modlst}} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d MOD dn=\"%s\"" conn_id op_nr modify); si.si_log `OPERATIONS (sprintf "conn=%d op=%d MOD attr=\"%s\"" conn_id op_nr (List.fold_left (fun s attr -> if s = "" then attr.mod_value.attr_type else (attr.mod_value.attr_type ^ " " ^ s)) "" modlst)); (match bi.bi_op_modify with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Modify_response not_implemented)); raise Finished)) | {protocolOp=Add_request {sr_dn=dn}} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d ADD dn=\"%s\"" conn_id op_nr dn); (match bi.bi_op_add with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Add_response not_implemented)); raise Finished)) | {protocolOp=Delete_request dn} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d DEL dn=\"%s\"" conn_id op_nr dn); (match bi.bi_op_delete with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Delete_response not_implemented)); raise Finished)) | {protocolOp=Modify_dn_request {modn_dn=dn}} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d MODRDN dn=\"%s\"" conn_id op_nr dn); (match bi.bi_op_modrdn with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Modify_dn_response not_implemented)); raise Finished)) | {protocolOp=Compare_request {cmp_dn=dn;cmp_ava=ava}} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d CMP dn=\"%s\" attr=\"%s\"" conn_id op_nr dn ava.attributeDesc); (match bi.bi_op_compare with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Compare_response not_implemented)); raise Finished)) | {protocolOp=Abandon_request msgid} -> si.si_log `OPERATIONS (sprintf "conn=%d op=%d ABANDON msgid=%ld" conn_id op_nr msgid); (match bi.bi_op_abandon with Some f -> (fun () -> f conn_id message;raise Finished) | None -> (fun () -> raise Finished)) | {protocolOp=Extended_request _} -> (match bi.bi_op_extended with Some f -> (fun () -> send_message si conn_id op_nr fd (f conn_id message); raise Finished) | None -> (fun () -> send_message si conn_id op_nr fd (not_imp message (Extended_response {ext_result=not_implemented; ext_responseName=None; ext_response=None})); raise Finished)) | _ -> raise (Server_error "invalid operation") let string_of_sockaddr sockaddr = match sockaddr with ADDR_UNIX addr -> addr | ADDR_INET (ip, port) -> (sprintf "%s:%d" (string_of_inet_addr ip) port) let run si = let pending_writes si = (* do we have data to write? *) Hashtbl.fold (fun k (_, _, ops_pending, _) pending -> match ops_pending with [] -> pending | _ -> k :: pending) si.si_client_sockets [] in let process_read reading writing excond (fd:file_descr) = if Hashtbl.mem si.si_client_sockets fd then (* an existing client has requested a new operation *) let (conn_id, op_nr, pending_ops, rb) = Hashtbl.find si.si_client_sockets fd in try try Hashtbl.replace si.si_client_sockets fd (conn_id, (op_nr + 1), (dispatch_request si conn_id op_nr rb fd) :: pending_ops, rb) with LDAP_Decoder e | Decoding_error e -> (* handle protocol errors *) send_message si conn_id 0 fd (* send a notice of disconnection *) {messageID=0l; protocolOp=Extended_response {ext_result={result_code=`PROTOCOL_ERROR; matched_dn=""; error_message=e; ldap_referral=None}; ext_responseName=(Some "1.3.6.1.4.1.1466.20036"); ext_response=None}; controls=None}; raise (Readbyte_error Transport_error) (* close the connection *) with Readbyte_error Transport_error -> (match si.si_backend.bi_op_unbind with Some f -> f conn_id {messageID=0l;protocolOp=Unbind_request;controls=None} | None -> ()); (* remove the client from our table of clients, and from the list of readable/writable fds, that way we don't try to do a write to them, even though we may have pending writes *) Hashtbl.remove si.si_client_sockets fd; reading := List.filter ((<>) fd) !reading; writing := List.filter ((<>) fd) !writing; excond := List.filter ((<>) fd) !excond; (try close fd with _ -> ()); si.si_log `CONNECTION (sprintf "conn=%d fd=0 closed" conn_id) else (* a new connection has come in, accept it *) let (newfd, sockaddr) = accept fd in let rb = readbyte_of_fd newfd in let connid = allocate_connection_id si in Hashtbl.add si.si_client_sockets newfd (connid, 0, [], rb); si.si_log `CONNECTION (sprintf "conn=%d fd=0 ACCEPT from IP=%s (IP=%s)" connid (string_of_sockaddr sockaddr) (string_of_sockaddr (getsockname fd))) in let process_write reading writing excond (fd: file_descr) = if Hashtbl.mem si.si_client_sockets fd then let (conn_id, op_nr, pending_ops, rb) = Hashtbl.find si.si_client_sockets fd in try match pending_ops with [] -> () | hd :: tl -> try hd () with Finished -> Hashtbl.replace si.si_client_sockets fd (conn_id, op_nr, tl, rb) with Server_error "data cannot be written" -> (match si.si_backend.bi_op_unbind with Some f -> f conn_id {messageID=0l;protocolOp=Unbind_request;controls=None} | None -> ()); Hashtbl.remove si.si_client_sockets fd; reading := List.filter ((<>) fd) !reading; writing := List.filter ((<>) fd) !writing; excond := List.filter ((<>) fd) !excond; si.si_log `CONNECTION (sprintf "conn=%d fd=0 closed" conn_id) else raise (Server_error "socket to write to not found") in si.si_log `GENERAL "starting"; while true do let fds = keys si.si_client_sockets in let reading = ref [] and writing = ref [] and excond = ref [] in let (rd, wr, ex) = select (si.si_listening_socket :: fds) (pending_writes si) (* nothing to write? don't bother *) fds (-1.0) in reading := rd;writing := wr;excond := ex; (* service connections which are ready to be read *) List.iter (process_read reading writing excond) !reading; (* service connections which are ready to be written to *) List.iter (process_write reading writing excond) !writing; (* Process out of band data *) List.iter (process_read reading writing excond) !excond done ocamldap-2.1.8/ldap_funserver.mli0000644000175000017500000000662410444405447016364 0ustar gildorgildor(* Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** A functional ldap server construction kit *) open Ldap_types (** raised whenever an error occurrs in the server *) exception Server_error of string type connection_id = int (** This structure is the guts of the ldap server. For each operation that you implement put the function (or closure) of the correct type in this structure. Any functions you set as None will return `UNWILLING_TO_PERFORM, with the error string set to "not implemented". bi_init will be called (if it is provided) before the server is brought up, and bi_close (if it is provided) will be called before the server is brought down. This interface is based loosely on the back-end api in OpenLDAP.*) type backendInfo = { bi_op_bind : (connection_id -> ldap_message -> ldap_message) option; bi_op_unbind : (connection_id -> ldap_message -> unit) option; bi_op_search : (connection_id -> ldap_message -> (unit -> ldap_message)) option; bi_op_compare : (connection_id -> ldap_message -> ldap_message) option; bi_op_modify : (connection_id -> ldap_message -> ldap_message) option; bi_op_modrdn : (connection_id -> ldap_message -> ldap_message) option; bi_op_add : (connection_id -> ldap_message -> ldap_message) option; bi_op_delete : (connection_id -> ldap_message -> ldap_message) option; bi_op_abandon : (connection_id -> ldap_message -> unit) option; bi_op_extended : (connection_id -> ldap_message -> ldap_message) option; bi_init : (unit -> unit) option; bi_close : (unit -> unit) option; } type log_level = [ `GENERAL | `CONNECTION | `OPERATIONS | `ERROR | `TRACE ] (** This abstract type contains the server context. It has the listening, socket, all the connected client sockets, and some internal data structures. *) type server_info (** Initialize the server, create the listening socket and return the server context, which you will pass to serv to process connections. log is a string -> log_level -> unit function to which log messages will be sent. *) val init : ?log:(log_level -> string -> unit) -> ?port:int -> backendInfo -> server_info (** Shutdown the server *) val shutdown : server_info -> unit (** Using the supplied server context, begin processing ldap operations. This function should never terminate unless there is an exceptional condition, in which case the exception will be raised. In many cases it is safe to restart the server process when an exception happens. *) val run : server_info -> unit ocamldap-2.1.8/ldap_mutex.ml0000644000175000017500000000555710444405447015342 0ustar gildorgildoropen Ldap_ooclient open Ldap_types (* ldap mutexes *) exception Ldap_mutex of string * exn class type mutex_t = object method lock: unit method unlock: unit end class type object_lock_table_t = object method lock: dn -> unit method unlock: dn -> unit end let addmutex ldap mutexdn = let mt = new ldapentry in let mtrdn = List.hd (Ldap_dn.of_string mutexdn) in mt#set_dn mutexdn; mt#add [("objectclass", ["top";"mutex"]); (mtrdn.attr_type, mtrdn.attr_vals)]; try ldap#add mt with exn -> raise (Ldap_mutex ("addmutex", exn)) let rec lock (ldap:ldapcon) mutexdn lockval = try let obj = try ldap#search ~base:mutexdn ~scope:`BASE "objectclass=*" with LDAP_Failure (`NO_SUCH_OBJECT, _, _) -> [] in if List.length obj = 0 then begin addmutex ldap mutexdn; lock ldap mutexdn lockval end else if List.length obj = 1 then while true do try ldap#modify (List.hd obj)#dn lockval; failwith "locked" with (* the mutex is locked already *) LDAP_Failure (`TYPE_OR_VALUE_EXISTS, _, _) | LDAP_Failure (`OBJECT_CLASS_VIOLATION, _, _) -> (* this is so evil *) ignore (Unix.select [] [] [] 0.25) (* wait 1/4 of a second *) done else failwith "huge error, multiple objects with the same dn" with Failure "locked" -> () | (Ldap_mutex _) as exn -> raise exn | exn -> raise (Ldap_mutex ("lock", exn)) let rec unlock (ldap:ldapcon) mutexdn unlockval = try let obj = try ldap#search ~base:mutexdn ~scope:`BASE "objectclass=*" with LDAP_Failure (`NO_SUCH_OBJECT, _, _) -> [] in if List.length obj = 0 then begin addmutex ldap mutexdn; unlock ldap mutexdn unlockval end else if List.length obj = 1 then try ldap#modify (List.hd obj)#dn unlockval with LDAP_Failure (`NO_SUCH_ATTRIBUTE, _, _) -> () with (Ldap_mutex _) as exn -> raise exn | exn -> raise (Ldap_mutex ("unlock", exn)) class mutex ldapurls binddn bindpw mutexdn = object (self) val ldap = let ldap = new ldapcon ldapurls in ldap#bind binddn ~cred:bindpw; ldap method private addmutex = addmutex ldap mutexdn method lock = lock ldap mutexdn [(`ADD, "mutexlocked", ["locked"])] method unlock = unlock ldap mutexdn [(`DELETE, "mutexlocked", [])] end let apply_with_mutex mutex f = mutex#lock; try let result = f () in mutex#unlock; result with exn -> (try mutex#unlock with _ -> ());raise exn class object_lock_table ldapurls binddn bindpw mutextbldn = object (self) val ldap = let ldap = new ldapcon ldapurls in ldap#bind binddn ~cred:bindpw; ldap method private addmutex = addmutex ldap mutextbldn method lock dn = lock ldap mutextbldn [(`ADD, "lockedObject", [Ldap_dn.to_string dn])] method unlock dn = unlock ldap mutextbldn [(`DELETE, "lockedObject", [Ldap_dn.to_string dn])] end ocamldap-2.1.8/ldap_mutex.mli0000644000175000017500000000351710444405447015505 0ustar gildorgildoropen Ldap_ooclient (** functions for implementing mutexes on top of LDAP's built in test and set mechanism. In order to use this module you must load mutex.schema, which is an rfc2252 format schema file. raised when a mutex operation fails. The string argument contains the name of the method which failed, and the exception contains details about what failed. *) exception Ldap_mutex of string * exn (** the class type of a single mutex, used for performing advisory locking of some action *) class type mutex_t = object method lock: unit method unlock: unit end (** the class type of an object lock table which allows for advisory locking of objects by dn *) class type object_lock_table_t = object method lock: Ldap_types.dn -> unit method unlock: Ldap_types.dn -> unit end (** new mutex ldapurls binddn bindpw mutexdn *) class mutex: string list -> string -> string -> string -> object (** lock the mutex. This WILL block if the mutex is already locked *) method lock: unit (** unlock the mutex *) method unlock: unit end (** used to apply some function, first locking the mutex, unlocking it only after the function has been applied. If the function generates any exception, this wrapper catches that exception, and unlocks the mutex before reraising the exception. Generally garentees that the mutex will always be used consistantly when performing an action. *) val apply_with_mutex: mutex -> (unit -> 'a) -> 'a (** new object_lock_table ldapurls binddn bindpw mutexdn *) class object_lock_table: string list -> string -> string -> string -> object (** lock the specified dn, if it is already locked, then block until the lock can be aquired *) method lock: Ldap_types.dn -> unit (** unlock the specified dn, if it is not locked do nothing *) method unlock: Ldap_types.dn -> unit end ocamldap-2.1.8/ldap_ooclient.ml0000644000175000017500000012511410444405447016004 0ustar gildorgildor (* An object oriented interface to ldap Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_funclient open Ldap_schemaparser open String (* types used throughout the library *) (* add types *) type op = string * string list type op_lst = op list type referral_policy = [ `RETURN | `FOLLOW ] (* change type for ldap entry *) type changetype = [ `ADD | `DELETE | `MODIFY | `MODDN | `MODRDN ] class type ldapentry_t = object method add : op_lst -> unit method delete : op_lst -> unit method replace : op_lst -> unit method modify : (modify_optype * string * string list) list -> unit method attributes : string list method exists : string -> bool method get_value : string -> string list method diff : ldapentry_t -> (modify_optype * string * string list) list method changes : (modify_optype * string * string list) list method changetype : changetype method set_changetype : changetype -> unit method flush_changes : unit method dn : string method set_dn : string -> unit method print : unit end;; class type ldapcon_t = object method add : ldapentry_t -> unit method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit method delete : string -> unit method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit method modrdn : string -> ?deleteoldrdn:bool -> string -> unit method rawschema : ldapentry_t method schema : Ldap_schemaparser.schema method search : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> string -> ldapentry_t list method search_a : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> string -> (?abandon:bool -> unit -> ldapentry_t) method unbind : unit method update_entry : ldapentry_t -> unit end let format_entry e = Format.open_box 0; Format.open_box 2; Format.print_string (" let length = List.length (e#get_value a) in let i = ref 0 in Format.print_string (Printf.sprintf "(\"%s\", " (String.escaped a)); Format.open_box 0; Format.print_string "["; List.iter (fun v -> if !i < length - 1 then (Format.print_string (Printf.sprintf "\"%s\";" (String.escaped v)); Format.print_break 1 0) else Format.print_string (Printf.sprintf "\"%s\"" (String.escaped v)); i := !i + 1) (e#get_value a); Format.print_string "]"; Format.close_box (); (if !j < length_attrs - 1 then (Format.print_string ");"; Format.force_newline ()) else Format.print_string ")"); j := !j + 1) (e#attributes); Format.close_box (); Format.print_string ">"; Format.close_box () let format_entries lst = let length = List.length lst in let i = ref 0 in Format.open_box 0; Format.print_string "["; if length > 3 then try List.iter (fun e -> if !i > 49 then failwith "limit" else if !i < length - 1 then begin Format.print_string ("; "); Format.print_cut (); i := !i + 1 end else Format.print_string ("")) lst with Failure "limit" -> Format.print_string "..." else List.iter (fun e -> if !i < length - 1 then begin format_entry e; Format.print_break 1 0; i := !i + 1 end else format_entry e) lst; Format.print_string "]"; Format.close_box () module CaseInsensitiveString = (struct type t = string * string let of_string s = (s, String.lowercase s) let to_string x = fst x let compare x y = String.compare (snd x) (snd y) end : sig type t val of_string: string -> t val to_string: t -> string val compare: t -> t -> int end);; module OrdOid = struct type t = Oid.t let compare = Oid.compare end;; module OrdStr = struct type t = CaseInsensitiveString.t let compare = CaseInsensitiveString.compare end;; (* types for a set of Oids, and a set of strings *) module Strset = Set.Make (OrdStr) module Setstr = Set.Make (OrdOid) (********************************************************************************) (********************************************************************************) (********************************************************************************) (* ldap entry object *) class ldapentry = object (self) val mutable dn = "" val mutable data = Hashtbl.create 50 val mutable changes = [] val mutable changetype = `ADD method private push_change (t:modify_optype) lst = match changetype with `MODIFY -> (match lst with [] -> () | (attr, values) :: tail -> changes <- (t, attr, values) :: changes; self#push_change t tail) | _ -> () method changetype = changetype; method set_changetype (typ:changetype) = changetype <- typ method flush_changes = changes <- [] method changes = changes method exists x = Hashtbl.mem data (lowercase x) method add (x:op_lst) = let rec do_add (x:op_lst) = match x with [] -> () | (name, value) :: lst -> let lcname = lowercase name in try Ulist.addlst (Hashtbl.find data lcname) value; do_add lst with Not_found -> let current = Ulist.create 5 in Hashtbl.add data lcname current; Ulist.addlst current value; do_add lst in do_add x; self#push_change `ADD x method diff (entry: ldapentry_t) = let diff_entries e1 e2 : (modify_optype * string * string list) list = let rec setOfList ?(set=Strset.empty) list = match list with a :: tail -> setOfList ~set:(Strset.add a set) tail | [] -> set in let ciStringlst list = List.rev_map CaseInsensitiveString.of_string list in let e1attrs = setOfList (ciStringlst e1#attributes) in let e2attrs = setOfList (ciStringlst e2#attributes) in let add_attrs = Strset.fold (fun attr mods -> let attr = CaseInsensitiveString.to_string attr in (`REPLACE, attr, e1#get_value attr) :: mods) (Strset.diff e1attrs (Strset.inter e1attrs e2attrs)) [] in let remove_attrs = Strset.fold (fun attr mods -> let attr = CaseInsensitiveString.to_string attr in (`DELETE, attr, []) :: mods) (Strset.diff e2attrs (Strset.inter e2attrs e1attrs)) [] in let sync_attrs = Strset.fold (fun attr mods -> let attr = CaseInsensitiveString.to_string attr in let e1vals = setOfList (ciStringlst (e1#get_value attr)) in let e2vals = setOfList (ciStringlst (e2#get_value attr)) in if (not (Strset.is_empty (Strset.diff e1vals (Strset.inter e1vals e2vals)))) || (not (Strset.is_empty (Strset.diff e2vals (Strset.inter e1vals e2vals)))) then (`REPLACE, attr, e1#get_value attr) :: mods else mods) (Strset.inter e1attrs (Strset.inter e1attrs e2attrs)) [] in List.rev_append remove_attrs (List.rev_append sync_attrs add_attrs) in (diff_entries self entry) method delete (x:op_lst) = let rec do_delete x = match x with [] -> () | (attr, values) :: lst -> let lcname = lowercase attr in match values with [] -> Hashtbl.remove data lcname;do_delete lst | _ -> (try List.iter (Ulist.remove (Hashtbl.find data lcname)) values with Not_found -> ()); (match Ulist.tolst (Hashtbl.find data lcname) with [] -> Hashtbl.remove data lcname | _ -> ()); do_delete lst in do_delete x; self#push_change `DELETE x method replace (x:op_lst) = let rec do_replace x = match x with [] -> () | (attr, values) :: lst -> let n = Ulist.create 5 in Ulist.addlst n values; Hashtbl.replace data (lowercase attr) n; do_replace lst; in do_replace x; self#push_change `REPLACE x method modify (x: (modify_optype * string * string list) list) = let rec do_modify x = match x with [] -> () | (`ADD, attr, values) :: t -> self#add [(attr, values)];do_modify t | (`DELETE, attr, values) :: t -> self#delete [(attr, values)];do_modify t | (`REPLACE, attr, values) :: t -> self#replace [(attr, values)];do_modify t in do_modify x method attributes = let keys hash = let cur = ref [] in let key k _ = cur := k :: !cur in Hashtbl.iter key hash; !cur in keys data method get_value attr = Ulist.tolst (Hashtbl.find data (lowercase attr)) method set_dn x = dn <- x method dn = dn method print = print_endline "THIS METHOD IS DEPRECATED, use Ldif_oo, or rely on the toplevel printers"; print_endline ("dn: " ^ self#dn); (List.iter (fun a -> (List.iter (fun b -> print_endline (a ^ ": " ^ b)) (self#get_value a))) self#attributes) end type changerec = [`Modification of string * ((Ldap_types.modify_optype * string * string list) list) | `Addition of ldapentry | `Delete of string | `Modrdn of string * int * string] (********************************************************************************) (********************************************************************************) (********************************************************************************) let to_entry ent = let rec add_attrs attrs entry = match attrs with {attr_type = name; attr_vals = values} :: tail -> entry#add [(name, values)]; add_attrs tail entry | [] -> entry#set_changetype `MODIFY; entry in match ent with `Entry {sr_dn = dn; sr_attributes = attrs} -> let entry = new ldapentry in entry#set_dn dn; add_attrs attrs entry | `Referral refs -> let entry = new ldapentry in entry#set_dn "referral"; entry#add [("ref", refs)]; entry#add [("objectclass", ["referral"])]; entry let of_entry ldapentry = let rec extract_attrs ?(converted=[]) entry attrs = match attrs with [] -> converted | attr :: tail -> extract_attrs ~converted:({attr_type=attr; attr_vals=(entry#get_value attr)} :: converted) entry tail in {sr_dn=(ldapentry#dn); sr_attributes=(extract_attrs ldapentry ldapentry#attributes)} let iter (f: ldapentry -> unit) (res: ?abandon:bool -> unit -> ldapentry) = try while true do f (res ()); done with LDAP_Failure (`SUCCESS, _, _) -> () | exn -> (try ignore (res ~abandon:true ()) with _ -> ());raise exn let rev_map (f: ldapentry -> 'a) (res: ?abandon:bool -> unit -> ldapentry) = let lst = ref [] in (try while true do lst := (f (res ())) :: !lst done with LDAP_Failure (`SUCCESS, _, _) -> () | exn -> (try ignore (res ~abandon:true ()) with _ -> ());raise exn); !lst let map (f: ldapentry -> 'a) (res: ?abandon:bool -> unit -> ldapentry) = List.rev (rev_map f res) let fold (f:ldapentry -> 'a -> 'a) (v:'a) (res: ?abandon:bool -> unit -> ldapentry) = let value = ref v in try while true do value := (f (res ()) !value) done; !value with LDAP_Failure (`SUCCESS, _, _) -> !value | exn -> (try ignore (res ~abandon:true ()) with _ -> ());raise exn (* a connection to an ldap server *) class ldapcon ?(connect_timeout=1) ?(referral_policy=`RETURN) ?(version = 3) hosts = object (self) val mutable bdn = "" val mutable pwd = "" val mutable mth = `SIMPLE val mutable bound = true val mutable reconnect_successful = true val mutable con = init ~connect_timeout:connect_timeout ~version:version hosts method private reconnect = if bound then unbind con; bound <- false; reconnect_successful <- false; con <- init ~connect_timeout:connect_timeout ~version:version hosts; bound <- true; bind_s ~who: bdn ~cred: pwd ~auth_method: mth con; reconnect_successful <- true; method unbind = if bound then (unbind con;bound <- false) method update_entry (e:ldapentry) = if not (reconnect_successful && bound) then self#reconnect; try self#modify e#dn (List.rev e#changes); e#flush_changes with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#update_entry e method bind ?(cred = "") ?(meth:authmethod = `SIMPLE) dn = if not bound then begin con <- init ~connect_timeout:connect_timeout ~version: version hosts; bound <- true end; bind_s ~who: dn ~cred: cred ~auth_method: meth con; reconnect_successful <- true; bdn <- dn; pwd <- cred; mth <- meth method add (entry: ldapentry) = if not (reconnect_successful && bound) then self#reconnect; try add_s con (of_entry entry) with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#add entry method delete dn = if not (reconnect_successful && bound) then self#reconnect; try delete_s con dn with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#delete dn method modify dn mods = if not (reconnect_successful && bound) then self#reconnect; try modify_s con dn mods with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#modify dn mods method modrdn dn ?(deleteoldrdn = true) ?(newsup: string option=None) newrdn = if not (reconnect_successful && bound) then self#reconnect; try modrdn_s con ~dn ~newdn:newrdn ~deleteoldrdn ~newsup with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#modrdn dn ~deleteoldrdn:deleteoldrdn newrdn method search ?(scope = `SUBTREE) ?(attrs = []) ?(attrsonly = false) ?(base = "") ?(sizelimit = 0l) ?(timelimit = 0l) filter = if not (reconnect_successful && bound) then self#reconnect; try List.rev_map to_entry (search_s ~scope ~base ~attrs ~attrsonly ~sizelimit ~timelimit con filter) with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect; self#search ~scope ~attrs ~attrsonly ~base ~sizelimit ~timelimit filter method search_a ?(scope = `SUBTREE) ?(attrs = []) ?(attrsonly = false) ?(base = "") ?(sizelimit = 0l) ?(timelimit = 0l) filter = (* a function which is returned by search_a, calling it will give the next entry due from the async search. The first_entry argument is there to maintain the semantics of ldapcon's transparent reconnection system. When search_a is called, we fetch the first entry, and pass it in to this function. We do this because, we will not know if the server actually recieved our search until we read the first entry. *) let fetch_result con (msgid:msgid) first_entry ?(abandon=false) () = if abandon then (Ldap_funclient.abandon con msgid; self#reconnect; to_entry (`Entry {sr_dn="";sr_attributes=[]})) else match !first_entry with (* are we on the first entry of the search? *) `No -> to_entry (get_search_entry con msgid) | `Yes e -> first_entry := `No; to_entry e | `NoResults -> (* this search has no results *) raise (LDAP_Failure (`SUCCESS, "success", {ext_matched_dn = ""; ext_referral = None})) in if not (reconnect_successful && bound) then self#reconnect; try let first_entry = ref `No in let msgid = search ~scope ~base ~attrs ~attrsonly ~sizelimit ~timelimit con filter in (* make sure the server is really still there *) (try first_entry := `Yes (get_search_entry con msgid) with LDAP_Failure (`SUCCESS, _, _) -> (* the search is already complete and has no results *) first_entry := `NoResults); fetch_result con msgid first_entry with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect; self#search_a ~scope ~attrs ~attrsonly ~base ~sizelimit ~timelimit filter method schema = if not (reconnect_successful && bound) then self#reconnect; try if version = 3 then let schema_base = (match (self#search ~base: "" ~scope: `BASE ~attrs: ["subschemasubentry"] "(objectclass=*)") with [e] -> List.hd (e#get_value "subschemasubentry") | _ -> raise Not_found) in (match (self#search ~base: schema_base ~scope: `BASE ~attrs: ["objectClasses";"attributeTypes"; "matchingRules";"ldapSyntaxes"] "(objectclass=subschema)") with [e] -> readSchema (e#get_value "objectclasses") (e#get_value "attributetypes") | _ -> raise Not_found) else raise Not_found with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#schema method rawschema = if not (reconnect_successful && bound) then self#reconnect; try if version = 3 then let schema_base = (match (self#search ~base: "" ~scope: `BASE ~attrs: ["subschemasubentry"] "(objectclass=*)") with [e] -> List.hd (e#get_value "subschemasubentry") | _ -> raise Not_found) in (match (self#search ~base: schema_base ~scope: `BASE ~attrs: ["objectClasses";"attributeTypes"; "matchingRules";"ldapSyntaxes"] "(objectclass=*)") with [e] -> e | _ -> raise Not_found) else raise Not_found with LDAP_Failure(`SERVER_DOWN, _, _) -> self#reconnect;self#rawschema end;; (********************************************************************************) (********************************************************************************) (********************************************************************************) (* A schema checking entry: An entry which validates its validity against the server's schema *) (* schema checking flavor *) type scflavor = Optimistic (* attempt to find objectclasses which make illegal attributes legal, delete them if no objectclass can be found *) | Pessimistic (* delete any illegal attributes, do not add objectclasses to make them legal*) (* for the schema checker, should never be seen by the user *) exception Invalid_objectclass of string exception Invalid_attribute of string exception Single_value of string exception Objectclass_is_required let attrToOid schema (attr:Lcstring.t) = try (Hashtbl.find schema.attributes attr).at_oid (* try canonical name first *) with Not_found -> (match (Hashtbl.fold (fun k v matches -> if (List.exists (fun n -> attr = (Lcstring.of_string n)) v.at_name) then v.at_oid :: matches else matches) schema.attributes []) with [] -> raise (Invalid_attribute (Lcstring.to_string attr)) | [oid] -> oid | _ -> raise (Invalid_attribute ("this attribute mapps to multiple oids: " ^ (Lcstring.to_string attr))));; let oidToAttr schema (attr:Oid.t) = List.hd (Hashtbl.find schema.attributes_byoid attr).at_name;; let ocToOid schema (oc:Lcstring.t) = try (Hashtbl.find schema.objectclasses oc).oc_oid with Not_found -> raise (Invalid_objectclass (Lcstring.to_string oc));; let oidToOc schema (oc:Oid.t) = List.hd (Hashtbl.find schema.objectclasses_byoid oc).oc_name let getOc schema (oc:Lcstring.t) = try Hashtbl.find schema.objectclasses oc with Not_found -> raise (Invalid_objectclass (Lcstring.to_string oc));; let getAttr schema (attr:Lcstring.t) = try Hashtbl.find schema.attributes attr with Not_found -> raise (Invalid_attribute (Lcstring.to_string attr));; let equateAttrs schema a1 a2 = (attrToOid schema a1) = (attrToOid schema a2) let rec setOfList ?(set=Setstr.empty) list = match list with a :: tail -> setOfList ~set:(Setstr.add a set) tail | [] -> set class scldapentry schema = object (self) inherit ldapentry as super val schemaAttrs = Hashtbl.create 50 val schema = schema val mutable consistent = false (* the set of all attibutes actually present *) val mutable present = Setstr.empty (* the set of all musts from all objectclasses on the entry *) val mutable must = Setstr.empty (* the set of all mays from all objectclasses on the entry *) val mutable may = Setstr.empty (* the set of required objectclasses *) val mutable requiredOcs = Setstr.empty (* present objectclasses *) val mutable presentOcs = Setstr.empty (* must + may *) val mutable all_allowed = Setstr.empty (* must - (present * must) *) val mutable missingAttrs = Setstr.empty (* requiredOcs - (presentOcs * requiredOcs) *) val mutable missingOcs = Setstr.empty (* any objectclass which depends on a missing objectclass *) val mutable illegalOcs = Setstr.empty (* present - (present * all_allowed) *) val mutable illegalAttrs = Setstr.empty (* schema checking is best expressed as set manipulations. I can ascert this having implimented it in other ways *) method private update_condition = let generate_present attrs schema = setOfList (List.rev_map (attrToOid schema) attrs) in let rec generate_mustmay ocs schema set must = match ocs with oc :: tail -> let musts = setOfList (List.rev_map (fun attr -> attrToOid schema attr) (if must then (getOc schema oc).oc_must else (getOc schema oc).oc_may)) in generate_mustmay tail schema (Setstr.union musts set) must | [] -> set in let rec lstRequired schema (oc: Lcstring.t) = oc :: (List.flatten (List.rev_map (fun sup -> lstRequired schema sup) (getOc schema oc).oc_sup)) in let rec generate_requiredocs schema ocs = setOfList (List.rev_map (ocToOid schema) (List.flatten (List.rev_map (lstRequired schema) ocs))) in let generate_illegal_oc missing schema ocs = let is_illegal_oc missing schema oc = let supchain = lstRequired schema oc in List.exists (fun mis -> List.exists ((=) mis) supchain) missing in List.filter (is_illegal_oc missing schema) ocs in present <- (generate_present (List.rev_map (Lcstring.of_string) super#attributes) schema); must <- (generate_mustmay (List.rev_map (Lcstring.of_string) (try super#get_value "objectclass" with Not_found -> raise Objectclass_is_required)) schema Setstr.empty true); may <- (generate_mustmay (List.rev_map (Lcstring.of_string) (try super#get_value "objectclass" with Not_found -> raise Objectclass_is_required)) schema Setstr.empty false); all_allowed <- Setstr.union must may; missingAttrs <- Setstr.diff must (Setstr.inter must present); illegalAttrs <- Setstr.diff present (Setstr.inter all_allowed present); requiredOcs <- (generate_requiredocs schema (List.rev_map (Lcstring.of_string) (try super#get_value "objectclass" with Not_found -> raise Objectclass_is_required))); presentOcs <- (setOfList (List.rev_map (fun attr -> ocToOid schema (Lcstring.of_string attr)) (try super#get_value "objectclass" with Not_found -> raise Objectclass_is_required))); missingOcs <- Setstr.diff requiredOcs (Setstr.inter requiredOcs presentOcs); illegalOcs <- (setOfList (List.rev_map (ocToOid schema) (generate_illegal_oc (List.rev_map (fun x -> Lcstring.of_string (oidToOc schema x)) (Setstr.elements missingOcs)) schema (List.rev_map (Lcstring.of_string) (try super#get_value "objectclass" with Not_found -> raise Objectclass_is_required))))); if Setstr.is_empty (Setstr.union missingAttrs illegalAttrs) then consistent <- true else consistent <- false method private drive_updatecon = try self#update_condition with Invalid_objectclass(s) -> super#delete [("objectclass",[s])];self#drive_updatecon | Invalid_attribute(s) -> super#delete [(s,[])];self#drive_updatecon | Objectclass_is_required -> super#add [("objectclass", ["top"])] method private reconsile_illegal flavor = let find_in_oc oc attr = (List.exists ((=) (Lcstring.of_string attr)) oc.oc_must) || (List.exists ((=) (Lcstring.of_string attr)) oc.oc_may) in let find_oc schema attr = let oc = ref (Lcstring.of_string "") in Hashtbl.iter (fun key valu -> if (find_in_oc valu attr) then oc := key) schema.objectclasses; if !oc = (Lcstring.of_string "") then raise Not_found; !oc in match flavor with Optimistic -> if not (Setstr.is_empty illegalAttrs) then ((List.iter (* add necessary objectclasses *) (fun oc -> super#add [("objectclass",[(Lcstring.to_string oc)])]) (List.rev_map (fun attr -> try find_oc schema attr with Not_found -> raise (Invalid_attribute attr)) (List.rev_map (oidToAttr schema) (Setstr.elements illegalAttrs)))); self#drive_updatecon); (* add any objectclasses the ones we just added are dependant on *) if not (Setstr.is_empty missingOcs) then ((List.iter (fun oc -> super#add [("objectclass", [oc])]) (List.rev_map (oidToOc schema) (Setstr.elements missingOcs))); self#drive_updatecon); | Pessimistic -> (List.iter (fun oc -> super#delete [("objectclass",[oc])]) (List.rev_map (oidToOc schema) (Setstr.elements illegalOcs))); self#drive_updatecon; (List.iter (* remove disallowed attributes *) (fun attr -> super#delete [(attr, [])]) (List.rev_map (oidToAttr schema) (Setstr.elements illegalAttrs))); self#drive_updatecon method private drive_reconsile flavor = try self#reconsile_illegal flavor with Invalid_attribute(a) -> (* remove attributes for which there is no objectclass *) (super#delete [(a, [])]; self#drive_updatecon; self#drive_reconsile flavor) (* for debugging *) method private getCondition = let printLst lst = List.iter print_endline lst in print_endline "MAY"; printLst (List.rev_map (oidToAttr schema) (Setstr.elements may)); print_endline "PRESENT"; printLst (List.rev_map (oidToAttr schema) (Setstr.elements present)); (* printLst (Setstr.elements present);*) print_endline "MUST"; printLst (List.rev_map (oidToAttr schema) (Setstr.elements must)); (* printLst (Setstr.elements must);*) print_endline "MISSING"; printLst (List.rev_map (oidToAttr schema) (Setstr.elements missingAttrs)); (* printLst (Setstr.elements missingAttrs);*) print_endline "ILLEGAL"; printLst (List.rev_map (oidToAttr schema) (Setstr.elements illegalAttrs)); print_endline "REQUIREDOCS"; (* printLst (List.rev_map (oidToOc schema) (Setstr.elements requiredOcs));*) printLst (List.rev_map Oid.to_string (Setstr.elements requiredOcs)); print_endline "PRESENTOCS"; (* printLst (List.rev_map (oidToOc schema) (Setstr.elements presentOcs));*) printLst (List.rev_map Oid.to_string (Setstr.elements presentOcs)); print_endline "MISSINGOCS"; (* printLst (List.rev_map (oidToOc schema) (Setstr.elements missingOcs));*) printLst (List.rev_map Oid.to_string (Setstr.elements missingOcs)); print_endline "ILLEGALOCS"; (* printLst (List.rev_map (oidToOc schema) (Setstr.elements illegalOcs))*) printLst (List.rev_map Oid.to_string (Setstr.elements illegalOcs)); (* for debugging *) method private getData = (must, may, present, missingOcs) method of_entry ?(scflavor=Pessimistic) (e:ldapentry) = super#set_dn (e#dn); super#set_changetype `ADD; (List.iter (fun attr -> try (super#add (try self#single_val_check [(attr, (e#get_value attr))] true; [(attr, (e#get_value attr))] with (* remove single valued attributes *) Single_value _ -> [(attr, [List.hd (e#get_value attr)])])) with (* single_val_check may encounter unknown attributes *) Invalid_attribute _ | Invalid_objectclass _ -> ()) e#attributes); self#drive_updatecon; self#drive_reconsile scflavor (* raise an exception if the user attempts to have more than one value in a single valued attribute. *) method private single_val_check (x:op_lst) consider_present = let check op = let attr = getAttr schema (Lcstring.of_string (fst op)) in (if attr.at_single_value then (match op with (attr, v1 :: v2 :: tail) -> false | (attr, v1 :: tail) -> (if consider_present && (super#exists attr) then false else true) | _ -> true) else true) in match x with op :: tail -> (if not (check op) then raise (Single_value (fst op)) else self#single_val_check tail consider_present) | [] -> () method add x = self#single_val_check x true;super#add x; self#drive_updatecon;self#drive_reconsile Optimistic method delete x = super#delete x;self#drive_updatecon;self#drive_reconsile Pessimistic method replace x = self#single_val_check x false;super#replace x; self#drive_updatecon;self#drive_reconsile Optimistic method modify x = let filter_mod x op = List.rev_map (fun (_, a, v) -> (a, v)) (List.filter (function (the_op, _, _) when the_op = op -> true | _ -> false) x) in self#single_val_check (filter_mod x `ADD) true; self#single_val_check (filter_mod x `REPLACE) false; super#modify x; self#drive_updatecon; self#drive_reconsile Pessimistic method get_value x = try super#get_value x with Not_found -> if (Setstr.mem (attrToOid schema (Lcstring.of_string x)) missingAttrs) then ["required"] else raise Not_found method attributes = List.rev_append super#attributes (List.rev_map (fun a -> oidToAttr schema a) (Setstr.elements missingAttrs)) method list_missing = Setstr.elements missingAttrs method list_allowed = Setstr.elements all_allowed method list_present = Setstr.elements present method is_missing x = Setstr.mem (attrToOid schema (Lcstring.of_string x)) missingAttrs method is_allowed x = Setstr.mem (attrToOid schema (Lcstring.of_string x)) all_allowed end;; (********************************************************************************) (********************************************************************************) (********************************************************************************) (* a high level interface for accounts, and services in the directory *) type generator = {gen_name:string; required:string list; genfun:(ldapentry_t -> string list)};; type service = {svc_name: string; static_attrs: (string * (string list)) list; generate_attrs: string list; depends: string list};; type generation_error = Missing_required of string list | Generator_error of string exception No_generator of string;; exception Generation_failed of generation_error;; exception No_service of string;; exception Service_dep_unsatisfiable of string;; exception Generator_dep_unsatisfiable of string * string;; exception Cannot_sort_dependancies of (string list);; let diff_values convert_to_oid convert_from_oid attr attrvals svcvals = (attr, (List.rev_map convert_from_oid (Setstr.elements (Setstr.diff svcvals (Setstr.inter svcvals attrvals))))) (* compute the intersection of values between an attribute and a service, you need to pass this function as an argument to apply_set_op_to_values *) let intersect_values convert_to_oid convert_from_oid attr attrvals svcvals = (attr, (List.rev_map convert_from_oid (Setstr.elements (Setstr.inter svcvals attrvals)))) (* this function allows you to apply a set operation to the values of an attribute, and the static values on a service *) let apply_set_op_to_values schema (attr:string) e svcval opfun = let lc = String.lowercase in let convert_to_oid = (match lc ((getAttr schema (Lcstring.of_string attr)).at_equality) with "objectidentifiermatch" -> (fun oc -> ocToOid schema (Lcstring.of_string oc)) | "caseexactia5match" -> Oid.of_string | _ -> (fun av -> Oid.of_string (lc av))) in let convert_from_oid = (match lc ((getAttr schema (Lcstring.of_string attr)).at_equality) with "objectidentifiermatch" -> (fun av -> oidToOc schema av) | "caseexactia5match" -> Oid.to_string | _ -> Oid.to_string) in let attrvals = setOfList (List.rev_map convert_to_oid (try e#get_value attr with Not_found -> [])) in let svcvals = setOfList (List.rev_map convert_to_oid (snd svcval)) in opfun convert_to_oid convert_from_oid attr attrvals svcvals class ldapaccount schema (generators:(string, generator) Hashtbl.t) (services:(string, service) Hashtbl.t) = object (self) inherit scldapentry schema as super val mutable toGenerate = Setstr.empty val mutable neededByGenerators = Setstr.empty val services = services val generators = generators (* evaluates the set of missing attributes to see if any of them can be generated, if so, it adds them to be generated *) method private resolve_missing = (* computes the set of generateable attributes *) let generate_togenerate generators missing togenerate = (* generators have dependancies. Some of the dependancies can also be generated. We can generate a dependancy if the following conditions are met. 1. The dependancy is in the generators hash (it has a generation function) 2. The dependancy is allowed by the schema (it is either a must or may of an objectclass currently on the object) 3. The dependancy is not already present (if it is present already then it has already been satisfied, and there is no need to generate it) *) let find_generatable_dep generators generator = (List.rev_map (fun e -> attrToOid schema (Lcstring.of_string e)) (List.filter (fun g -> if ((Hashtbl.mem generators g) && (not (Setstr.mem (attrToOid schema (Lcstring.of_string g)) (setOfList self#list_present)))) then true else false) (List.filter (* we can only add it if it is allowed by the schema *) (fun attr -> super#is_allowed attr) (Hashtbl.find generators generator).required))) in (* collect a flat list of all generatable dependancies *) let rec find_generatable_deps generators genlst = (List.flatten (List.rev_map (find_generatable_dep generators) genlst)) in (* the set we are currently generating, union the set of missing attributes which we can generate. *) let generateing = (List.filter (fun gen -> if (Hashtbl.mem generators (lowercase (oidToAttr schema gen))) then true else false) (List.rev_append missing (Setstr.elements togenerate))) in (* the total set of generatable at any point in time is. The set we are already generating, unioned with any generatable dependancies, unioned with the set of missing attributes (required by the schema) which can be generated. Note, the last union is done in the generateing expression above. *) setOfList (List.rev_append generateing (find_generatable_deps generators (List.rev_map (fun e -> lowercase (oidToAttr schema e)) generateing))) in let generate_missing togen generators = setOfList (Hashtbl.fold (fun key valu requiredlst -> if Setstr.mem (attrToOid schema (Lcstring.of_string valu.gen_name)) togen then List.rev_append requiredlst (List.rev_map (fun x -> try attrToOid schema (Lcstring.of_string x) with Invalid_attribute a -> raise (Generator_dep_unsatisfiable (key, a))) valu.required) else requiredlst) generators []) in toGenerate <- generate_togenerate generators super#list_missing toGenerate; neededByGenerators <- generate_missing toGenerate generators; method list_missing = let allmissing = Setstr.union neededByGenerators (setOfList super#list_missing) in Setstr.elements (Setstr.diff allmissing (Setstr.inter allmissing (Setstr.union toGenerate (setOfList super#list_present)))) method attributes = (List.rev_map (oidToAttr schema) (Setstr.elements (Setstr.union toGenerate (setOfList (List.rev_map (fun a -> attrToOid schema (Lcstring.of_string a)) super#attributes))))) method is_missing x = (not (Setstr.mem (attrToOid schema (Lcstring.of_string x)) toGenerate)) || (super#is_missing x) method generate = let sort_genlst generators unsatisfied = let satisfied alreadysatisfied present deps = List.for_all (fun dep -> (List.mem dep alreadysatisfied) || (List.mem (attrToOid schema (Lcstring.of_string dep)) (present))) deps in let rec sort present ordtogen unsatisfied = match unsatisfied with [] -> ordtogen | todo -> let (aresat, notyet) = (List.partition (fun attr -> (satisfied ordtogen present (Hashtbl.find generators attr).required)) todo) in match aresat with [] -> raise (Cannot_sort_dependancies notyet) | _ -> sort present (ordtogen @ aresat) notyet in sort (self#list_present) [] unsatisfied in match self#list_missing with [] -> (List.iter (fun attr -> self#add [(attr, (Hashtbl.find generators attr).genfun (self:>ldapentry_t))]) (sort_genlst generators (List.rev_map (fun elt -> String.lowercase (oidToAttr schema elt)) (Setstr.elements toGenerate)))); toGenerate <- Setstr.empty | a -> raise (Generation_failed (Missing_required (List.rev_map (oidToAttr schema) a))) method get_value x = if (Setstr.mem (attrToOid schema (Lcstring.of_string x)) toGenerate) then ["generate"] else super#get_value x (* adapt the passed in service to the current state of the entry this may result in a service with applies no changes. The entry may already have the service. *) method adapt_service svc = {svc_name=svc.svc_name; static_attrs=(List.filter (fun cons -> match cons with (attr, []) -> false | _ -> true) (List.rev_map (fun cons -> apply_set_op_to_values schema (fst cons) self cons diff_values) svc.static_attrs)); generate_attrs=(List.filter (fun attr -> (try (ignore (super#get_value attr));false with Not_found -> true)) svc.generate_attrs); depends=svc.depends} (* add a service to the account, if they already satisfy the service then do nothing *) method add_service svc = let service = try Hashtbl.find services (lowercase svc) with Not_found -> raise (No_service svc) in (try List.iter (self#add_service) service.depends with (No_service x) -> raise (Service_dep_unsatisfiable x)); let adaptedsvc = self#adapt_service service in (let do_adds a = let singlevalu = (List.filter (fun attr -> (getAttr schema (Lcstring.of_string (fst attr))).at_single_value) a) in let multivalued = (List.filter (fun attr -> not (getAttr schema (Lcstring.of_string (fst attr))).at_single_value) a) in self#add multivalued; self#replace singlevalu in do_adds adaptedsvc.static_attrs); (match adaptedsvc.generate_attrs with [] -> () | a -> List.iter (self#add_generate) a) method delete_service svc = let find_deps services service = (Hashtbl.fold (fun serv svcstruct deplst -> if (List.exists ((=) service) svcstruct.depends) then serv :: deplst else deplst) services []) in let service = try Hashtbl.find services (lowercase svc) with Not_found -> raise (No_service svc) in (List.iter (self#delete_service) (find_deps services svc)); (List.iter (fun e -> match e with (attr, []) -> () | a -> (try (ignore (super#get_value (fst a)));super#delete [a] with Not_found -> ())) (List.rev_map (fun cons -> apply_set_op_to_values schema (fst cons) self cons intersect_values) service.static_attrs)); (List.iter (fun attr -> (try (match self#get_value attr with ["generate"] -> self#delete_generate attr | _ -> super#delete [(attr, [])]) with Not_found -> ())) service.generate_attrs) method service_exists service = let service = (try (Hashtbl.find services service) with Not_found -> raise (No_service service)) in match self#adapt_service service with {svc_name=s; static_attrs=[]; generate_attrs=[]; depends=d} -> (match d with [] -> true | d -> List.for_all self#service_exists d) | _ -> false method services_present = Hashtbl.fold (fun k v l -> if self#service_exists v.svc_name then v.svc_name :: l else l) services [] method of_entry ?(scflavor=Pessimistic) e = super#of_entry ~scflavor e;self#resolve_missing method add_generate x = (if (Hashtbl.mem generators (lowercase x)) then toGenerate <- Setstr.add (attrToOid schema (Lcstring.of_string x)) toGenerate else raise (No_generator x)); self#resolve_missing method delete_generate x = let find_dep attr generators = (Hashtbl.fold (fun key valu deplst -> if (List.exists ((=) attr) valu.required) then key :: deplst else deplst) generators []) in (List.iter (self#delete_generate) (find_dep x generators)); toGenerate <- Setstr.remove (attrToOid schema (Lcstring.of_string x)) toGenerate method add x = (* add x, remove all attributes in x from the list of generated attributes *) super#add x; (List.iter (fun a -> toGenerate <- (Setstr.remove (attrToOid schema (Lcstring.of_string (fst a))) toGenerate)) x); self#resolve_missing method delete x = super#delete x;self#resolve_missing method replace x = (* replace x, removeing it from the list of generated attrs *) super#replace x; (List.iter (fun a -> toGenerate <- (Setstr.remove (attrToOid schema (Lcstring.of_string (fst a))) toGenerate)) x); self#resolve_missing end;; ocamldap-2.1.8/ldap_ooclient.mli0000644000175000017500000006511010444405447016154 0ustar gildorgildor(* an object oriented interface to ldap Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** an object oriented ldap client interface *) open Ldap_types (** {2 Basic Data Types} *) (** the type of an operation, eg. [("cn", ["foo";"bar"])] *) type op = string * string list type op_lst = op list (** The policy the client should take when it encounteres a referral. This is currently not used *) type referral_policy = [ `FOLLOW | `RETURN ] (** The change type of an ldapentry. This controls some aspects of it's behavior *) type changetype = [ `ADD | `DELETE | `MODDN | `MODIFY | `MODRDN ] (** {2 Local Representation of LDAP Objects} *) (** The base type of an ldap entry represented in memory. *) class type ldapentry_t = object method add : op_lst -> unit method attributes : string list method changes : (Ldap_types.modify_optype * string * string list) list method changetype : changetype method delete : op_lst -> unit method dn : string method diff : ldapentry_t -> (modify_optype * string * string list) list method exists : string -> bool method flush_changes : unit method get_value : string -> string list method modify : (Ldap_types.modify_optype * string * string list) list -> unit method print : unit method replace : op_lst -> unit method set_changetype : changetype -> unit method set_dn : string -> unit end (** this object represents a remote object within local memory. It records all local changes made to it (if it's changetype is set to `MODIFY), and can commit them to the server at a later time via {!Ldap_ooclient.ldapcon.update_entry}. *) class ldapentry : object (** add values to an attribute (or create a new attribute). Does not change the server until you update *) method add : op_lst -> unit (** return a list of the type (name) of all the attributes present on the object *) method attributes : string list (** return a list of changes made to the object in a the format of a modify operation. For example, you can apply the changes to another ldapentry object using the {!Ldap_ooclient.ldapentry.modify} method *) method changes : (Ldap_types.modify_optype * string * string list) list (** return the changetype of the object *) method changetype : changetype (** delete attributes from the object, does not change the directory until you update *) method delete : op_lst -> unit (** return the dn of the object *) method dn : string (** given an ldapentry, return the differences between the current entry and the specified entry in the form of a modify operation which would make the specified entry the same as the current entry. *) method diff : ldapentry_t -> (modify_optype * string * string list) list (** query whether the attribute type (name) exists in the object *) method exists : string -> bool (** clear all accumulated changes *) method flush_changes : unit (** get the value of an attribute @raise Not_found If the attribute does not exist. *) method get_value : string -> string list (** Apply modifications to object in memory, does not change the database until you update using {!Ldap_ooclient.ldapcon.update_entry} *) method modify : (Ldap_types.modify_optype * string * string list) list -> unit (** @deprecated print an ldif like representation of the object to stdout, see Ldif_oo for standards compliant ldif. Usefull for toplevel sessions. *) method print : unit (** replace values in the object, does not change the database until you call update *) method replace : op_lst -> unit (** set the changetype of the object *) method set_changetype : changetype -> unit (** set the dn of the object *) method set_dn : string -> unit end (** {1 Miscallaneous} *) (** toplevel formatter for ldapentry, prints the whole entry with a nice structure. Each attribute is in the correct syntax to be copied and pasted into a modify operation. *) val format_entry : < attributes : string list; dn : string; get_value : string -> string list; .. > -> unit (** format lists of entries, in this case only print the dn *) val format_entries : < attributes : string list; dn : string; get_value : string -> string list; .. > list -> unit (** The type of an ldap change record, used by extended LDIF *) type changerec = [`Modification of string * ((Ldap_types.modify_optype * string * string list) list) | `Addition of ldapentry | `Delete of string | `Modrdn of string * int * string] (** {0 Communication With {!Ldap_funclient}} *) (** given a search_result_entry as returned by ldap_funclient, produce an ldapentry containing either the entry, or the referral object *) val to_entry : [< `Entry of Ldap_types.search_result_entry | `Referral of string list ] -> ldapentry (** given an ldapentry as returned by ldapcon, or constructed manually, produce a search_result_entry suitable for ldap_funclient, or ldap_funserver. *) val of_entry : ldapentry -> search_result_entry (** {2 Interacting with LDAP Servers} *) (** This class abstracts a connection to an LDAP server (or servers), an instance will be connected to the server you specify and can be used to perform operations on that server. {0 Example} [new ldapcon ~connect_timeout:5 ~version:3 ["ldap://first.ldap.server";"ldap://second.ldap.server"]]. In addition to specifying multiple urls, if DNS names are given, and those names are bound to multiple addresses, then all possible addresses will be tried. {0 Example} [new ldapcon ["ldaps://rrldap.csun.edu"]] is equivelant to [new ldapcon ["ldap://130.166.1.30";"ldap://130.166.1.31";"ldap://130.166.1.32"]] This means that if any host in the rr fails, the ldapcon will transparently move on to the next host, and you will never know the difference. @raise LDAP_Failure All methods raise {!Ldap_types.LDAP_Failure} on error @param connect_timeout Default [1], an integer which specifies how long to wait for any given server in the list to respond before trying the next one. After all the servers have been tried for [connect_timeout] seconds [LDAP_Failure (`SERVER_DOWN, ...)] will be raised. @param referral_policy In a future version of ocamldap this will be used to specify what you would like to do in the event of a referral. Currently it does nothing and is ignored see {!Ldap_ooclient.referral_policy}. @param version The protocol version to use, the default is [3], the other recognized value is [2]. *) class ldapcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> object (** {2 Authentication} *) (** bind to the database using dn. {0 Simple Bind Example} [ldap#bind ~cred:"password" "cn=foo,ou=people,ou=auth,o=bar"] To bind anonymously, omit ~cred, and leave dn blank eg. {0 Example} [ldap#bind ""] @param cred The credentials to provide for binding. Default [""]. @param meth The method to use when binding See {!Ldap_funclient.authmethod} the default is [`SIMPLE]. If [`SASL] is used then [dn] and [~cred] Are interperted according to the chosen SASL mechanism. SASL binds have not been tested extensively. *) method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit (** Deauthenticate and close the connection to the server *) method unbind : unit (** {2 Searching} *) (** Search the directory syncronously for an entry which matches the search criteria. {0 Example} [ldap#search ~base:"dc=foo,dc=bar" ~attrs:["cn"] "uid=*"] @param scope Default [`SUBTREE], defines the scope of the search. see {!Ldap_types.search_scope} @param attrs Default [[]] (means all attributes) @param attrsonly Default [false] If true, asks the server to return only the attribute names, not their values. @param base Default [""], The search base, which is the dn of the object from which you want to start your search. Only that object, and it's children will be included in the search. Further controlled by [~scope]. @param timelimit The time limit (in seconds) to allow the search to run for. Default [0l], which means there is no user specified time limit, the server may still impose one. @param sizelimit The max number of entries to return from the search (in number of entries) *) method search : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> ?sizelimit:Int32.t -> ?timelimit:Int32.t -> string -> ldapentry list (** Search the directory asyncronously, otherwise the same as search. *) method search_a : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> ?sizelimit:Int32.t -> ?timelimit:Int32.t -> string -> (?abandon:bool -> unit -> ldapentry) (** Fetch the raw (unparsed) schema from the directory using the standard mechanism (requires protocol version 3) *) method rawschema : ldapentry (** Fetch and parse the schema from the directory via the standard mechanism (requires version 3). Return a structured representation of the schema indexed by canonical name, and oid. *) method schema : Ldap_schemaparser.schema (** {2 Making Modifications} *) (** add an entry to the database *) method add : ldapentry -> unit (** Delete the object named by dn from the database *) method delete : string -> unit (** Modify the entry named by dn, applying mods {0 Example} [ldap#modify "uid=foo,ou=people,dc=bar,dc=baz" [(`DELETE, "cn", ["foo";"bar"])]] *) method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit (** Syncronize changes made locally to an ldapentry with the directory. *) method update_entry : ldapentry -> unit (** Modify the rdn of the object named by dn, if the protocol version is 3 you may additionally change the superior, the rdn will be changed to the attribute represented (as a string) by newrdn, {0 Example With New Superior} [ldap#modrdn ~newsup:(Some "o=csun") "cn=bob,ou=people,o=org" "uid=bperson"] After this example "cn=bob,ou=people,o=org" will end up as "uid=bperson,o=csun". @param deleteoldrdn Default [true], delete the old rdn value as part of the modrdn. @param newsup Default [None], only valid when the protocol version is 3, change the object's location in the tree, making its superior equal to the specified object. *) method modrdn : string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit end (** {1 Iterators Over Streams of ldapentry Objects} *) (** given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a, apply f (first arg) to each entry See List.iter *) val iter : (ldapentry -> unit) -> (?abandon:bool -> unit -> ldapentry) -> unit (** given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a apply f (first arg) to each entry in reverse, and return a list containing the result of each application. See List.map *) val rev_map : (ldapentry -> 'a) -> (?abandon:bool -> unit -> ldapentry) -> 'a list (** same as rev_map, but does it in order *) val map : (ldapentry -> 'a) -> (?abandon:bool -> unit -> ldapentry) -> 'a list (** given a source of ldapentry objects (unit -> ldapentry), such as the return value of ldapcon#search_a compute (f eN ... (f e2 (f e1 intial))) see List.fold_right. *) val fold : (ldapentry -> 'a -> 'a) -> 'a -> (?abandon:bool -> unit -> ldapentry) -> 'a (** {2 Schema Aware ldapentry Derivatives} *) (** {1 General Schema Aware Entry} {!Ldap_ooclient.scldapentry}, A schema aware derivative of {!Ldap_ooclient.ldapentry}. It contains an rfc2252 schema checker, and given the database schema, it can be used to garentee that operations performed in memory are valid against a standards compliant database. It has numerious uses, translation between two databases with different schemas an example of where it finds natural usage. For an example application @see tdir *) (** an ordered oid type, for placing oids in sets *) module OrdOid : sig type t = Ldap_schemaparser.Oid.t val compare : t -> t -> int end (** A set of Oids @deprecated the name is historical, and may be changed *) module Setstr : sig type elt = OrdOid.t type t = Set.Make(OrdOid).t val empty : t val is_empty : t -> bool val mem : elt -> t -> bool val add : elt -> t -> t val singleton : elt -> t val remove : elt -> t -> t val union : t -> t -> t val inter : t -> t -> t val diff : t -> t -> t val compare : t -> t -> int val equal : t -> t -> bool val subset : t -> t -> bool val iter : (elt -> unit) -> t -> unit val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a val for_all : (elt -> bool) -> t -> bool val exists : (elt -> bool) -> t -> bool val filter : (elt -> bool) -> t -> t val partition : (elt -> bool) -> t -> t * t val cardinal : t -> int val elements : t -> elt list val min_elt : t -> elt val max_elt : t -> elt val choose : t -> elt val split : elt -> t -> t * bool * t end (** The type of schema checking to perform in {!Ldap_ooclient.scldapentry}. Normally this is picked automatically, however it can be overridden in some cases. *) type scflavor = Optimistic (** Add missing attributes to make the object consistant, or add objectclasses in order to make illegal attribues legal *) | Pessimistic (** Delete objectclasses which must attributes which are missing, and delete illegal attributes. *) (** given a name of an attribute name (canonical or otherwise), return its oid @raise Invalid_attribute If the attribute is not found in the schema. *) val attrToOid : Ldap_schemaparser.schema -> Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t (** given the oid of an attribute, return its canonical name @raise Invalid_attribute If the attribute is not found in the schema. *) val oidToAttr : Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string (** given a name of an objectclass (canonical or otherwise), return its oid. @raise Invalid_objectclass If the objectclass is not found in the schema. *) val ocToOid : Ldap_schemaparser.schema -> Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Oid.t (** given the oid of an objectclass, return its canonical name @raise Invalid_objectclass If the objectclass is not found in the schema. *) val oidToOc : Ldap_schemaparser.schema -> Ldap_schemaparser.Oid.t -> string (** get an objectclass structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster) @raise Invalid_objectclass If the objectclass is not found in the schema. *) val getOc : Ldap_schemaparser.schema -> Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.objectclass (** get an attr structure by one of its names (canonical or otherwise, however getting it by canonical name is currently much faster) @raise Invalid_attribute If the attribute is not found in the schema. *) val getAttr : Ldap_schemaparser.schema -> Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.attribute (** equate attributes by oid. This allows non canonical names to be handled correctly, for example "uid" and "userID" are actually the same attribute. @raise Invalid_attribute If either attribute is not found in the schema. *) val equateAttrs : Ldap_schemaparser.schema -> Ldap_schemaparser.Lcstring.t -> Ldap_schemaparser.Lcstring.t -> bool exception Invalid_objectclass of string exception Invalid_attribute of string exception Single_value of string exception Objectclass_is_required class scldapentry : Ldap_schemaparser.schema -> object (** {2 New Methods} *) (** Returns true if the attributed specified is allowed by the current set of objectclasses present on the entry. *) method is_allowed : string -> bool (** Returns true if the attribute specified is a must, but is not currently present. *) method is_missing : string -> bool (** Return a list of all attributes allowed on the entry (by oid) *) method list_allowed : Setstr.elt list (** Return a list of all missing attributes (by oid) *) method list_missing : Setstr.elt list (** Return a list of all present attributes. In contrast to the [attributes] method, this method ignores missing required attributes and just returns those attributes which are actually present. *) method list_present : Setstr.elt list (** Given an {!Ldap_ooclient.ldapentry} copy all of it's data into the current object, and perform a schema check. @param scflavor Default [Pessimistic] The schema checking bias, see {!Ldap_ooclient.scflavor} *) method of_entry : ?scflavor:scflavor -> ldapentry -> unit (** {2 Inherited Methods} *) (** Add values to the entry, just as {!Ldap_ooclient.ldapentry.add}, However, after the add is complete the schema checker is run in [Optimistic] mode. see {!Ldap_ooclient.scflavor} *) method add : op_lst -> unit (** Same as {!Ldap_ooclient.ldapentry.add}, except that the schema checker is run in [Pessimistic] mode after the operation is complete. see {!Ldap_ooclient.scflavor} *) method delete : op_lst -> unit (** Same as {!Ldap_ooclient.ldapentry.replace} except that once the replace has completed the schema checker is run again in [Optimistic] mode. See {!Ldap_ooclient.scflavor} *) method replace : op_lst -> unit (** Same as {!Ldap_ooclient.ldapentry.attributes}, except that the returned list contains attributes which may not yet exist on the entry. For example musts which are not yet present will be listed. *) method attributes : string list (** Same as {!Ldap_ooclient.ldapentry.exists} except that it refrences attributes which may not yet exist. For example musts which are not yet present. *) method exists : string -> bool (** Same as {!Ldap_ooclient.ldapentry.get_value}, except that attributes which do not yet exists may be referenced. For example a must which has not yet been satisfied will return [["required"]] when [get_value] is called on it. *) method get_value : string -> string list (** Same as {!Ldap_ooclient.ldapentry.modify} except that the schema checker is run in [Pessimistic] mode after the modification is applied. see {!Ldap_ooclient.scflavor}. *) method modify : (Ldap_types.modify_optype * string * string list) list -> unit (** Same as {!Ldap_ooclient.ldapentry.changes} except that changes made by the schema checker may also be listed. *) method changes : (Ldap_types.modify_optype * string * string list) list (** Same as {!Ldap_ooclient.ldapentry.changetype} *) method changetype : changetype (** Same as {!Ldap_ooclient.ldapentry.dn} *) method dn : string (** Same as {!Ldap_ooclient.ldapentry.flush_changes} *) method flush_changes : unit (** Same as {!Ldap_ooclient.ldapentry.diff} *) method diff : ldapentry_t -> (Ldap_types.modify_optype * string * string list) list (** @deprecated Same as {!Ldap_ooclient.ldapentry.print}, except that it prints attributes which may not yet be present on the object. For example, if the object has unsatisfied musts, it will print "attrname: required" for that attribute. *) method print : unit (** Same as {!Ldap_ooclient.ldapentry.set_changetype} *) method set_changetype : changetype -> unit (** Same as {!Ldap_ooclient.ldapentry.set_dn} *) method set_dn : string -> unit end (** {1 Schema Aware Entry for Account Managment} A derivative of {!Ldap_ooclient.scldapentry} which includes abstractions for managing user accounts in the directory. This class is experimantal, and may be drastically changed in the next version. As with all experimental code, use with caution. A few of its features. {ul {- Loosely dependant attributes: Many attributes are derived from others via a function. ldapaccount allows you to codify that relationship by providing an attribute generator ({!Ldap_ooclient.generator}) for the attribute, which will be used to derive it's value except in the case that it is specified explicitly} {- Attribute and Generator Grouping: via the service abstraction. Allows you to group attributes together with generators and default values in interesting ways. You can then assign the whole grouping a name, and refer to it by that name. See {!Ldap_ooclient.service}} {- Difference Based: Service operations are difference based, all applications of service operations compute the delta between the current object, and what the service requires. The minumum set of changes necessary to satisfy the service are applied to the object.} {- Idempotentcy: As a result of being difference based, Service operations are itempotent. For example, adding a service twice has no effect on the object. It will not queue changes for modification to the directory, and it will not change the object in memory. Deleting a service twice has no effect...etc}} *) (** The structure of a generator *) type generator = { (** The name of the generator, this should also be its key in the hashtbl *) gen_name : string; (** A list of names of attributes which are required by this generator. The names need not be canonical. *) required : string list; (** A function which returns a list of values for the attribute, given the entire object. *) genfun : ldapentry_t -> string list; } (** The structure of a service *) type service = { (** The name of the service, should also be its key in the hashtbl. *) svc_name : string; (** A list of attributes and values which must be present for the service to be satisfied. *) static_attrs : (string * string list) list; (** A list of attributes to generate. *) generate_attrs : string list; (** A list of services on which this service depends. *) depends : string list; } (** The type of error raised by attribute generators *) type generation_error = Missing_required of string list | Generator_error of string (** You've asked it to generate an attribute (in a service) which doesn't have a generator *) exception No_generator of string (** Generator has failed because of some kind of error *) exception Generation_failed of generation_error (** The service you're talking about doesn't exist *) exception No_service of string (** A service which the one you tried to add depends on doesn't exists *) exception Service_dep_unsatisfiable of string (** Your generator depends on an attribute which isn't in the schema *) exception Generator_dep_unsatisfiable of string * string (** You have detached cycles in your generator dependancy lists *) exception Cannot_sort_dependancies of string list class ldapaccount : Ldap_schemaparser.schema -> (string, generator) Hashtbl.t -> (string, service) Hashtbl.t -> object (** {2 Account Manipulation Methods} *) (** add the named service to the object, this also adds all the services depended upon by the named service. *) method add_service : string -> unit (** Delete the named service. This will also delete all services which depend on it, either directly or indirectly *) method delete_service : string -> unit (** Run service through the delta engine to find out what changes would actually be applied to this object *) method adapt_service : service -> service (** Tests whether the named service is satisfied by the current entry. A service is satisfied if no changes would result from adding it to the entry. *) method service_exists : string -> bool (** Return a list of all the named services which are satisfied by the current entry. *) method services_present : string list (** add the named attribute to the list of attributes to be generated *) method add_generate : string -> unit (** Delete the named attribute from the list of attributes to generate *) method delete_generate : string -> unit (** Run the generation functions on the list of attributes to be generated, saving the results in the entry. You must run this method in order to run any generators at all. *) method generate : unit (** {2 Inherited Methods} Unless explicitly stated, these methods do exactly the same thing as in {!Ldap_ooclient.scldapentry} *) (** Missing attributes may be marked for generation. *) method add : op_lst -> unit method attributes : string list method changes : (Ldap_types.modify_optype * string * string list) list method changetype : changetype method delete : op_lst -> unit method dn : string method diff : ldapentry_t -> (Ldap_types.modify_optype * string * string list) list method exists : string -> bool method flush_changes : unit (** If a missing attribute is marked for generation its value will be ["generate"] instead of ["required"] *) method get_value : string -> string list method is_allowed : string -> bool method is_missing : string -> bool method list_allowed : Setstr.elt list method list_missing : Setstr.elt list method list_present : Setstr.elt list method modify : (Ldap_types.modify_optype * string * string list) list -> unit method of_entry : ?scflavor:scflavor -> ldapentry -> unit (** @deprecated Missing required attributes which will be generated are shown as "attrname: generate" instead of "attrname: required" *) method print : unit method replace : op_lst -> unit method set_changetype : changetype -> unit method set_dn : string -> unit end ocamldap-2.1.8/ldap_protocol.ml0000644000175000017500000012005310444405447016026 0ustar gildorgildor(* An implementation of the ldap protocol, both client and server functions are implemented Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Lber open Ldap_types let encode_resultcode (code:ldap_resultcode) = match code with `SUCCESS -> 0 | `OPERATIONS_ERROR -> 1 | `PROTOCOL_ERROR -> 2 | `TIMELIMIT_EXCEEDED -> 3 | `SIZELIMIT_EXCEEDED -> 4 | `COMPARE_FALSE -> 5 | `COMPARE_TRUE -> 6 | `AUTH_METHOD_NOT_SUPPORTED -> 7 | `STRONG_AUTH_REQUIRED -> 8 | `REFERRAL -> 10 | `ADMINLIMIT_EXCEEDED -> 11 | `UNAVAILABLE_CRITICAL_EXTENSION -> 12 | `CONFIDENTIALITY_REQUIRED -> 13 | `SASL_BIND_IN_PROGRESS -> 14 | `NO_SUCH_ATTRIBUTE -> 16 | `UNDEFINED_TYPE -> 17 | `INAPPROPRIATE_MATCHING -> 18 | `CONSTRAINT_VIOLATION -> 19 | `TYPE_OR_VALUE_EXISTS -> 20 | `INVALID_SYNTAX -> 21 | `NO_SUCH_OBJECT -> 32 | `ALIAS_PROBLEM -> 33 | `INVALID_DN_SYNTAX -> 34 | `IS_LEAF -> 35 | `ALIAS_DEREF_PROBLEM -> 36 | `INAPPROPRIATE_AUTH -> 48 | `INVALID_CREDENTIALS -> 49 | `INSUFFICIENT_ACCESS -> 50 | `BUSY -> 51 | `UNAVAILABLE -> 52 | `UNWILLING_TO_PERFORM -> 53 | `LOOP_DETECT -> 54 | `NAMING_VIOLATION -> 64 | `OBJECT_CLASS_VIOLATION -> 65 | `NOT_ALLOWED_ON_NONLEAF -> 66 | `NOT_ALLOWED_ON_RDN -> 67 | `ALREADY_EXISTS -> 68 | `NO_OBJECT_CLASS_MODS -> 69 | `AFFECTS_MULTIPLE_DSAS -> 71 | `OTHER -> 80 | `SERVER_DOWN -> 80 | `LOCAL_ERROR -> 80 | `ENCODING_ERROR -> 80 | `DECODING_ERROR -> 80 | `TIMEOUT -> 80 | `AUTH_UNKNOWN -> 80 | `FILTER_ERROR -> 80 | `USER_CANCELLED -> 80 | `PARAM_ERROR -> 80 | `NO_MEMORY -> 80 | `CONNECT_ERROR -> 80 | `NOT_SUPPORTED -> 80 | `CONTROL_NOT_FOUND -> 80 | `NO_RESULTS_RETURNED -> 80 | `MORE_RESULTS_TO_RETURN -> 80 | `CLIENT_LOOP -> 80 | `REFERRAL_LIMIT_EXCEEDED -> 80 | `UNKNOWN_ERROR i -> i let decode_resultcode code = match code with 0 -> `SUCCESS | 1 -> `OPERATIONS_ERROR | 2 -> `PROTOCOL_ERROR | 3 -> `TIMELIMIT_EXCEEDED | 4 -> `SIZELIMIT_EXCEEDED | 5 -> `COMPARE_FALSE | 6 -> `COMPARE_TRUE | 7 -> `AUTH_METHOD_NOT_SUPPORTED | 8 -> `STRONG_AUTH_REQUIRED | 10 -> `REFERRAL | 11 -> `ADMINLIMIT_EXCEEDED | 12 -> `UNAVAILABLE_CRITICAL_EXTENSION | 13 -> `CONFIDENTIALITY_REQUIRED | 14 -> `SASL_BIND_IN_PROGRESS | 16 -> `NO_SUCH_ATTRIBUTE | 17 -> `UNDEFINED_TYPE | 18 -> `INAPPROPRIATE_MATCHING | 19 -> `CONSTRAINT_VIOLATION | 20 -> `TYPE_OR_VALUE_EXISTS | 21 -> `INVALID_SYNTAX | 32 -> `NO_SUCH_OBJECT | 33 -> `ALIAS_PROBLEM | 34 -> `INVALID_DN_SYNTAX | 35 -> `IS_LEAF | 36 -> `ALIAS_DEREF_PROBLEM | 48 -> `INAPPROPRIATE_AUTH | 49 -> `INVALID_CREDENTIALS | 50 -> `INSUFFICIENT_ACCESS | 51 -> `BUSY | 52 -> `UNAVAILABLE | 53 -> `UNWILLING_TO_PERFORM | 54 -> `LOOP_DETECT | 64 -> `NAMING_VIOLATION | 65 -> `OBJECT_CLASS_VIOLATION | 66 -> `NOT_ALLOWED_ON_NONLEAF | 67 -> `NOT_ALLOWED_ON_RDN | 68 -> `ALREADY_EXISTS | 69 -> `NO_OBJECT_CLASS_MODS | 71 -> `AFFECTS_MULTIPLE_DSAS | 80 -> `OTHER | i -> `UNKNOWN_ERROR i (* encode a standard sequence header *) let encode_seq_hdr ?(cls=Universal) ?(tag=16) length = encode_ber_header {ber_class=cls; ber_tag=tag; ber_primitive=false; ber_length=Definite length} let decode_ldapcontrol rb = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in let controlType = decode_ber_octetstring rb in let criticality = try decode_ber_bool rb with Readbyte_error End_of_stream -> false in let controlValue = try Some (decode_ber_octetstring rb) with Readbyte_error End_of_stream -> None in {controlType=controlType;criticality=criticality;controlValue=controlValue} | _ -> raise (LDAP_Decoder "decode_ldapcontrol: expected sequence") let decode_ldapcontrols rb = try let rb = (* set the context to this control *) match decode_ber_header rb with {ber_class=Context_specific;ber_tag=0;ber_length=control_length} -> readbyte_of_ber_element control_length rb | _ -> raise (LDAP_Decoder "decode_ldapcontrol: expected control (controls [0])") in let rec decode_ldapcontrols' ?(controls=[]) rb = try decode_ldapcontrols' ~controls:((decode_ldapcontrol rb) :: controls) rb with Readbyte_error End_of_stream -> match controls with [] -> None | controls -> Some (List.rev controls) (* return them in order *) in decode_ldapcontrols' rb with Readbyte_error End_of_stream -> None let encode_components_of_ldapresult {result_code=resultcode; matched_dn=dn;error_message=msg; ldap_referral=refs} = let result_code = encode_ber_enum (Int32.of_int (encode_resultcode resultcode)) in let matched_dn = encode_ber_octetstring dn in let error_message = encode_ber_octetstring msg in let ldap_referral = (match refs with Some refs -> let buf = Buffer.create 100 in List.iter (fun ref -> Buffer.add_string buf (encode_ber_octetstring ref)) refs; let hdr = Buffer.create 101 in Buffer.add_string hdr (encode_ber_header {ber_class=Context_specific; ber_tag=3; ber_primitive=false; ber_length=Definite (Buffer.length buf)}); Buffer.add_buffer hdr buf; Some (Buffer.contents hdr) | None -> None) in let buf = Buffer.create 100 in Buffer.add_string buf result_code; Buffer.add_string buf matched_dn; Buffer.add_string buf error_message; (match ldap_referral with Some s -> Buffer.add_string buf s | None -> ()); Buffer.contents buf let encode_ldapresult ?(cls=Universal) ?(tag=16) ldapresult = let components = encode_components_of_ldapresult ldapresult in let len = String.length components in let buf = Buffer.create (len + 20) in Buffer.add_string buf (encode_ber_header {ber_class=cls; ber_tag=tag; ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf components; Buffer.contents buf let decode_components_of_ldapresult rb = let resultCodeval = decode_ber_enum rb in let matched_dn = decode_ber_octetstring rb in let error_message = decode_ber_octetstring rb in let referrals = try (match decode_ber_header ~peek:true rb with {ber_class=Context_specific;ber_tag=3;ber_length=referral_length} -> ignore (decode_ber_header rb); let rb = readbyte_of_ber_element referral_length rb in (match decode_berval_list decode_ber_octetstring rb with [] -> None | lst -> Some lst) | _ -> None) with Readbyte_error End_of_stream -> None in {result_code=(decode_resultcode (Int32.to_int resultCodeval)); matched_dn=matched_dn; error_message=error_message; ldap_referral=referrals} let decode_ldapresult rb = let rb = (* set context to this result only *) (match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=result_length} -> readbyte_of_ber_element result_length rb | _ -> raise (LDAP_Decoder "decode_ldapresult: expected ldapresult (sequence)")) in decode_components_of_ldapresult rb let encode_bindrequest {bind_version=ver;bind_name=dn;bind_authentication=auth} = let buf = Buffer.create 100 in let version = encode_ber_int32 (Int32.of_int ver) in let dn = encode_ber_octetstring dn in let auth = (match auth with Simple pwd -> encode_ber_octetstring ~cls:Context_specific ~tag:0 pwd | Sasl {sasl_mechanism=mech;sasl_credentials=cred} -> let buf = Buffer.create 10 in let mech = encode_ber_octetstring mech in let cred = (match cred with Some cred -> Some (encode_ber_octetstring cred) | None -> None) in let hdr = encode_seq_hdr ~cls:Context_specific ~tag:3 ((String.length mech) + (match cred with Some cred -> String.length cred | None -> 0)) in Buffer.add_string buf hdr; Buffer.add_string buf mech; (match cred with Some cred -> Buffer.add_string buf cred | None -> ()); Buffer.contents buf) in let hdr = (encode_ber_header {ber_class=Application; ber_tag=0; ber_primitive=false; ber_length=Definite ((String.length version) + (String.length dn) + (String.length auth))}) in Buffer.add_string buf hdr; Buffer.add_string buf version; Buffer.add_string buf dn; Buffer.add_string buf auth; Buffer.contents buf let decode_bindrequest rb = let version = decode_ber_int32 rb in let dn = decode_ber_octetstring rb in let cred = (match decode_ber_header rb with {ber_class=Context_specific;ber_tag=0;ber_length=cred_length} -> (* simple *) Simple (decode_ber_octetstring ~contents:(Some (read_contents rb cred_length)) rb) | {ber_class=Context_specific;ber_tag=3;ber_length=cred_length} -> (* sasl *) let rb = readbyte_of_ber_element cred_length rb in let sasl_mech = decode_ber_octetstring rb in let sasl_cred = (try Some (decode_ber_octetstring rb) with Readbyte_error End_of_stream -> None) in Sasl {sasl_mechanism=sasl_mech;sasl_credentials=sasl_cred} | _ -> raise (LDAP_Decoder "decode_bindrequest: unknown authentication method")) in Bind_request {bind_version=Int32.to_int version; bind_name=dn; bind_authentication=cred} let encode_bindresponse {bind_result=result;bind_serverSaslCredentials=saslcred} = let encoded_result = encode_components_of_ldapresult result in let encoded_saslcred = (match saslcred with Some s -> Some (encode_ber_octetstring s) | None -> None) in let len = (String.length encoded_result) + (match encoded_saslcred with Some s -> (String.length s) | None -> 0) in let buf = Buffer.create (len + 20) in Buffer.add_string buf (encode_ber_header {ber_class=Application; ber_tag=1;ber_primitive=false; ber_length=Definite len}); Buffer.add_string buf encoded_result; (match encoded_saslcred with Some s -> Buffer.add_string buf s | None -> ()); Buffer.contents buf let decode_bindresponse rb = let result = decode_components_of_ldapresult rb in let saslcred = try Some (decode_ber_octetstring rb) with Readbyte_error End_of_stream -> None in Bind_response {bind_result=result; bind_serverSaslCredentials=saslcred} let decode_unbindrequest rb = (* some clients do not properly encode the length octets, which will cause decoding of null values to fail. In short, it is never OK to omit completely the length octets, however some clients (namely openldap) do it anyway *) (try ignore (decode_ber_null rb) with Readbyte_error End_of_stream -> ()); Unbind_request let encode_unbindrequest () = encode_ber_null () (* not really a sequence *) let decode_attributevalueassertion rb = let attributeDesc = decode_ber_octetstring rb in let assertionValue = decode_ber_octetstring rb in {attributeDesc=attributeDesc; assertionValue=assertionValue} let encode_substringfilter {attrtype=attr; substrings={substr_initial=initial; substr_any=any;substr_final=final}} = let encode_component ctype vals = match vals with [] -> "" | vals -> let tag = match ctype with `INITIAL -> 0 | `ANY -> 1 | `FINAL -> 2 in let buf = Buffer.create (List.fold_left (fun s v -> s + (String.length v) + 3) 0 vals) in List.iter (fun v -> Buffer.add_string buf (encode_ber_octetstring ~cls:Context_specific ~tag v)) vals; Buffer.contents buf in let e_attr = encode_ber_octetstring attr in let e_initial = encode_component `INITIAL initial in let e_any = encode_component `ANY any in let e_final = encode_component `FINAL final in let component_len = (String.length e_initial) + (String.length e_any) + (String.length e_final) in let component_buf = Buffer.create (component_len + 3) in Buffer.add_string component_buf (encode_ber_header {ber_class=Universal;ber_tag=16;ber_primitive=false; ber_length=(Definite component_len)}); Buffer.add_string component_buf e_initial; Buffer.add_string component_buf e_any; Buffer.add_string component_buf e_final; let len = ((Buffer.length component_buf) + (String.length e_attr)) in let buf = Buffer.create (len + 3) in Buffer.add_string buf (encode_ber_header {ber_class=Context_specific;ber_tag=4;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_attr; Buffer.add_buffer buf component_buf; Buffer.contents buf let decode_substringfilter rb = let rec decode_substring_components skel rb = try match decode_ber_header ~peek:true rb with {ber_class=Context_specific;ber_tag=0} -> decode_substring_components {skel with substr_initial=((decode_ber_octetstring ~cls:Context_specific ~tag:0 rb) :: skel.substr_initial)} rb | {ber_class=Context_specific;ber_tag=1} -> decode_substring_components {skel with substr_any=((decode_ber_octetstring ~cls:Context_specific ~tag:1 rb) :: skel.substr_any)} rb | {ber_class=Context_specific;ber_tag=2} -> decode_substring_components {skel with substr_final=((decode_ber_octetstring ~cls:Context_specific ~tag:2 rb) :: skel.substr_final)} rb | _ -> raise (LDAP_Decoder "decode_substringfilter: invalid substring component") with Readbyte_error End_of_stream -> skel in let attrtype = decode_ber_octetstring rb in let components = (match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in let skel = {substr_initial=[];substr_any=[];substr_final=[]} in let result = decode_substring_components skel rb in if result = skel then raise (LDAP_Decoder "decode_substringfilter: invalid substring filter") else result | _ -> raise (LDAP_Decoder "decode_substringfilter: expected sequence of choice")) in {attrtype=attrtype; substrings=components} let encode_matchingruleassertion {matchingRule=mrule;ruletype=mruletype; matchValue=valu;dnAttributes=dnattrs} = let olen s = match s with Some s -> String.length s | None -> 0 in let oadd buf encoded = (match encoded with Some e -> Buffer.add_string buf e | None -> ()) in let oencode tag valu = match valu with Some s -> Some (encode_ber_octetstring ~cls:Context_specific ~tag:tag s) | None -> None in let e_mrule = oencode 1 mrule in let e_mruletype = oencode 2 mruletype in let e_valu = encode_ber_octetstring ~cls:Context_specific ~tag:3 valu in let e_dnattrs = encode_ber_bool ~cls:Context_specific ~tag:4 dnattrs in let len = (olen e_mrule) + (olen e_mruletype) + (String.length e_valu) + (String.length e_dnattrs) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Context_specific;ber_tag=9; ber_primitive=false;ber_length=(Definite len)}); oadd buf e_mrule; oadd buf e_mruletype; Buffer.add_string buf e_valu; Buffer.add_string buf e_dnattrs; Buffer.contents buf let decode_matchingruleassertion rb = let matchingrule = (match decode_ber_header ~peek:true rb with {ber_class=Context_specific;ber_tag=0;ber_length=len} -> Some (decode_ber_octetstring ~cls:Context_specific ~tag:1 rb) | _ -> None) in let ruletype = (match decode_ber_header ~peek:true rb with {ber_class=Context_specific;ber_tag=1;ber_length=len} -> Some (decode_ber_octetstring ~cls:Context_specific ~tag:2 rb) | _ -> None) in let matchvalue = decode_ber_octetstring rb in let dnattributes = try decode_ber_bool rb with Readbyte_error End_of_stream -> false in {matchingRule=matchingrule; ruletype=ruletype; matchValue=matchvalue; dnAttributes=dnattributes} let rec encode_ldapfilter filter = let encode_complex lst hdr = let encoded_lst = encode_berval_list encode_ldapfilter lst in let len = String.length encoded_lst in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {hdr with ber_length=(Definite len)}); Buffer.add_string buf encoded_lst; Buffer.contents buf in let encode_simple attr valu hdr = let e_attr = encode_ber_octetstring attr in let e_valu = encode_ber_octetstring valu in let len = (String.length e_attr) + (String.length e_valu) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {hdr with ber_length=(Definite len)}); Buffer.add_string buf e_attr; Buffer.add_string buf e_valu; Buffer.contents buf in let hdr = {ber_class=Context_specific;ber_tag=0; ber_primitive=false;ber_length=Definite 0} in match filter with `And lst -> encode_complex lst hdr | `Or lst -> encode_complex lst {hdr with ber_tag=1} | `Not f -> encode_complex [f] {hdr with ber_tag=2} | `EqualityMatch {attributeDesc=attr;assertionValue=valu} -> encode_simple attr valu {hdr with ber_tag=3} | `Substrings substrs -> encode_substringfilter substrs | `GreaterOrEqual {attributeDesc=attr;assertionValue=valu} -> encode_simple attr valu {hdr with ber_tag=5} | `LessOrEqual {attributeDesc=attr;assertionValue=valu} -> encode_simple attr valu {hdr with ber_tag=6} | `Present attr -> encode_ber_octetstring ~cls:Context_specific ~tag:7 attr | `ApproxMatch {attributeDesc=attr;assertionValue=valu} -> encode_simple attr valu {hdr with ber_tag=8} | `ExtensibleMatch extn -> encode_matchingruleassertion extn let rec decode_ldapfilter rb = match decode_ber_header rb with {ber_class=Context_specific;ber_tag=0;ber_length=len} -> (* and *) let rb = readbyte_of_ber_element len rb in `And (decode_berval_list decode_ldapfilter rb) | {ber_class=Context_specific;ber_tag=1;ber_length=len} -> (* or *) let rb = readbyte_of_ber_element len rb in `Or (decode_berval_list decode_ldapfilter rb) | {ber_class=Context_specific;ber_tag=2;ber_length=len} -> (* not *) `Not (decode_ldapfilter rb) | {ber_class=Context_specific;ber_tag=3;ber_length=len} -> (* equality match *) `EqualityMatch (decode_attributevalueassertion rb) | {ber_class=Context_specific;ber_tag=4;ber_length=len} -> (* substring match *) `Substrings (decode_substringfilter rb) | {ber_class=Context_specific;ber_tag=5;ber_length=len} -> (* greater than or equal *) `GreaterOrEqual (decode_attributevalueassertion rb) | {ber_class=Context_specific;ber_tag=6;ber_length=len} -> (* less than or equal *) `LessOrEqual (decode_attributevalueassertion rb) | {ber_class=Context_specific;ber_tag=7;ber_length=len} -> (* present *) `Present (decode_ber_octetstring ~contents:(Some (read_contents rb len)) rb) | {ber_class=Context_specific;ber_tag=8;ber_length=len} -> (* approx *) `ApproxMatch (decode_attributevalueassertion rb) | {ber_class=Context_specific;ber_tag=9;ber_length=len} -> (* extensible match *) `ExtensibleMatch (decode_matchingruleassertion rb) | _ -> raise (LDAP_Decoder "decode_filter: expected filter part") let encode_attributedescriptionlist attrs = let e_attrs = encode_berval_list encode_ber_octetstring attrs in let len = String.length e_attrs in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=16; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_attrs; Buffer.contents buf let decode_attributedescriptionlist rb = match decode_ber_header rb with {ber_class=Universal;ber_tag=16} -> decode_berval_list decode_ber_octetstring rb | _ -> raise (LDAP_Decoder "decode_attributedescriptionlist: expected sequence") let encode_searchrequest {baseObject=base;scope=scope; derefAliases=deref;sizeLimit=sizelimit; timeLimit=timelimit;typesOnly=typesonly; filter=filter;s_attributes=attributes} = let e_base = encode_ber_octetstring base in let e_scope = encode_ber_enum (match scope with `BASE -> 0l | `ONELEVEL -> 1l | `SUBTREE -> 2l) in let e_deref = encode_ber_enum (match deref with `NEVERDEREFALIASES -> 0l | `DEREFINSEARCHING -> 1l | `DEREFFINDINGBASE -> 2l | `DEREFALWAYS -> 3l) in let e_sizelimit = encode_ber_int32 sizelimit in let e_timelimit = encode_ber_int32 timelimit in let e_typesonly = encode_ber_bool typesonly in let e_filter = encode_ldapfilter filter in let e_attributes = encode_attributedescriptionlist attributes in let len = (String.length e_base) + (String.length e_scope) + (String.length e_deref) + (String.length e_sizelimit) + (String.length e_timelimit) + (String.length e_typesonly) + (String.length e_filter) + (String.length e_attributes) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=3; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_base; Buffer.add_string buf e_scope; Buffer.add_string buf e_deref; Buffer.add_string buf e_sizelimit; Buffer.add_string buf e_timelimit; Buffer.add_string buf e_typesonly; Buffer.add_string buf e_filter; Buffer.add_string buf e_attributes; Buffer.contents buf let decode_searchrequest rb = let base = decode_ber_octetstring rb in let scope = (match decode_ber_enum rb with 0l -> `BASE | 1l -> `ONELEVEL | 2l -> `SUBTREE | _ -> raise (LDAP_Decoder "decode_searchrequest: invalid scope")) in let deref = (match decode_ber_enum rb with 0l -> `NEVERDEREFALIASES | 1l -> `DEREFINSEARCHING | 2l -> `DEREFFINDINGBASE | 3l -> `DEREFALWAYS | _ -> raise (LDAP_Decoder "decode_searchrequest: invalid deref policy")) in let sizelimit = decode_ber_int32 rb in let timelimit = decode_ber_int32 rb in let typesonly = decode_ber_bool rb in let filter = decode_ldapfilter rb in let attributes = decode_attributedescriptionlist rb in Search_request {baseObject=base; scope=scope; derefAliases=deref; sizeLimit=sizelimit; timeLimit=timelimit; typesOnly=typesonly; filter=filter; s_attributes=attributes} let encode_attribute {attr_type=attrtype;attr_vals=attrvals} = let e_attrtype = encode_ber_octetstring attrtype in let e_attrvals = let vals = encode_berval_list encode_ber_octetstring attrvals in let len = String.length vals in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=17; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf vals; Buffer.contents buf in let len = (String.length e_attrtype) + (String.length e_attrvals) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=16; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_attrtype; Buffer.add_string buf e_attrvals; Buffer.contents buf let decode_attribute rb = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in let attrtype = decode_ber_octetstring rb in let attrvals = match decode_ber_header rb with {ber_class=Universal;ber_tag=17} -> decode_berval_list decode_ber_octetstring rb | _ -> raise (LDAP_Decoder "decode_attribute: expected set") in {attr_type=attrtype;attr_vals=attrvals} | _ -> raise (LDAP_Decoder "decode_attributes: expected sequence") (* also used to encode addrequest. Forgive the naming conventions, trying to follow the ASN.1 closely, but not copy some of its problems at the same time. They have a few seperate implementations of entry, all the same encoding, but with different names, and different ASN.1 code! *) let encode_searchresultentry ?(tag=4) {sr_dn=dn;sr_attributes=attributes} = let e_dn = encode_ber_octetstring dn in let e_attributes = let valu = encode_berval_list encode_attribute attributes in let len = String.length valu in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=16; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf valu; Buffer.contents buf in let len = (String.length e_dn) + (String.length e_attributes) in let buf = Buffer.create 50 in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=tag; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_dn; Buffer.add_string buf e_attributes; Buffer.contents buf let decode_searchresultentry rb = let dn = decode_ber_octetstring rb in let attributes = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_berval_list decode_attribute rb | _ -> raise (LDAP_Decoder "decode_searchresultentry: expected squenece") in Search_result_entry {sr_dn=dn;sr_attributes=attributes} let encode_searchresultdone = encode_ldapresult ~cls:Application ~tag:5 let decode_searchresultdone rb = Search_result_done (decode_components_of_ldapresult rb) let encode_searchresultreference srf = let refs = encode_berval_list encode_ber_octetstring srf in let len = String.length refs in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=19; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf refs; Buffer.contents buf let decode_searchresultreference rb = Search_result_reference (decode_berval_list decode_ber_octetstring rb) let encode_modification {mod_op=op;mod_value=attr} = let e_op = encode_ber_enum (match op with `ADD -> 0l | `DELETE -> 1l | `REPLACE -> 2l) in let e_attr = encode_attribute attr in let len = (String.length e_op) + (String.length e_attr) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=16;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_op; Buffer.add_string buf e_attr; Buffer.contents buf let decode_modification rb = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> (* sequence is specified *) let rb = readbyte_of_ber_element len rb in let op = (match decode_ber_enum rb with 0l -> `ADD | 1l -> `DELETE | 2l -> `REPLACE | _ -> raise (LDAP_Decoder "decode_modification: unknown operation")) in let attr = decode_attribute rb in {mod_op=op;mod_value=attr} | {ber_class=cls;ber_tag=tag;ber_length=len} -> raise (LDAP_Decoder ("decode_modification: expected sequence, or enum, " ^ ("tag: " ^ (string_of_int tag)))) let encode_modifyrequest {mod_dn=dn;modification=mods} = let e_dn = encode_ber_octetstring dn in let e_mods = let vals = encode_berval_list encode_modification mods in let len = String.length vals in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Universal;ber_tag=16;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf vals; Buffer.contents buf in let len = (String.length e_dn) + (String.length e_mods) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=6; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_dn; Buffer.add_string buf e_mods; Buffer.contents buf let decode_modifyrequest rb = let dn = decode_ber_octetstring rb in let mods = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_berval_list decode_modification rb | _ -> raise (LDAP_Decoder "decode_modifyrequest: expected sequence") in Modify_request {mod_dn=dn;modification=mods} let encode_modifyresponse = encode_ldapresult ~cls:Application ~tag:7 let decode_modifyresponse rb = Modify_response (decode_components_of_ldapresult rb) (* the types from search are reused. I refuse to duplicate them each type countless times like the ASN.1 specification does *) let encode_addrequest = encode_searchresultentry ~tag:8 let decode_addrequest rb = let res = decode_searchresultentry rb in match res with Search_result_entry res -> Add_request res | _ -> raise (LDAP_Decoder "decode_addrequest: invalid addrequest") let encode_addresponse = encode_ldapresult ~cls:Application ~tag:9 let decode_addresponse rb = Add_response (decode_components_of_ldapresult rb) let encode_deleterequest req = encode_ber_octetstring ~cls:Application ~tag:10 req let decode_deleterequest len rb = Delete_request (decode_ber_octetstring ~contents:(Some (read_contents rb len)) rb) let encode_deleteresponse = encode_ldapresult ~cls:Application ~tag:11 let decode_deleteresponse rb = Delete_response (decode_components_of_ldapresult rb) let encode_modifydnrequest {modn_dn=dn;modn_newrdn=newrdn; modn_deleteoldrdn=deleteold; modn_newSuperior=newsup} = let e_dn = encode_ber_octetstring dn in let e_newrdn = encode_ber_octetstring newrdn in let e_deleteold = encode_ber_bool deleteold in let e_newsup = (match newsup with Some s -> Some (encode_ber_octetstring s) | None -> None) in let len = (String.length e_dn) + (String.length e_newrdn) + (String.length e_deleteold) + (match e_newsup with Some s -> String.length s | None -> 0) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=12;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_dn; Buffer.add_string buf e_newrdn; Buffer.add_string buf e_deleteold; (match e_newsup with Some s -> Buffer.add_string buf s | None -> ()); Buffer.contents buf let decode_modifydnrequest rb = let dn = decode_ber_octetstring rb in let newrdn = decode_ber_octetstring rb in let deleteoldrdn = decode_ber_bool rb in let newsup = (try Some (decode_ber_octetstring ~cls:Context_specific ~tag:0 rb) with Readbyte_error End_of_stream -> None) in Modify_dn_request {modn_dn=dn;modn_newrdn=newrdn; modn_deleteoldrdn=deleteoldrdn; modn_newSuperior=newsup} let encode_modifydnresponse = encode_ldapresult ~cls:Application ~tag:13 let decode_modifydnresponse rb = Modify_dn_response (decode_components_of_ldapresult rb) let encode_comparerequest {cmp_dn=dn; cmp_ava={attributeDesc=attr;assertionValue=valu}} = let e_dn = encode_ber_octetstring dn in let e_attr = encode_ber_octetstring attr in let e_valu = encode_ber_octetstring valu in let len = (String.length e_dn) + (String.length e_attr) + (String.length e_valu) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=14; ber_primitive=false;ber_length=(Definite len)}); Buffer.add_string buf e_dn; Buffer.add_string buf e_attr; Buffer.add_string buf e_valu; Buffer.contents buf let decode_comparerequest rb = let dn = decode_ber_octetstring rb in let attr = decode_ber_octetstring rb in let valu = decode_ber_octetstring rb in Compare_request {cmp_dn=dn;cmp_ava={attributeDesc=attr;assertionValue=valu}} let encode_compareresponse = encode_ldapresult ~cls:Application ~tag:15 let decode_compareresponse rb = Compare_response (decode_components_of_ldapresult rb) let encode_abandonrequest msgid = let e_msgid = encode_ber_int32 msgid in let len = String.length e_msgid in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=16;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_msgid; Buffer.contents buf let decode_abandonrequest rb = Abandon_request (decode_ber_int32 rb) let encode_extendedrequest {ext_requestName=reqname;ext_requestValue=reqval} = let e_reqname = encode_ber_octetstring reqname in let e_reqval = (match reqval with Some s -> Some (encode_ber_octetstring s) | None -> None) in let len = (String.length e_reqname) + (match e_reqval with Some s -> String.length s | None -> 0) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=23;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_reqname; (match e_reqval with Some s -> Buffer.add_string buf s | None -> ()); Buffer.contents buf let decode_extendedrequest rb = let reqname = decode_ber_octetstring ~cls:Context_specific ~tag:0 rb in let reqval = try Some (decode_ber_octetstring ~cls:Context_specific ~tag:1 rb) with Readbyte_error End_of_stream -> None in Extended_request {ext_requestName=reqname;ext_requestValue=reqval} let encode_extendedresponse {ext_result=result;ext_responseName=resname;ext_response=res} = let e_result = encode_components_of_ldapresult result in let e_resname = (match resname with Some s -> Some (encode_ber_octetstring s) | None -> None) in let e_res = (match res with Some s -> Some (encode_ber_octetstring s) | None -> None) in let len = (String.length e_result) + (match e_resname with Some s -> String.length s | None -> 0) + (match e_res with Some s -> String.length s | None -> 0) in let buf = Buffer.create (len + 10) in Buffer.add_string buf (encode_ber_header {ber_class=Application;ber_tag=24;ber_primitive=false; ber_length=(Definite len)}); Buffer.add_string buf e_result; (match e_resname with Some s -> Buffer.add_string buf s | None -> ()); (match e_res with Some s -> Buffer.add_string buf s | None -> ()); Buffer.contents buf let decode_extendedresponse rb = let result = decode_components_of_ldapresult rb in let responsename = ref None in let response = ref None in (try responsename := Some (decode_ber_octetstring ~cls:Context_specific ~tag:10 rb); response := Some (decode_ber_octetstring ~cls:Context_specific ~tag:11 rb) with Readbyte_error End_of_stream -> ()); Extended_response {ext_result=result; ext_responseName=(!responsename); ext_response=(!response)} let encode_ldapmessage {messageID=msgid;protocolOp=protocol_op;controls=controls} = let encoded_op = match protocol_op with Bind_request br -> encode_bindrequest br | Bind_response br -> encode_bindresponse br | Unbind_request -> encode_unbindrequest () | Search_request sr -> encode_searchrequest sr | Search_result_entry sre -> encode_searchresultentry sre | Search_result_done srd -> encode_searchresultdone srd | Search_result_reference a -> encode_searchresultreference a | Modify_request mreq -> encode_modifyrequest mreq | Modify_response res -> encode_modifyresponse res | Add_request sre -> encode_addrequest sre | Add_response res -> encode_addresponse res | Delete_request req -> encode_deleterequest req | Delete_response res -> encode_deleteresponse res | Modify_dn_request req -> encode_modifydnrequest req | Modify_dn_response res -> encode_modifydnresponse res | Compare_request req -> encode_comparerequest req | Compare_response res -> encode_compareresponse res | Abandon_request req -> encode_abandonrequest req | Extended_request req -> encode_extendedrequest req | Extended_response res -> encode_extendedresponse res in let buf = Buffer.create ((String.length encoded_op) + 20) in let msgid = encode_ber_int32 msgid in Buffer.add_string buf (encode_seq_hdr ((String.length encoded_op) + (String.length msgid))); Buffer.add_string buf msgid; Buffer.add_string buf encoded_op; Buffer.contents buf let decode_ldapmessage rb = match decode_ber_header rb with {ber_class=Universal;ber_tag=16;ber_length=total_length} -> (* set up our context to be this message *) let rb = readbyte_of_ber_element total_length rb in let messageid = decode_ber_int32 rb in let protocol_op = match decode_ber_header rb with {ber_class=Application;ber_tag=0;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_bindrequest rb | {ber_class=Application;ber_tag=1;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_bindresponse rb | {ber_class=Application;ber_tag=2;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_unbindrequest rb | {ber_class=Application;ber_tag=3;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_searchrequest rb | {ber_class=Application;ber_tag=4;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_searchresultentry rb | {ber_class=Application;ber_tag=5;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_searchresultdone rb | {ber_class=Application;ber_tag=19;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_searchresultreference rb | {ber_class=Application;ber_tag=6;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_modifyrequest rb | {ber_class=Application;ber_tag=7;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_modifyresponse rb | {ber_class=Application;ber_tag=8;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_addrequest rb | {ber_class=Application;ber_tag=9;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_addresponse rb | {ber_class=Application;ber_tag=10;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_deleterequest len rb | {ber_class=Application;ber_tag=11;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_deleteresponse rb | {ber_class=Application;ber_tag=12;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_modifydnrequest rb | {ber_class=Application;ber_tag=13;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_modifydnresponse rb | {ber_class=Application;ber_tag=14;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_comparerequest rb | {ber_class=Application;ber_tag=15;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_compareresponse rb | {ber_class=Application;ber_tag=16;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_abandonrequest rb | {ber_class=Application;ber_tag=23;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_extendedrequest rb | {ber_class=Application;ber_tag=24;ber_length=len} -> let rb = readbyte_of_ber_element len rb in decode_extendedresponse rb | _ -> raise (LDAP_Decoder "protocol error") in let controls = decode_ldapcontrols rb in {messageID=messageid;protocolOp=protocol_op;controls=controls} | _ -> raise (LDAP_Decoder "decode_ldapmessage: expected sequence") ocamldap-2.1.8/ldap_protocol.mli0000644000175000017500000000341610444405447016202 0ustar gildorgildor(* an implementation of the ldap wire protocol Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** an implementation of the ldap wire protocol *) open Ldap_types open Lber (** return the int asociated with the specified result code *) val encode_resultcode : ldap_resultcode -> int (** return the result code for the specified int, error codes which do not map to a code defined within the standard (or any of our own internal ones) will be represented as (`UNKNOWN_ERROR of int), where int is the unknown error code. *) val decode_resultcode : int -> ldap_resultcode (** encode a value of type ldap_message using lber and return a string which is ready to be put on the wire *) val encode_ldapmessage : ldap_message -> string (** decode an ldap_message from the wire, and build/return a structure of type ldap_message *) val decode_ldapmessage : readbyte -> ldap_message ocamldap-2.1.8/ldap_schemalexer.mll0000644000175000017500000001324510444405447016645 0ustar gildorgildor(* lexer for rfc2252 format schemas Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { type token = Lparen | Rparen | Numericoid of string | Name of string list | Desc of string | Obsolete | Equality of string | Ordering of string | Substr of string | Syntax of string * Int64.t | Single_value | Collective | No_user_modification | Usage of string | Sup of string list | Abstract | Structural | Auxiliary | Must of string list | May of string list | Xstring of string let quote = Str.regexp "'" let spacerex = Str.regexp " *" let stripspace buf = Str.global_replace spacerex "" buf let extract buf i chop = String.sub buf i ((String.length buf) - i - chop);; let splitoidlst buf regex = Str.split regex buf;; let stripquote buf = Str.global_replace quote "" buf let stripquotes lst = List.map (fun item -> stripquote item) lst } (* conversion definitions, from rfc 2252. I've tried to keep the names the same, or close. I've changed some names to make them more descriptive *) let alpha = [ 'a' - 'z' 'A' - 'Z' ] let digit = [ '0' - '9' ] let hdigit = [ 'a' - 'f' 'A' - 'F' '0' - '9' ] let k = [ 'a' - 'z' 'A' - 'Z' '0' - '9' '-' ';' ] let p = [ 'a' - 'z' 'A' - 'Z' '0' - '9' '"' '(' ')' '+' ',' '-' '.' '/' ':' '?' ' ' ] let utf8 = [ '\t' ' ' '!' - '&' '(' - '~' ] (* for now, this works, need to read about this *) let xstring = [ 'A' - 'Z' '-' ';' '_' ] + let whsp = ' ' + let dstring = utf8 * let qdstring = (whsp)? '\'' (dstring as qdstringval) '\'' (whsp)? let qdstringlist = qdstring + let qdstrings = qdstring | ( (whsp)? '(' qdstringlist ')' (whsp)? ) let letterstring = alpha + let numericstring = digit + let anhstring = k + let keystring = alpha anhstring * let printablestring = p + let space = ' ' + let descr = keystring let qdescr = whsp ''' (descr as qdescrval) ''' whsp let qdescrlist = qdescr ( ''' descr ''' whsp ) * let numericoid = numericstring ( '.' numericstring ) * let oid = descr | numericoid let woid = ( whsp )? oid ( whsp )? let oidlist = ( woid ( '$' woid ) * ) as oidlst let oids = woid as oidlst | whsp '(' ( oidlist as oidlst ) ')' whsp (* violates rfc2252 to support Microsoft Active Directory, but at least is not ambigous *) let noidlen = whsp ( ( numericoid ( '{' numericstring '}' ) ? ) as oid ) | whsp ''' ( ( numericoid ( '{' numericstring '}' ) ? ) as oid ) ''' | whsp ''' ( keystring as oid ) ''' let attributeUsage = "userApplication" | "directoryOperation" | "distributedOperation" | "dSAOperation" rule lexattr = parse '(' whsp {Lparen} | "NAME" qdescr {Name [qdescrval]} | "NAME" whsp '(' (qdescrlist as namelst) ')' whsp {Name (stripquotes (splitoidlst namelst (Str.regexp " *")))} | "DESC" qdstring {Desc qdstringval} | "OBSOLETE" whsp {Obsolete} | "SUP" whsp (woid as sup) {Sup [(stripspace sup)]} | "EQUALITY" whsp (woid as equality) {Equality (stripspace equality)} | "ORDERING" whsp (woid as ord) {Ordering (stripspace ord)} | "SUBSTR" whsp (woid as substr) {Substr (stripspace substr)} | "SYNTAX" noidlen whsp {match (splitoidlst oid (Str.regexp "{")) with [syntax] -> Syntax (syntax, Int64.zero) | [syntax;length] -> Syntax (syntax, Int64.of_string (extract length 0 1)) | _ -> failwith "syntax error"} | "SINGLE-VALUE" whsp {Single_value} | "COLLECTIVE" whsp {Collective} | "NO-USER-MODIFICATION" whsp {No_user_modification} | "USAGE" whsp attributeUsage whsp {Usage (extract (Lexing.lexeme lexbuf) 6 1)} | "X-" xstring qdstrings {Xstring (Lexing.lexeme lexbuf)} | oid whsp {Numericoid (extract (Lexing.lexeme lexbuf) 0 1)} | ')' {Rparen} and lexoc = parse '(' whsp {Lparen} | "NAME" qdescr {Name [qdescrval]} | "NAME" whsp '(' (qdescrlist as namelst) ')' whsp {Name (stripquotes (splitoidlst namelst (Str.regexp " *")))} | "DESC" qdstring {Desc qdstringval} | "OBSOLETE" whsp {Obsolete} | "SUP" whsp (woid as sup) {Sup [(stripspace sup)]} | "SUP" whsp '(' oidlist ')' whsp {Sup (List.rev_map stripspace (splitoidlst oidlst (Str.regexp " *\\$ *")))} | "ABSTRACT" whsp {Abstract} | "STRUCTURAL" whsp {Structural} | "AUXILIARY" whsp {Auxiliary} | "MUST" whsp (woid as must) {Must [(stripspace must)]} | "MUST" whsp '(' oidlist ')' whsp {Must (List.rev_map stripspace (splitoidlst oidlst (Str.regexp " *\\$ *")))} | "MAY" whsp (woid as may) {May [(stripspace may)]} | "MAY" whsp '(' oidlist ')' whsp {May (List.rev_map stripspace (splitoidlst oidlst (Str.regexp " *\\$ *")))} | "X-" xstring qdstrings {Xstring (Lexing.lexeme lexbuf)} | oid whsp {Numericoid (extract (Lexing.lexeme lexbuf) 0 1)} | ')' {Rparen} ocamldap-2.1.8/ldap_schemaparser.ml0000644000175000017500000002654610444405447016656 0ustar gildorgildor(* A parser for rfc2252 format schema definitionsa Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_schemalexer;; module Oid = (struct type t = string let of_string s = s let to_string oid = oid let compare x y = String.compare (to_string x) (to_string y) end : sig type t val of_string: string -> t val to_string: t -> string val compare: t -> t -> int end);; let format_oid id = Format.open_box 0; Format.print_string (""); Format.close_box () module Lcstring = (struct type t = string let of_string s = String.lowercase s let to_string x = x let compare x y = String.compare x y end : sig type t val of_string: string -> t val to_string: t -> string val compare: t -> t -> int end);; let format_lcstring id = Format.open_box 0; Format.print_string (""); Format.close_box () type octype = Abstract | Structural | Auxiliary;; type objectclass = {oc_name: string list; oc_oid:Oid.t; oc_desc:string; oc_obsolete:bool; oc_sup:Lcstring.t list; oc_must:Lcstring.t list; oc_may:Lcstring.t list; oc_type:octype; oc_xattr:string list} type attribute = {at_name:string list; at_desc:string; at_oid:Oid.t; at_equality:string; at_ordering:string; at_substr:Oid.t; at_syntax:Oid.t; at_length: Int64.t; at_obsolete:bool; at_single_value:bool; at_collective:bool; at_no_user_modification:bool; at_usage:string; at_sup:Lcstring.t list; at_xattr:string list};; type schema = {objectclasses: (Lcstring.t, objectclass) Hashtbl.t; objectclasses_byoid: (Oid.t, objectclass) Hashtbl.t; attributes: (Lcstring.t, attribute) Hashtbl.t; attributes_byoid: (Oid.t, attribute) Hashtbl.t};; type schema_error = Undefined_attr_reference of string | Undefined_oc_reference of string | Cross_linked_oid of string list let typecheck_schema schema = let attribute_exists_p schema attr = if Hashtbl.mem schema.attributes attr then true else Hashtbl.fold (fun _ {at_name=names} b -> if b then b else List.exists (fun name -> (Lcstring.of_string name) = attr) names) schema.attributes false in (* check that all musts, and all mays are attributes which exist. It would be an error to specify a must or a may which does not exist. *) let errors = Hashtbl.fold (fun oc {oc_must=musts;oc_may=mays} errors -> let check_error errors attr = if not (attribute_exists_p schema attr) then (Lcstring.to_string oc, Undefined_attr_reference (Lcstring.to_string attr)) :: errors else errors in (List.rev_append errors (List.rev_append (List.fold_left check_error [] musts) (List.fold_left check_error [] mays)))) schema.objectclasses [] in (* check for cross linked oids *) let errors = let oids = Hashtbl.create 100 in let seen = Hashtbl.create 100 in Hashtbl.iter (fun oid {at_name=n} -> Hashtbl.add oids oid (List.hd n)) schema.attributes_byoid; Hashtbl.iter (fun oid {oc_name=n} -> Hashtbl.add oids oid (List.hd n)) schema.objectclasses_byoid; Hashtbl.fold (fun oid name errors -> if List.length (Hashtbl.find_all oids oid) > 1 then if Hashtbl.mem seen oid then errors else ( Hashtbl.add seen oid (); (name, Cross_linked_oid (Hashtbl.find_all oids oid)) :: errors ) else errors ) oids errors in (* make sure all superior ocs are defined *) let errors = Hashtbl.fold (fun oc {oc_sup=sups} errors -> List.rev_append errors (List.rev_map (fun missing -> (missing, Undefined_oc_reference missing)) (List.filter (fun oc -> not (Hashtbl.mem schema.objectclasses (Lcstring.of_string oc))) (List.rev_map Lcstring.to_string sups)))) schema.objectclasses errors in errors let schema_print_depth = ref 10 let format_schema s = let indent = 3 in let printtbl tbl = let i = ref 0 in try Hashtbl.iter (fun aname aval -> if !i < !schema_print_depth then begin Format.print_string (""); Format.print_break 1 indent; i := !i + 1 end else failwith "depth") tbl with Failure "depth" -> Format.print_string "..." in Format.open_box 0; Format.print_string "{objectclasses = ;"; Format.print_break 0 1; Format.print_string "objectclasses_byoid = ;"; Format.print_break 0 1; Format.print_string "attributes = ;"; Format.print_break 0 1; Format.print_string "attributes_byoid = }"; Format.close_box () exception Parse_error_oc of Lexing.lexbuf * objectclass * string;; exception Parse_error_at of Lexing.lexbuf * attribute * string;; exception Syntax_error_oc of Lexing.lexbuf * objectclass * string;; exception Syntax_error_at of Lexing.lexbuf * attribute * string;; let rec readSchema oclst attrlst = let empty_oc = {oc_name=[];oc_oid=Oid.of_string "";oc_desc="";oc_obsolete=false;oc_sup=[]; oc_must=[];oc_may=[];oc_type=Abstract;oc_xattr=[]} in let empty_attr = {at_name=[];at_oid=Oid.of_string "";at_desc="";at_equality="";at_ordering=""; at_usage=""; at_substr=Oid.of_string "";at_syntax=Oid.of_string ""; at_length=0L;at_obsolete=false;at_single_value=false; at_collective=false;at_no_user_modification=false;at_sup=[];at_xattr=[]} in let readOc lxbuf oc = let rec readOptionalFields lxbuf oc = try match (lexoc lxbuf) with Name s -> readOptionalFields lxbuf {oc with oc_name=s} | Desc s -> readOptionalFields lxbuf {oc with oc_desc=s} | Obsolete -> readOptionalFields lxbuf {oc with oc_obsolete=true} | Sup s -> (readOptionalFields lxbuf {oc with oc_sup=(List.rev_map (Lcstring.of_string) s)}) | Ldap_schemalexer.Abstract -> readOptionalFields lxbuf {oc with oc_type=Abstract} | Ldap_schemalexer.Structural -> readOptionalFields lxbuf {oc with oc_type=Structural} | Ldap_schemalexer.Auxiliary -> readOptionalFields lxbuf {oc with oc_type=Auxiliary} | Must s -> (readOptionalFields lxbuf {oc with oc_must=(List.rev_map (Lcstring.of_string) s)}) | May s -> (readOptionalFields lxbuf {oc with oc_may=(List.rev_map (Lcstring.of_string) s)}) | Xstring t -> (readOptionalFields lxbuf {oc with oc_xattr=(t :: oc.oc_xattr)}) | Rparen -> oc | _ -> raise (Parse_error_oc (lxbuf, oc, "unexpected token")) with Failure(_) -> raise (Parse_error_oc (lxbuf, oc, "Expected right parenthesis")) in let readOid lxbuf oc = try match (lexoc lxbuf) with Numericoid(s) -> readOptionalFields lxbuf {oc with oc_oid=Oid.of_string s} | _ -> raise (Parse_error_oc (lxbuf, oc, "missing required field, numericoid")) with Failure(_) -> raise (Syntax_error_oc (lxbuf, oc, "Syntax error")) in let readLparen lxbuf oc = try match (lexoc lxbuf) with Lparen -> readOid lxbuf oc | _ -> raise (Parse_error_oc (lxbuf, oc, "Expected left paren")) with Failure(_) -> raise (Syntax_error_oc (lxbuf, oc, "Syntax error")) in readLparen lxbuf oc in let rec readOcs oclst schema = match oclst with a :: l -> let oc = readOc (Lexing.from_string a) empty_oc in List.iter (fun n -> Hashtbl.add schema.objectclasses (Lcstring.of_string n) oc) oc.oc_name; Hashtbl.add schema.objectclasses_byoid oc.oc_oid oc;readOcs l schema | [] -> () in let rec readAttr lxbuf attr = let rec readOptionalFields lxbuf attr = try match (lexattr lxbuf) with Name s -> readOptionalFields lxbuf {attr with at_name=s} | Desc s -> readOptionalFields lxbuf {attr with at_desc=s} | Obsolete -> readOptionalFields lxbuf {attr with at_obsolete=true} | Sup s -> readOptionalFields lxbuf {attr with at_sup=(List.rev_map (Lcstring.of_string) s)} | Equality s -> readOptionalFields lxbuf {attr with at_equality=s} | Substr s -> readOptionalFields lxbuf {attr with at_substr=Oid.of_string s} | Ordering s -> readOptionalFields lxbuf {attr with at_ordering=s} | Syntax (s, l) -> readOptionalFields lxbuf {attr with at_syntax=Oid.of_string s;at_length=l} | Single_value -> readOptionalFields lxbuf {attr with at_single_value=true} | Collective -> readOptionalFields lxbuf {attr with at_collective=true} | No_user_modification -> readOptionalFields lxbuf {attr with at_no_user_modification=true} | Usage s -> readOptionalFields lxbuf {attr with at_usage=s} | Rparen -> attr | Xstring t -> (readOptionalFields lxbuf {attr with at_xattr=(t :: attr.at_xattr)}) | _ -> raise (Parse_error_at (lxbuf, attr, "unexpected token")) with Failure(f) -> raise (Parse_error_at (lxbuf, attr, f)) in let readOid lxbuf attr = try match (lexoc lxbuf) with Numericoid(s) -> readOptionalFields lxbuf {attr with at_oid=Oid.of_string s} | _ -> raise (Parse_error_at (lxbuf, attr, "missing required field, numericoid")) with Failure(_) -> raise (Syntax_error_at (lxbuf, attr, "Syntax error")) in let readLparen lxbuf attr = try match (lexoc lxbuf) with Lparen -> readOid lxbuf attr | _ -> raise (Parse_error_at (lxbuf, attr, "Expected left paren")) with Failure(_) -> raise (Syntax_error_at (lxbuf, attr, "Syntax error")) in readLparen lxbuf attr in let rec readAttrs attrlst schema = match attrlst with a :: l -> let attr = readAttr (Lexing.from_string a) empty_attr in List.iter (fun n -> Hashtbl.add schema.attributes (Lcstring.of_string n) attr) attr.at_name; Hashtbl.add schema.attributes_byoid attr.at_oid attr;readAttrs l schema | [] -> () in let schema = {objectclasses=Hashtbl.create 500; objectclasses_byoid=Hashtbl.create 500; attributes=Hashtbl.create 5000; attributes_byoid=Hashtbl.create 5000} in readAttrs attrlst schema; readOcs oclst schema; schema;; ocamldap-2.1.8/ldap_schemaparser.mli0000644000175000017500000000560010444405447017013 0ustar gildorgildor(** A library for parsing rfc2252 schemas as returned by directory servers *) module Oid : sig type t val of_string : string -> t val to_string : t -> string val compare : t -> t -> int end val format_oid : Oid.t -> unit module Lcstring : sig type t val of_string : string -> t val to_string : t -> string val compare : t -> t -> int end val format_lcstring : Lcstring.t -> unit type octype = Abstract | Structural | Auxiliary (** The type representing an objectclass definition *) type objectclass = { oc_name : string list; oc_oid : Oid.t; oc_desc : string; oc_obsolete : bool; oc_sup : Lcstring.t list; oc_must : Lcstring.t list; oc_may : Lcstring.t list; oc_type : octype; oc_xattr : string list; } (** The type representing an attribute definition *) type attribute = { at_name : string list; at_desc : string; at_oid : Oid.t; at_equality : string; at_ordering : string; at_substr : Oid.t; at_syntax : Oid.t; at_length : Int64.t; at_obsolete : bool; at_single_value : bool; at_collective : bool; at_no_user_modification : bool; at_usage : string; at_sup : Lcstring.t list; at_xattr : string list; } (** The type representing the whole schema. Consists of hashtbls indexed by two useful keys. For both attributes and objectclasses there exists a hashtbl indexed by OID, and one indexed by lower case canonical name. There exist functions in Ldap_ooclient to look up attributes and objectclasses by non canonical names if that is necessary for you to do. see attrToOid, and ocToOid. They will find the oid of an attribute or objectclass given any name, not just the canonical one. Not that this is somewhat (like several orders of magnitude) slower than lookups by canonical name.*) type schema = { objectclasses : (Lcstring.t, objectclass) Hashtbl.t; objectclasses_byoid : (Oid.t, objectclass) Hashtbl.t; attributes : (Lcstring.t, attribute) Hashtbl.t; attributes_byoid : (Oid.t, attribute) Hashtbl.t; } (** This reference controls the dept of printing for the schema in the toplevel. The default is 10 keys from each table will be printed. OID tables are not currently printed. *) val schema_print_depth : int ref (** A formatter for the schema, prints the structure, and expands the hashtbls to show the keys. The number of keys printed is controled by schema_print_depth. *) val format_schema : schema -> unit exception Parse_error_oc of Lexing.lexbuf * objectclass * string exception Parse_error_at of Lexing.lexbuf * attribute * string exception Syntax_error_oc of Lexing.lexbuf * objectclass * string exception Syntax_error_at of Lexing.lexbuf * attribute * string (** readSchema attribute_list objectclass_list, parse the schema into a schema type given a list of attribute definition lines, and objectclass definition lines. *) val readSchema : string list -> string list -> schema ocamldap-2.1.8/ldap_toplevel.ml0000644000175000017500000000430110444405447016014 0ustar gildorgildor(* Functions which resemble the command line tools, useful in the interactive environment Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_ooclient open Ldap_types open Ldif_oo open Ldap_schemaparser let eval s = let l = Lexing.from_string s in let ph = !Toploop.parse_toplevel_phrase l in assert(Toploop.execute_phrase false Format.err_formatter ph) ;; eval "#install_printer Ldap_ooclient.format_entries;;";; eval "#install_printer Ldap_ooclient.format_entry;;";; eval "#install_printer Ldap_schemaparser.format_oid;;";; eval "#install_printer Ldap_schemaparser.format_lcstring;;";; eval "#install_printer Ldap_schemaparser.format_schema;;";; let ldap_cmd_harness ~h ~d ~w f = let ldap = new ldapcon [h] in try ldap#bind d ~cred:w; let res = f ldap in ldap#unbind; res with exn -> ldap#unbind;raise exn ;; let ldapsearch ?(s=`SUBTREE) ?(a=[]) ?(b="") ?(d="") ?(w="") ~h filter = ldap_cmd_harness ~h ~d ~w (fun ldap -> ldap#search ~base:b ~scope:s ~attrs:a filter) ;; let ldapmodify ~h ~d ~w mods = ldap_cmd_harness ~h ~d ~w (fun ldap -> List.iter (fun (dn, ldmod) -> ldap#modify dn ldmod) mods) ;; let ldapadd ~h ~d ~w entries = ldap_cmd_harness ~h ~d ~w (fun ldap -> List.iter (fun entry -> ldap#add entry) entries) ;; ocamldap-2.1.8/ldap_toplevel.mli0000644000175000017500000000533310444405447016173 0ustar gildorgildor(* Functions which resemble the command line tools which many users are familar with, useful in the interactive environment Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Functions which resemble the command line tools which many users are familar with, useful in the interactive environment *) (** connect to the specified host and perform a search. @param h The ldapurl which names the host and port to connect to @param d The dn of the object you with to bind as, default anonymous @param w The credentials of the object you wish to bind as, default anonymous @param s The scope of the search, default `SUBTREE @param b The base of the search The final argument is the search filter *) val ldapsearch : ?s:Ldap_types.search_scope -> ?a:string list -> ?b:string -> ?d:string -> ?w:string -> h:string -> string -> Ldap_ooclient.ldapentry list (** connect to the specified host and perform one or more modifications. @param h The ldapurl which names the host and port to connect to @param d The dn of the object you with to bind as, default anonymous @param w The credentials of the object you wish to bind as, default anonymous The final argument is a list of (dn, modification) pairs which you want to apply *) val ldapmodify : h:string -> d:string -> w:string -> (string * (Ldap_types.modify_optype * string * string list) list) list -> unit (** connect to the specified host and add the specified objects. @param h The ldapurl which names the host and port to connect to @param d The dn of the object you with to bind as, default anonymous @param w The credentials of the object you wish to bind as, default anonymous The final argument is a list of objects you wish to add *) val ldapadd : h:string -> d:string -> w:string -> Ldap_ooclient.ldapentry list -> unit ocamldap-2.1.8/ldap_txooclient.ml0000644000175000017500000001345310444405447016362 0ustar gildorgildoropen Ldap_mutex open Ldap_ooclient open Ldap_types type txn = { mutable dead: bool; entries: (string, (ldapentry_t * ldapentry_t)) Hashtbl.t } exception Rollback of exn * ((ldapentry_t * ldapentry_t) list) exception Txn_commit_failure of string * exn * ldapentry_t list option exception Txn_rollback_failure of string * exn class ldapadvisorytxcon ?(connect_timeout=1) ?(referral_policy=`RETURN) ?(version = 3) hosts binddn bindpw mutextbldn = let copy_entry entry = let new_entry = new ldapentry in new_entry#set_dn (entry#dn); List.iter (fun attr -> new_entry#add [(attr, entry#get_value attr)]) entry#attributes; new_entry in object (self) inherit ldapcon ~connect_timeout ~referral_policy ~version hosts as super initializer super#bind binddn ~cred:bindpw val lock_table = new object_lock_table hosts binddn bindpw mutextbldn method private check_dead txn = if txn.dead then raise (LDAP_Failure (`LOCAL_ERROR, "this transaction is dead, create a new one", {ext_matched_dn="";ext_referral=None})) method begin_txn = {dead=false;entries=Hashtbl.create 1} method associate_entry txn (entry: ldapentry_t) = self#check_dead txn; let dn = Ldap_dn.canonical_dn entry#dn in if Hashtbl.mem txn.entries dn then raise (LDAP_Failure (`LOCAL_ERROR, "dn: " ^ dn ^ " is already part of this transaction", {ext_matched_dn="";ext_referral=None})) else if entry#changes = [] then begin lock_table#lock (Ldap_dn.of_string dn); Hashtbl.add txn.entries dn ((copy_entry entry), (entry :> ldapentry_t)) end else raise (LDAP_Failure (`LOCAL_ERROR, "this entry has been changed since it was downloaded " ^ "commit your current changes, and then add the entry to " ^ "this transaction", {ext_matched_dn="";ext_referral=None})) method associate_entries txn entries = List.iter (self#associate_entry txn) entries method disassociate_entry txn (entry: ldapentry_t) = self#check_dead txn; let dn = Ldap_dn.canonical_dn entry#dn in if Hashtbl.mem txn.entries dn then begin Hashtbl.remove txn.entries dn; lock_table#unlock (Ldap_dn.of_string dn); end else raise (LDAP_Failure (`LOCAL_ERROR, "dn: " ^ dn ^ " is not part of this transaction", {ext_matched_dn="";ext_referral=None})) method disassociate_entries txn entries = List.iter (self#disassociate_entry txn) entries method commit_txn txn = self#check_dead txn; txn.dead <- true; try List.iter (fun (_, e) -> lock_table#unlock (Ldap_dn.of_string e#dn)) (Hashtbl.fold (fun k (original_entry, modified_entry) successful_so_far -> try (match modified_entry#changetype with `MODIFY -> super#update_entry modified_entry | `ADD -> super#add modified_entry | `DELETE -> super#delete modified_entry#dn | `MODRDN -> super#modrdn original_entry#dn (Ldap_dn.to_string [(List.hd (Ldap_dn.of_string modified_entry#dn))]) | `MODDN -> let dn = Ldap_dn.of_string modified_entry#dn in super#modrdn original_entry#dn (Ldap_dn.to_string [List.hd dn]) ~newsup:(Some (Ldap_dn.to_string (List.tl dn)))); (original_entry, modified_entry) :: successful_so_far with exn -> raise (Rollback (exn, successful_so_far))) txn.entries []) with Rollback (exn, successful_so_far) -> (Hashtbl.iter (fun k (_, e) -> e#flush_changes) txn.entries); (match ((Hashtbl.iter (* rollback everything in memory *) (fun k (original_entry, modified_entry) -> match modified_entry#changetype with `MODIFY -> modified_entry#modify (original_entry#diff modified_entry) | `ADD -> () | `DELETE -> () | `MODRDN -> if not (List.mem (original_entry, modified_entry) successful_so_far) then modified_entry#set_dn original_entry#dn | `MODDN -> if not (List.mem (original_entry, modified_entry) successful_so_far) then modified_entry#set_dn original_entry#dn) txn.entries); (List.fold_left (* rollback in the directory only what we commited *) (fun not_rolled_back (original_entry, modified_entry) -> try (match modified_entry#changetype with `MODIFY -> super#update_entry modified_entry | `ADD -> super#delete modified_entry#dn | `DELETE -> super#add modified_entry | `MODRDN -> super#modrdn (modified_entry#dn) (Ldap_dn.to_string [List.hd (Ldap_dn.of_string original_entry#dn)]) | `MODDN -> super#modrdn (modified_entry#dn) (Ldap_dn.to_string [List.hd (Ldap_dn.of_string original_entry#dn)]) ~newsup:(Some (Ldap_dn.to_string (List.tl (Ldap_dn.of_string original_entry#dn))))); not_rolled_back with _ -> modified_entry :: not_rolled_back) [] successful_so_far)) with [] -> Hashtbl.iter (fun k (e, _) -> lock_table#unlock (Ldap_dn.of_string e#dn)) txn.entries; (Hashtbl.iter (fun k (_, e) -> e#flush_changes) txn.entries); raise (Txn_commit_failure ("rollback successful", exn, None)) | not_rolled_back -> Hashtbl.iter (fun k (e, _) -> lock_table#unlock (Ldap_dn.of_string e#dn)) txn.entries; (Hashtbl.iter (fun k (_, e) -> e#flush_changes) txn.entries); raise (Txn_commit_failure ("rollback failed", exn, Some not_rolled_back))) method rollback_txn txn = txn.dead <- true; Hashtbl.iter (fun k (original_entry, modified_entry) -> try lock_table#unlock (Ldap_dn.of_string original_entry#dn); modified_entry#modify (original_entry#diff modified_entry); modified_entry#flush_changes with exn -> raise (Txn_rollback_failure ("rollback failed", exn))) txn.entries end ocamldap-2.1.8/ldap_txooclient.mli0000644000175000017500000000661710444405447016537 0ustar gildorgildoropen Ldap_ooclient (** the abstract type of a transaction *) type txn (** raised when a commit fails, contains a list of entries which were not rolled back successfully only if rollback failed as well, otherwise None *) exception Txn_commit_failure of string * exn * ldapentry_t list option (** raised when an explicit rollback fails *) exception Txn_rollback_failure of string * exn (** A subclass of ldapcon which implements an experimental interface to draft_zeilenga_ldap_txn. A draft standard for multi object transactions over the ldap protocol. This class can only implement advisory transactions because it must depend on the advisory locking mechanisms for the transactions to be consistant. You use this class by calling begin_txn to get a transaction id, and then associating a set of ldapentry objects with the transaction by calling associate_entry_with_txn. You are then free to modify those entries in any way you like, and when you are done, you can either call commit_txn, or rollback_txn. Commit will commit the changes of all the entries associated with the transaction to the database. For other writers which obey advisory locking the commit operation is atomic. For readers which are willing to obey advisory locking is atomic. If the commit fails, a full rollback occurrs, including all changes made to the directory. For example in a set of N entries in a transaction, if the modificiation of the nth entry fails to commit, then the modifications to all the previous entries, which have already been made in the directory, are undone. It is important to note that if advisory locking is not obeyed, rollback may not be successful. Rollback undoes all the changes you've made in memory, and unlocks all the objects in the transaction. After a transaction object has been commited or rolled back it is considered "dead", and cannot be used again. *) class ldapadvisorytxcon : ?connect_timeout:int -> ?referral_policy:[> `RETURN ] -> ?version:int -> string list -> string -> string -> string -> (* hosts binddn bindpw mutextbldn *) object method add : ldapentry -> unit method bind : ?cred:string -> ?meth:Ldap_funclient.authmethod -> string -> unit method delete : string -> unit method modify : string -> (Ldap_types.modify_optype * string * string list) list -> unit method modrdn : string -> ?deleteoldrdn:bool -> ?newsup:string option -> string -> unit method rawschema : ldapentry method schema : Ldap_schemaparser.schema method search : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> ?sizelimit:Int32.t -> ?timelimit:Int32.t -> string -> ldapentry list method search_a : ?scope:Ldap_types.search_scope -> ?attrs:string list -> ?attrsonly:bool -> ?base:string -> ?sizelimit:Int32.t -> ?timelimit:Int32.t -> string -> (?abandon:bool -> unit -> ldapentry) method unbind : unit method update_entry : ldapentry -> unit method begin_txn : txn method associate_entry : txn -> ldapentry_t -> unit method associate_entries : txn -> ldapentry_t list -> unit method disassociate_entry : txn -> ldapentry_t -> unit method disassociate_entries : txn -> ldapentry_t list -> unit method commit_txn : txn -> unit method rollback_txn : txn -> unit end ocamldap-2.1.8/ldap_types.ml0000644000175000017500000002041710444405447015334 0ustar gildorgildor(* Common data types from rfc 2251 used throughout the library Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Common data types used by ocamldap. Most of these types are taken from the ASN.1 specification for LDAP as defined in rfc2251 @see rfc2251*) (** An encoding error has occurred, the argument contains a description of the error This is likely a bug, so it should be reported *) exception LDAP_Encoder of string (** A decoding error has occurred, the argument contains a description of the error. This MAY be a bug, but it may also be that the server you are talking to is non standard. Please report these right away in any case.*) exception LDAP_Decoder of string type ldap_resultcode = [ `SUCCESS | `OPERATIONS_ERROR | `PROTOCOL_ERROR | `TIMELIMIT_EXCEEDED | `SIZELIMIT_EXCEEDED | `COMPARE_FALSE | `COMPARE_TRUE | `AUTH_METHOD_NOT_SUPPORTED | `STRONG_AUTH_REQUIRED | `REFERRAL | `ADMINLIMIT_EXCEEDED | `UNAVAILABLE_CRITICAL_EXTENSION | `CONFIDENTIALITY_REQUIRED | `SASL_BIND_IN_PROGRESS | `NO_SUCH_ATTRIBUTE | `UNDEFINED_TYPE | `INAPPROPRIATE_MATCHING | `CONSTRAINT_VIOLATION | `TYPE_OR_VALUE_EXISTS | `INVALID_SYNTAX | `NO_SUCH_OBJECT | `ALIAS_PROBLEM | `INVALID_DN_SYNTAX | `IS_LEAF | `ALIAS_DEREF_PROBLEM | `INAPPROPRIATE_AUTH | `INVALID_CREDENTIALS | `INSUFFICIENT_ACCESS | `BUSY | `UNAVAILABLE | `UNWILLING_TO_PERFORM | `LOOP_DETECT | `NAMING_VIOLATION | `OBJECT_CLASS_VIOLATION | `NOT_ALLOWED_ON_NONLEAF | `NOT_ALLOWED_ON_RDN | `ALREADY_EXISTS | `NO_OBJECT_CLASS_MODS | `AFFECTS_MULTIPLE_DSAS | `OTHER | `SERVER_DOWN | `LOCAL_ERROR | `ENCODING_ERROR | `DECODING_ERROR | `TIMEOUT | `AUTH_UNKNOWN | `FILTER_ERROR | `USER_CANCELLED | `PARAM_ERROR | `NO_MEMORY | `CONNECT_ERROR | `NOT_SUPPORTED | `CONTROL_NOT_FOUND | `NO_RESULTS_RETURNED | `MORE_RESULTS_TO_RETURN | `CLIENT_LOOP | `REFERRAL_LIMIT_EXCEEDED | `UNKNOWN_ERROR of int ] type ldap_result = { result_code: ldap_resultcode; matched_dn: string; error_message: string; ldap_referral: (string list) option; } (** extended information to return with the LDAP_Failure exception. Contains the remaining values which are defined by the protocol ext_matched_dn: the matched dn. Commonly set by `NO_SUCH_OBJECT. ext_referral: a list of ldapurls returned by the server when you attempted to do a write operation. If you use Ldap_ooclient with referrals set to follow you will never see this*) type ldap_ext_return = { ext_matched_dn: string; ext_referral: string list option; } (** The exception raised to indicate all types of failure in the higher level libraries Ldap_funclient, and Ldap_ooclient. example [LDAP_Failure (`NO_SUCH_OBJECT, "no such object", {ext_matched_dn=Some "o=csun";ext_referral=None})] *) exception LDAP_Failure of ldap_resultcode * string * ldap_ext_return type saslCredentials = { sasl_mechanism: string; sasl_credentials: string option; } type authentication = Simple of string | Sasl of saslCredentials type bind_request = { bind_version: int; bind_name: string; bind_authentication: authentication; } type bind_response = { bind_result: ldap_result; bind_serverSaslCredentials: string option; } type attribute = { attr_type: string; attr_vals: string list; } type dn = attribute list (** the type used to encode and decode a search entry. Also the type returned by search_s and search_a in Ldap_funclient *) type search_result_entry = { sr_dn: string; sr_attributes: attribute list; } (** a type defining the scope of a search filter *) type search_scope = [ `BASE (** search only at the base *) | `ONELEVEL (** search one level below the base *) | `SUBTREE (** search the entire tree under the base *)] type alias_deref = [ `NEVERDEREFALIASES | `DEREFINSEARCHING | `DEREFFINDINGBASE | `DEREFALWAYS ] type attribute_value_assertion = { attributeDesc: string; assertionValue: string; } type matching_rule_assertion = { matchingRule: string option; ruletype: string option; matchValue: string; dnAttributes: bool; (* default false *) } type substring_component = { (* at least one must be specified *) substr_initial: string list; substr_any: string list; substr_final: string list; } type substring_filter = { attrtype: string; substrings: substring_component; } type filter = [ `And of filter list | `Or of filter list | `Not of filter | `EqualityMatch of attribute_value_assertion | `Substrings of substring_filter | `GreaterOrEqual of attribute_value_assertion | `LessOrEqual of attribute_value_assertion | `Present of string | `ApproxMatch of attribute_value_assertion | `ExtensibleMatch of matching_rule_assertion ] type search_request = { baseObject: string; scope: search_scope; derefAliases: alias_deref; sizeLimit: int32; timeLimit: int32; typesOnly: bool; filter: filter; s_attributes: string list; } type modify_optype = [ `ADD | `DELETE | `REPLACE ] type modify_op = { mod_op: modify_optype; mod_value: attribute; } type modify_request = { mod_dn: string; modification: modify_op list } type modify_dn_request = { modn_dn: string; modn_newrdn: string; modn_deleteoldrdn: bool; modn_newSuperior: string option } type compare_request = { cmp_dn: string; cmp_ava: attribute_value_assertion; } type extended_request = { ext_requestName: string; ext_requestValue: string option; } type extended_response = { ext_result: ldap_result; ext_responseName: string option; ext_response: string option; } type protocol_op = Bind_request of bind_request | Bind_response of bind_response | Unbind_request | Search_request of search_request | Search_result_entry of search_result_entry | Search_result_reference of string list | Search_result_done of ldap_result | Modify_request of modify_request | Modify_response of ldap_result | Add_request of search_result_entry | Add_response of ldap_result | Delete_request of string | Delete_response of ldap_result | Modify_dn_request of modify_dn_request | Modify_dn_response of ldap_result | Compare_request of compare_request | Compare_response of ldap_result | Abandon_request of Int32.t | Extended_request of extended_request | Extended_response of extended_response type ldap_control = { controlType: string; criticality: bool; controlValue: string option } type ldap_controls = ldap_control list type ldap_message = { messageID: Int32.t; protocolOp: protocol_op; controls: ldap_controls option; } type con_mech = [ `SSL | `PLAIN ] type ldap_url = { url_mech: con_mech; url_host: string option; url_port: string option; url_dn: string option; url_attributes: (string list) option; url_scope: search_scope option; url_filter: filter option; url_ext: ((bool * string * string) list) option; } (** see draft-zeilenga-ldap-grouping-xx Ldap grouping is a way of telling the server that a set of ldap operations is related, its most interesting application is transactions across multiple objects. This draft is not yet implemented by any present day ldap server *) type ldap_grouping_type = [ `LDAP_GROUP_TXN ] (** a cookie that is sent with every ldap operation which is part of a group *) type ldap_grouping_cookie ocamldap-2.1.8/ldap_types.mli0000644000175000017500000002041710444405447015505 0ustar gildorgildor(* Common data types from rfc 2251 used throughout the library Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Common data types used by ocamldap. Most of these types are taken from the ASN.1 specification for LDAP as defined in rfc2251 @see rfc2251*) (** An encoding error has occurred, the argument contains a description of the error This is likely a bug, so it should be reported *) exception LDAP_Encoder of string (** A decoding error has occurred, the argument contains a description of the error. This MAY be a bug, but it may also be that the server you are talking to is non standard. Please report these right away in any case.*) exception LDAP_Decoder of string type ldap_resultcode = [ `SUCCESS | `OPERATIONS_ERROR | `PROTOCOL_ERROR | `TIMELIMIT_EXCEEDED | `SIZELIMIT_EXCEEDED | `COMPARE_FALSE | `COMPARE_TRUE | `AUTH_METHOD_NOT_SUPPORTED | `STRONG_AUTH_REQUIRED | `REFERRAL | `ADMINLIMIT_EXCEEDED | `UNAVAILABLE_CRITICAL_EXTENSION | `CONFIDENTIALITY_REQUIRED | `SASL_BIND_IN_PROGRESS | `NO_SUCH_ATTRIBUTE | `UNDEFINED_TYPE | `INAPPROPRIATE_MATCHING | `CONSTRAINT_VIOLATION | `TYPE_OR_VALUE_EXISTS | `INVALID_SYNTAX | `NO_SUCH_OBJECT | `ALIAS_PROBLEM | `INVALID_DN_SYNTAX | `IS_LEAF | `ALIAS_DEREF_PROBLEM | `INAPPROPRIATE_AUTH | `INVALID_CREDENTIALS | `INSUFFICIENT_ACCESS | `BUSY | `UNAVAILABLE | `UNWILLING_TO_PERFORM | `LOOP_DETECT | `NAMING_VIOLATION | `OBJECT_CLASS_VIOLATION | `NOT_ALLOWED_ON_NONLEAF | `NOT_ALLOWED_ON_RDN | `ALREADY_EXISTS | `NO_OBJECT_CLASS_MODS | `AFFECTS_MULTIPLE_DSAS | `OTHER | `SERVER_DOWN | `LOCAL_ERROR | `ENCODING_ERROR | `DECODING_ERROR | `TIMEOUT | `AUTH_UNKNOWN | `FILTER_ERROR | `USER_CANCELLED | `PARAM_ERROR | `NO_MEMORY | `CONNECT_ERROR | `NOT_SUPPORTED | `CONTROL_NOT_FOUND | `NO_RESULTS_RETURNED | `MORE_RESULTS_TO_RETURN | `CLIENT_LOOP | `REFERRAL_LIMIT_EXCEEDED | `UNKNOWN_ERROR of int ] type ldap_result = { result_code: ldap_resultcode; matched_dn: string; error_message: string; ldap_referral: (string list) option; } (** extended information to return with the LDAP_Failure exception. Contains the remaining values which are defined by the protocol ext_matched_dn: the matched dn. Commonly set by `NO_SUCH_OBJECT. ext_referral: a list of ldapurls returned by the server when you attempted to do a write operation. If you use Ldap_ooclient with referrals set to follow you will never see this*) type ldap_ext_return = { ext_matched_dn: string; ext_referral: string list option; } (** The exception raised to indicate all types of failure in the higher level libraries Ldap_funclient, and Ldap_ooclient. example [LDAP_Failure (`NO_SUCH_OBJECT, "no such object", {ext_matched_dn=Some "o=csun";ext_referral=None})] *) exception LDAP_Failure of ldap_resultcode * string * ldap_ext_return type saslCredentials = { sasl_mechanism: string; sasl_credentials: string option; } type authentication = Simple of string | Sasl of saslCredentials type bind_request = { bind_version: int; bind_name: string; bind_authentication: authentication; } type bind_response = { bind_result: ldap_result; bind_serverSaslCredentials: string option; } type attribute = { attr_type: string; attr_vals: string list; } type dn = attribute list (** the type used to encode and decode a search entry. Also the type returned by search_s and search_a in Ldap_funclient *) type search_result_entry = { sr_dn: string; sr_attributes: attribute list; } (** a type defining the scope of a search filter *) type search_scope = [ `BASE (** search only at the base *) | `ONELEVEL (** search one level below the base *) | `SUBTREE (** search the entire tree under the base *)] type alias_deref = [ `NEVERDEREFALIASES | `DEREFINSEARCHING | `DEREFFINDINGBASE | `DEREFALWAYS ] type attribute_value_assertion = { attributeDesc: string; assertionValue: string; } type matching_rule_assertion = { matchingRule: string option; ruletype: string option; matchValue: string; dnAttributes: bool; (* default false *) } type substring_component = { (* at least one must be specified *) substr_initial: string list; substr_any: string list; substr_final: string list; } type substring_filter = { attrtype: string; substrings: substring_component; } type filter = [ `And of filter list | `Or of filter list | `Not of filter | `EqualityMatch of attribute_value_assertion | `Substrings of substring_filter | `GreaterOrEqual of attribute_value_assertion | `LessOrEqual of attribute_value_assertion | `Present of string | `ApproxMatch of attribute_value_assertion | `ExtensibleMatch of matching_rule_assertion ] type search_request = { baseObject: string; scope: search_scope; derefAliases: alias_deref; sizeLimit: int32; timeLimit: int32; typesOnly: bool; filter: filter; s_attributes: string list; } type modify_optype = [ `ADD | `DELETE | `REPLACE ] type modify_op = { mod_op: modify_optype; mod_value: attribute; } type modify_request = { mod_dn: string; modification: modify_op list } type modify_dn_request = { modn_dn: string; modn_newrdn: string; modn_deleteoldrdn: bool; modn_newSuperior: string option } type compare_request = { cmp_dn: string; cmp_ava: attribute_value_assertion; } type extended_request = { ext_requestName: string; ext_requestValue: string option; } type extended_response = { ext_result: ldap_result; ext_responseName: string option; ext_response: string option; } type protocol_op = Bind_request of bind_request | Bind_response of bind_response | Unbind_request | Search_request of search_request | Search_result_entry of search_result_entry | Search_result_reference of string list | Search_result_done of ldap_result | Modify_request of modify_request | Modify_response of ldap_result | Add_request of search_result_entry | Add_response of ldap_result | Delete_request of string | Delete_response of ldap_result | Modify_dn_request of modify_dn_request | Modify_dn_response of ldap_result | Compare_request of compare_request | Compare_response of ldap_result | Abandon_request of Int32.t | Extended_request of extended_request | Extended_response of extended_response type ldap_control = { controlType: string; criticality: bool; controlValue: string option } type ldap_controls = ldap_control list type ldap_message = { messageID: Int32.t; protocolOp: protocol_op; controls: ldap_controls option; } type con_mech = [ `SSL | `PLAIN ] type ldap_url = { url_mech: con_mech; url_host: string option; url_port: string option; url_dn: string option; url_attributes: (string list) option; url_scope: search_scope option; url_filter: filter option; url_ext: ((bool * string * string) list) option; } (** see draft-zeilenga-ldap-grouping-xx Ldap grouping is a way of telling the server that a set of ldap operations is related, its most interesting application is transactions across multiple objects. This draft is not yet implemented by any present day ldap server *) type ldap_grouping_type = [ `LDAP_GROUP_TXN ] (** a cookie that is sent with every ldap operation which is part of a group *) type ldap_grouping_cookie ocamldap-2.1.8/ldap_url.ml0000644000175000017500000000263410444405447014773 0ustar gildorgildor(* a quick and dirty rfc 2255 ldap url lexer for referral processing Will only parse a subset of the ldapurl Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_urllexer exception Invalid_ldap_url of int * string let of_string s = let lx = Lexing.from_string s in try lexurl lx with Failure "lexing: empty token" -> raise (Invalid_ldap_url (lx.Lexing.lex_last_pos, "syntax error")) | exn -> raise (Invalid_ldap_url (lx.Lexing.lex_last_pos, Printexc.to_string exn)) ocamldap-2.1.8/ldap_url.mli0000644000175000017500000000310310444405447015134 0ustar gildorgildor(* a quick and dirty rfc 2255 ldap url lexer for referral processing Will only parse a subset of the ldapurl Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** a library for parsing a subset of the ldapurl syntax *) (** will be raised in the event of a parse or type error. The integer is the location of the error, measured in charachters from the left, and the string is a description of the error. The current lexer does not correctly set the charachter location, however future lexers will. *) exception Invalid_ldap_url of int * string (** internalize the url contained in the string argument *) val of_string : string -> Ldap_types.ldap_url ocamldap-2.1.8/ldap_urllexer.mll0000644000175000017500000000457610444405447016216 0ustar gildorgildor(* a quick and dirty rfc 2255 ldap url lexer for referral processing Will only parse a subset of the ldapurl Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { open Ldap_types open Str type lexeme = SCHEME | COLONSLASHSLASH | PORT of string | HOST of string | DN of string | IDENT of string | SCOPE of string | FILTER of string | QUESTION | EQUAL | CRITICAL | SLASH | WHSP | COMMA } let port = ['0' - '9']+ let host = ['-' '.' '0' - '9' 'a' - 'z' 'A' - 'Z']+ let dn = [',' '=' '0' - '9' 'a' - 'z' 'A' - 'Z']+ let attribute = ['a' - 'z' 'A' - 'Z' '0' - '9']+ let filter = [' ' '(' ')' '&' '|' '!' '~' '=' '>' '<' '.' '\\' '0' - '9' 'a' - 'z' 'A' - 'Z'] + let scope = "base" | "one" | "sub" rule lexurl = parse (("ldap" 's'?) as mech) "://" (host as host)? (':' (port as port))? '/'? eof {{url_mech=(match mech with "ldap" -> `PLAIN | "ldaps" -> `SSL | _ -> failwith "invalid mechanism") ; url_host=host; url_port=port; url_dn=None; url_attributes=None; url_scope=None; url_filter=None; url_ext=None}} (* rule lexurl = parse "ldap" {SCHEME} | "://" {COLONSLASHSLASH} | port {PORT (Lexing.lexeme lexbuf)} | host {HOST (Lexing.lexeme lexbuf)} | dn {DN (Lexing.lexeme lexbuf)} | attribute {IDENT (Lexing.lexeme lexbuf)} | scope {SCOPE (Lexing.lexeme lexbuf)} | filter {FILTER (Lexing.lexeme lexbuf)} | ',' {COMMA} | '?' {QUESTION} | '=' {EQUAL} | ':' {COLON} | '!' {CRITICAL} | '/' {SLASH} | ' '* {WHSP} *) ocamldap-2.1.8/ldap_urlparser.cmi0000644000175000017500000000116410444405447016345 0ustar gildorgildorCaml1999I010xo.Ldap_urlparserY%token@@@&SCHEME@/COLONSLASHSLASH@%SLASH@(QUESTION@%EQUAL@%COLON@%COMMA@$WHSP@(CRITICAL@$HOSTC&string@@@@$PORT @@@"DN@@@%IDENT@@@%SCOPE@@@&FILTER&@@@@A@@AZ'ldapurl@ @&LexingA&lexbuf@@򰲐a@@@@&LexingA&lexbuf@@@*Ldap_typesA(ldap_url@@@@@@y@3.Ldap_urlparser0 PMJDE堠&Lexing0AS\6jS (*Pervasives0qE;&XF rt*Ldap_types0wiM1i\tpjf@ocamldap-2.1.8/ldap_urlparser.cmo0000644000175000017500000001366710444405447016366 0ustar gildorgildorCaml1999O006 T')* i8 $58%c(c 8 " ?(c 8 "h(c 8 " ?(c 8 "h(c 8 "(c 8 " ?(c 8 "h(c(c 8 "h(g 8 "k 8 "i 8 "h8 " V C @?(c @?(c 8 "h @?(c 8 "h(d 8 "h 8 "(c 8 "h(d 8 "h 8 "6 ^V5 ^V5 ^V5@[g0Tg^ Tg+?(d 8 "h 8 "h(c 8 "h(d 8 "h 8 " 8!?(d 8 "h 8 "h(c 8 "h(d(c 8 "h(g 8 "l 8 "l 8 "l8 "l8 "l8 "k8 "i8 "h 8 " A@( g 8 "l 8 "l 8 "k8 "i8 "h8 "h A@(d 8 "h 8 " ?(c 8 "h(g 8 "l 8 "l 8 "k8 "j8 "i8 "h8 "   >(c 8 "8 @[5?6]6]6666666l6666 + + + +k +5 + + + + + + + +z+@ +3 +! + + + + + + + + + +y +l +] +V +K> 8  > + ?9 $.Ldap_urlparserP Р@'ParsingAh&parser@@*PervasivesAHp젠0"\%(+̠.䠠14d7:=ؠ@CF4$baseD4caml_string_notequalP#one` l#sub|-invalid scopek𠠑nq,tPwh@+Ldap_filterA|ࠠ8TpĠܠ`|Ƞࠠ$<hȠࠠ(|:Ldap_urlparser.Parse_error@ @@,caml_obj_dup@    @@Ġ̠ < Ԡ <  ܠ    䠠< !01(젠 !(+$%0* 8888,,5,,5,<.   <    #& )$*.'"2%+569=>,/@-B34/78:;<?A  <         ! %   &,)   0185689:>@     FSCHEMECOLONSLASHSLASHSLASHQUESTIONEQUALCOLONCOMMAWHSPCRITICAL $ HOSTPORTDNIDENTSCOPEFILTER ,f ,@nA @&Lexing0AS\6jS (*Pervasives0qE;&XF rt-Ldap_urllexer0ǓJ꛱6}6.Ldap_urlparser0 PMJDE堠+Ldap_filter0-}ӽ;ɕ\92ܠ'Parsing0p6 +R:栠#Obj0t~'*Ldap_types0wiM1i\tpjf@@@@@ocamldap-2.1.8/ldap_urlparser.mli0000644000175000017500000000051210444405447016352 0ustar gildorgildortype token = | SCHEME | COLONSLASHSLASH | SLASH | QUESTION | EQUAL | COLON | COMMA | WHSP | CRITICAL | HOST of (string) | PORT of (string) | DN of (string) | IDENT of (string) | SCOPE of (string) | FILTER of (string) val ldapurl : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Ldap_types.ldap_url ocamldap-2.1.8/ldif_changerec_lexer.mll0000644000175000017500000000364710444405447017466 0ustar gildorgildor(* lexer for extended ldif Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { open Ldif_changerec_parser open Netencoding } let nl = '\n' let whsp = ' ' * let mustsp = ' ' + let alphanum = ['0' - '9' 'a' - 'z' 'A' - 'Z'] let anyprintablechar = ['\t' ' ' - '~'] let attrname = alphanum + let attrval = (anyprintablechar | '\n' ' ') + rule lexcr = parse | "dn:" mustsp ([' ' - '~']+ as dn) nl {Dn dn} | "changetype:" mustsp "modify" nl {Change_type_modify} | "changetype:" mustsp "delete" nl {Change_type_delete} | "changetype:" mustsp "modrdn" nl {Change_type_modrdn} | "changetype:" mustsp "add" nl {Change_type_add} | "add:" mustsp (attrname as name) nl {Add name} | "delete:" mustsp (attrname as name) nl {Delete name} | "replace:" mustsp (attrname as name) nl {Replace name} | (attrname as attr) ':' mustsp (attrval as valu) nl {Attr (attr, valu)} | (attrname as attr) "::" mustsp (attrval as valu) nl {Attr (attr, Base64.decode valu)} | '-' nl {Dash} | nl + {Newline} | eof {End_of_input} ocamldap-2.1.8/ldif_changerec_oo.ml0000644000175000017500000000625210444405447016603 0ustar gildorgildor(* create an ldap changerec factory from a channel attached to an ldif changerec source default is stdin and stdout. Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_ooclient open Ldif_changerec_parser open Ldif_changerec_lexer exception Invalid_changerec of string exception End_of_changerecs let iter f cr = try while true do f cr#read_changerec done with End_of_changerecs -> () let rec fold f cr a = try fold f cr (f a cr#read_changerec) with End_of_changerecs -> a let insert_change buf cr = match cr with `Modification (dn, mod_op) -> Buffer.add_string buf ("dn: " ^ dn ^ "\n"); Buffer.add_string buf "changetype: modify\n"; List.iter (fun (op, attr, vals) -> (match op with `ADD -> Buffer.add_string buf ("add: " ^ attr ^ "\n") | `DELETE -> Buffer.add_string buf ("delete: " ^ attr ^ "\n") | `REPLACE -> Buffer.add_string buf ("replace: " ^ attr ^ "\n")); List.iter (fun valu -> Buffer.add_string buf (attr ^ ": " ^ valu ^ "\n")) vals; Buffer.add_string buf "-\n") mod_op; Buffer.add_string buf "\n"; buf | `Addition e -> Ldif_oo.entry2ldif ~ext:true buf e; | `Delete dn -> Buffer.add_string buf ("dn: " ^ dn ^ "\n"); Buffer.add_string buf "changetype: delete\n"; buf | `Modrdn (dn, deleteoldrdn, newrdn) -> Buffer.add_string buf ("dn: " ^ dn ^ "\n"); Buffer.add_string buf "changetype: modrdn\n"; Buffer.add_string buf ("deleteoldrdn: " ^ (string_of_int deleteoldrdn) ^ "\n"); Buffer.add_string buf ("newrdn: " ^ newrdn ^ "\n"); buf class change ?(in_ch=stdin) ?(out_ch=stdout) () = object (self) val lxbuf = Lexing.from_channel in_ch val buf = Buffer.create 1 method read_changerec = try changerec lexcr lxbuf with Failure "end" -> raise End_of_changerecs | Failure s -> raise (Invalid_changerec s) method of_string (s:string) = let lx = Lexing.from_string s in try changerec lexcr lx with Failure "end" -> raise End_of_changerecs | Failure s -> raise (Invalid_changerec s) method to_string (e:changerec) = let res = Buffer.contents (insert_change buf e) in Buffer.clear buf;res method write_changerec (e:changerec) = ignore (insert_change buf e); Buffer.output_buffer out_ch buf; Buffer.clear buf end ocamldap-2.1.8/ldif_changerec_oo.mli0000644000175000017500000000376710444405447016764 0ustar gildorgildor(* create an ldap entry factory from a channel attached to an ldif source default is stdin and stdout. Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** an object oriented interface to the ldif parser *) (** an exception raised when there is a parse error *) exception Invalid_changerec of string (** raised at the end of the change records *) exception End_of_changerecs (** Ldif_changerec.iter f change, iterate accross all change entries in the specified change object, applying f to each one *) val iter : ('a -> unit) -> < read_changerec : 'a; .. > -> unit (** Ldif_changerec.fold f change value, for each change entry en in the change object fold computes f (... (f (f value e1) e2) ...) en *) val fold : ('a -> 'b -> 'a) -> < read_changerec : 'b; .. > -> 'a -> 'a class change: ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object method read_changerec: Ldap_ooclient.changerec method of_string: string -> Ldap_ooclient.changerec method to_string: Ldap_ooclient.changerec -> string method write_changerec: Ldap_ooclient.changerec -> unit end ocamldap-2.1.8/ldif_changerec_parser.mly0000644000175000017500000000560110444405447017650 0ustar gildorgildor/* a parser for extended ldif Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ %{ open Ldap_ooclient let check_attrs attr attrs = List.rev_map (fun (declared_attr, valu) -> if declared_attr = attr then valu else failwith ("declared attribute " ^ "modifies the wrong" ^ "attribute, " ^ "attribute: " ^ attr ^ "declared: " ^ declared_attr)) attrs let check_empty op attr = match op with `DELETE -> (op, attr, []) | `ADD -> failwith "non sensical empty add" | `REPLACE -> failwith "non sensical empty replace" %} %token End_of_input Change_type_add Change_type_modrdn %token Change_type_modify Change_type_delete Dash Newline %token AttributeType Dn Add Delete Replace %token Attr %type changerec %start changerec %% operation: Add {(`ADD, $1)} | Delete {(`DELETE, $1)} | Replace {(`REPLACE, $1)} ; attrlst: Attr attrlst {$1 :: $2} | Attr {[$1]} newline: Newline {} | End_of_input {} modificationterminator: Dash newline {} | newline {} ; modifications: operation attrlst Dash modifications {let (op, attr) = $1 in (op, attr, check_attrs attr $2) :: $4} | operation Dash modifications {let (op, attr) = $1 in (check_empty op attr) :: $3} | operation attrlst modificationterminator {let (op, attr) = $1 in [(op, attr, check_attrs attr $2)]} | operation modificationterminator {let (op, attr) = $1 in [(check_empty op attr)]} ; entry: Attr entry {let (a, v) = $1 in (a, [v]) :: $2} | Attr newline {let (a, v) = $1 in [(a, [v])]} changerec: Dn Change_type_modify modifications {`Modification ($1, List.rev $3)} | Dn Change_type_add entry {let e = new ldapentry in e#set_dn $1;e#add $3;`Addition e} | Dn Change_type_delete newline {`Delete $1} | Dn Change_type_modrdn Attr Attr newline {`Modrdn ($1, int_of_string (snd $3), snd $4)} | End_of_input {failwith "end"} ; ocamldap-2.1.8/ldif_oo.ml0000644000175000017500000000754510444405447014612 0ustar gildorgildor(* An object oriented interface for parsing Lightweight Directory Interchange Format file Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Str open Netencoding open Ldap_ooclient open Ldif_parser open Ldap_types let safe_string_regex = Str.regexp "^[\x01-\x09\x0b-\x0c\x0e-\x7f]+$" let password_regex = Str.regexp_case_fold ".*p\\(ass\\)?w\\(or\\)?d$" let empty_regex = Str.regexp "^ *$\\|^ *.*$" let safe_val buf s = if (Str.string_match safe_string_regex s 0) && (not (Str.string_match empty_regex s 0)) then begin Buffer.add_string buf ": "; Buffer.add_string buf s end else begin Buffer.add_string buf ":: "; Buffer.add_string buf (Base64.encode s) end let safe_attr_val buf a v = if Str.string_match password_regex a 0 then begin Buffer.add_string buf a; Buffer.add_string buf ":: "; Buffer.add_string buf (Base64.encode v) end else begin Buffer.add_string buf a; safe_val buf v end let entry2ldif ?(ext=false) outbuf e = Buffer.add_string outbuf "dn"; safe_val outbuf e#dn; if ext then Buffer.add_string outbuf "\nchangetype: add"; Buffer.add_char outbuf '\n'; (List.iter (fun attr -> (List.iter (fun value -> safe_attr_val outbuf attr value; Buffer.add_char outbuf '\n') (e#get_value attr))) e#attributes); Buffer.add_char outbuf '\n'; outbuf let iter (f: ('a -> unit)) ldif = try while true do f ldif#read_entry done with End -> () let fold f ldif v = let objects = let objects = ref [] in try while true do objects := (ldif#read_entry) :: !objects done; !objects with End -> !objects in List.fold_left f v objects class ldif ?(in_ch=stdin) ?(out_ch=stdout) () = object (self) val in_ch = {stream=(Stream.of_channel in_ch);buf=Buffer.create 256;line=1} val out_ch = out_ch val outbuf = Buffer.create 50 method read_entry = Ldap_ooclient.to_entry (`Entry (ldif_attrval_record in_ch)) method of_string s = let strm = {stream=(Stream.of_string s);buf=Buffer.create 256;line=1} in Ldap_ooclient.to_entry (`Entry (ldif_attrval_record strm)) method to_string (e:ldapentry_t) = try let contents = Buffer.contents (entry2ldif outbuf e) in Buffer.clear outbuf; contents with exn -> Buffer.clear outbuf; raise exn method write_entry (e:ldapentry_t) = try Buffer.output_buffer out_ch (entry2ldif outbuf e); Buffer.clear outbuf with exn -> Buffer.clear outbuf; raise exn end let read_ldif_file file = let fd = open_in file in try let ldif = new ldif ~in_ch:fd () in let entries = fold (fun l e -> e :: l) ldif [] in close_in fd; entries with exn -> close_in fd;raise exn let write_ldif_file file entries = let fd = open_out file in try let ldif = new ldif ~out_ch:fd () in List.iter ldif#write_entry entries; close_out fd with exn -> close_out fd;raise exn ocamldap-2.1.8/ldif_oo.mli0000644000175000017500000000472010444405447014753 0ustar gildorgildor(* create an ldap entry factory from a channel attached to an ldif source default is stdin and stdout. Copyright (C) 2004 Eric Stokes, Matthew Backes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** an object oriented interface to the ldif parser *) (** Ldif_oo.iter f ldif, iterate accross all ldif entries in the specified ldif object, applying f to each one *) val iter : ('a -> unit) -> < read_entry : 'a; .. > -> unit (** Ldif_oo.fold f ldif value, for each ldif entry en in the ldif object fold computes f (... (f (f value e1) e2) ...) en *) val fold : ('a -> 'b -> 'a) -> < read_entry : 'b; .. > -> 'a -> 'a (** if you need a fast, low level interface to to_string, this function will write ldif directly into a buffer. Setting ext to true (defaul false) will write extended ldif. Extended ldif should be parsed using the Ldif_changerec_oo module. *) val entry2ldif : ?ext:bool -> Buffer.t -> < attributes : string list; dn : string; get_value : string -> string list; .. > -> Buffer.t (** read all the entries in the named ldif file and return them in a list *) val read_ldif_file : string -> Ldap_ooclient.ldapentry list (** write all the entries in the given list to the named file in ldif format *) val write_ldif_file : string -> Ldap_ooclient.ldapentry list -> unit class ldif: ?in_ch:Pervasives.in_channel -> ?out_ch:Pervasives.out_channel -> unit -> object method read_entry: Ldap_ooclient.ldapentry method of_string: string -> Ldap_ooclient.ldapentry method to_string: Ldap_ooclient.ldapentry -> string method write_entry: Ldap_ooclient.ldapentry -> unit end ocamldap-2.1.8/ldif_parser.ml0000644000175000017500000001540310444405447015461 0ustar gildorgildor(* A lexer and parser for ldif format files Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Netencoding exception Illegal_char of char * int exception End type stream_rec = {stream: char Stream.t;buf:Buffer.t;mutable line: int} let optval o = match o with Some(c) -> c | None -> raise End let rec read_comment s = let check_next s = match (optval (Stream.peek s.stream)) with ' ' | '#' -> (Stream.junk s.stream);read_comment s (* line folded, or another comment *) | _ -> () in match (optval (Stream.peek s.stream)) with '\n' -> (Stream.junk s.stream);s.line <- s.line + 1;check_next s | '\r' -> (Stream.junk s.stream);(Stream.junk s.stream); s.line <- s.line + 1;check_next s | _ -> (Stream.junk s.stream);read_comment s let comment s = match (optval (Stream.peek s.stream)) with '#' -> (Stream.junk s.stream);read_comment s | _ -> () let sep s = match (optval (Stream.peek s.stream)) with '\n' -> (Stream.junk s.stream);s.line <- s.line + 1;"\n" | '\r' -> (Stream.junk s.stream);(Stream.junk s.stream);s.line <- s.line + 1;"\n" | c -> raise (Illegal_char (c,s.line));; let seps s = try (while true do ignore (sep s) done) with Illegal_char(_,_) -> ();; let digit s = match (optval (Stream.peek s.stream)) with '0'..'9' -> (Stream.next s.stream) | c -> raise (Illegal_char (c,s.line));; let safe_char s = match (optval (Stream.peek s.stream)) with ' '..'~' -> (Stream.next s.stream) | c -> raise (Illegal_char (c,s.line));; let safe_init_char s = match (optval (Stream.peek s.stream)) with '!'..'9'|';'..'~' -> (Stream.next s.stream) | c -> raise (Illegal_char (c,s.line));; let alpha s = match (optval (Stream.peek s.stream)) with 'a'..'z'|'A'..'Z' -> (Stream.next s.stream) | c -> raise (Illegal_char (c,s.line));; let safe_chars s = let rec do_safe_chars s = try while true do Buffer.add_char s.buf (safe_char s) done with Illegal_char('\n',_) -> (match (Stream.npeek 2 s.stream) with ['\n';' '] -> (Stream.junk s.stream);(Stream.junk s.stream); s.line <- s.line + 1; (do_safe_chars s) | _ -> ()) | Illegal_char('\r',_) -> (match (Stream.npeek 3 s.stream) with ['\r';'\n';' '] -> (Stream.junk s.stream);(Stream.junk s.stream);(Stream.junk s.stream); s.line <- s.line + 1; (do_safe_chars s) | _ -> ()) | Illegal_char(_,_) -> () | End -> () in do_safe_chars s;; let safe_string s = Buffer.clear s.buf; Buffer.add_char s.buf (safe_init_char s); safe_chars s; Buffer.contents s.buf;; let attr_type_char s = match (optval (Stream.peek s.stream)) with 'A'..'Z'|'a'..'z'|'0'..'9'|'-' -> (Stream.next s.stream) | c -> raise (Illegal_char (c, s.line));; let attr_type_chars s = try while true do Buffer.add_char s.buf (attr_type_char s) done; with Illegal_char(_,_) -> () let option s = Buffer.clear s.buf; Buffer.add_char s.buf (attr_type_char s); attr_type_chars s; Buffer.contents s.buf;; let rec options s = match (optval (Stream.peek s.stream)) with ';' -> let thisone = (Stream.junk s.stream);(option s) in thisone ^ (options s) | ':' -> "" | c -> raise (Illegal_char (c, s.line));; (* syntax error *) let attributeType s = Buffer.clear s.buf; Buffer.add_char s.buf (alpha s); attr_type_chars s; Buffer.contents s.buf;; let attributeDescription s = let name = (attributeType s) in let options = (match (optval (Stream.peek s.stream)) with ';' -> options s (* there are options *) | _ -> "") in let colon = (match (optval (Stream.peek s.stream)) with ':' -> (Stream.junk s.stream);"" | _ -> failwith "Parse, error. Missing colon in attribute spec") in name let value_spec s = match (optval (Stream.peek s.stream)) with ':' -> (Stream.junk s.stream); (match (optval (Stream.peek s.stream)) with ' ' -> (Stream.junk s.stream); (Base64.decode (safe_string s)) | c -> raise (Illegal_char (c, s.line))) | '<' -> (Stream.junk s.stream);(match (optval (Stream.peek s.stream)) with ' ' -> (Stream.junk s.stream);(safe_string s) (* a url *) | c -> raise (Illegal_char (c, s.line))) | ' ' -> (Stream.junk s.stream);(safe_string s) | c -> raise (Illegal_char (c, s.line)) let rec attrval_spec ?(attrs=[]) s = let lc = String.lowercase in try ignore (sep s);attrs with Illegal_char(_,_) -> let attr = (attributeDescription s) in let valu = (value_spec s) in let sep = (sep s) in (try let {attr_type=name;attr_vals=vals} = List.hd attrs in if (lc attr) = (lc name) then attrval_spec ~attrs:({attr_type=name; attr_vals=(valu :: vals)} :: (List.tl attrs)) s else attrval_spec ~attrs:({attr_type=attr;attr_vals=[valu]} :: attrs) s with Failure "hd" -> attrval_spec ~attrs:[{attr_type=attr;attr_vals=[valu]}] s) | End -> attrs let distinguishedName s = match (optval (Stream.peek s.stream)) with ':' -> (Stream.junk s.stream); (match (optval (Stream.peek s.stream)) with ' ' -> (Stream.junk s.stream); (Base64.decode (safe_string s)) | c -> raise (Illegal_char (c, s.line))) | ' ' -> (Stream.junk s.stream);safe_string s | c -> raise (Illegal_char (c, s.line)) let dn_spec s = match (Stream.npeek 3 s.stream) with ['d';'n';':'] -> (Stream.junk s.stream); (Stream.junk s.stream); (Stream.junk s.stream); (distinguishedName s) | _ -> failwith ("invalid dn on line: " ^ (string_of_int s.line)) let ldif_attrval_record s = let _ = comment s in let _ = seps s in let dn = dn_spec s in let _ = try seps s with End -> () in (* just a dn is a valid ldif file *) let attrs = attrval_spec s in {sr_dn=dn;sr_attributes=attrs} ocamldap-2.1.8/Makefile0000644000175000017500000000266410444405447014302 0ustar gildorgildor-include Makefile.conf SOURCES=lber.mli lber.ml ldap_types.mli ldap_types.ml ldap_error.mli \ ldap_error.ml ldap_protocol.mli ldap_protocol.ml ulist.ml \ ldap_urllexer.mll ldap_url.mli ldap_url.ml ldap_filterparser.mly \ ldap_filterlexer.mll ldap_filter.mli ldap_filter.ml ldap_funclient.mli \ ldap_funclient.ml ldap_schemalexer.mll ldap_schemaparser.mli \ ldap_schemaparser.ml ldap_dnparser.mly ldap_dnlexer.mll ldap_dn.mli \ ldap_dn.ml ldap_ooclient.mli ldap_ooclient.ml ldap_mutex.mli \ ldap_mutex.ml ldap_txooclient.mli ldap_txooclient.ml ldif_parser.ml \ ldif_oo.ml ldif_oo.mli ldap_funserver.mli ldap_funserver.ml \ ldif_changerec_parser.mly ldif_changerec_lexer.mll \ ldif_changerec_oo.mli ldif_changerec_oo.ml ldap_toplevel.ml RESULT=ocamldap PACKS=netstring str ssl #OCAMLFLAGS=-rectypes LIBINSTALL_FILES=$(wildcard *.mli *.cmi *.cma *.cmxa *.a *.so *.o *.cmx ldap_toplevel.cmo) OCAMLDOCFLAGS=-colorize-code all: debug-code-library opt: native-code-library reallyall: byte-code-library native-code-library install: libinstall uninstall: libuninstall documentation: ocamlfind ocamldoc -d doc/ocamldap/html -colorize-code -html -package netstring,str,ssl lber.mli ldap_types.mli ldap_error.mli ldap_protocol.mli ldap_url.mli ldap_filter.mli ldap_dn.mli ldap_funclient.mli ldap_ooclient.mli ldap_schemaparser.mli ldap_funserver.mli ldif_oo.mli ldap_toplevel.mli ldap_mutex.mli ldif_changerec_oo.mli ldap_txooclient.mli -include OCamlMakefile ocamldap-2.1.8/META0000644000175000017500000000015210444405447013301 0ustar gildorgildorrequires="netstring str ssl" version="2.1.5" archive(byte)="ocamldap.cma" archive(native)="ocamldap.cmxa" ocamldap-2.1.8/mutex.schema0000644000175000017500000000165210444405447015162 0ustar gildorgildor# symas:10 attributes # symas:11 objectclasses attributetype ( 1.3.6.1.4.1.4754.10.37 NAME 'mutexLocked' EQUALITY caseIgnoreMatch ORDERING caseIgnoreOrderingMatch SUBSTR caseIgnoreSubstringsMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.15{512} SINGLE-VALUE ) # used to implement object locking tables # in the case of a modify rdn operation alternative # locking mechanisms should be used. attributetype ( 1.3.6.1.4.1.4754.10.39 NAME 'lockedObject' EQUALITY distinguishedNameMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.12{512} ) attributetype ( 1.3.6.1.4.1.4754.10.38 NAME 'mutexName' EQUALITY caseIgnoreMatch ORDERING caseIgnoreOrderingMatch SUBSTR caseIgnoreSubstringsMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.15{512} SINGLE-VALUE ) objectclass (1.3.6.1.4.1.4754.11.4 NAME 'mutex' SUP top STRUCTURAL MAY ( mutexName $ description $ lockedObject $ mutexLocked ) ) ocamldap-2.1.8/OCamlMakefile0000644000175000017500000007120210444405447015210 0ustar gildorgildor########################################################################### # OCamlMakefile # Copyright (C) 1999-2004 Markus Mottl # # For updates see: # http://www.oefai.at/~markus/ocaml_sources # # $Id: OCamlMakefile 272 2005-10-19 00:53:46Z $ # ########################################################################### # Modified by damien for .glade.ml compilation # Set these variables to the names of the sources to be processed and # the result variable. Order matters during linkage! ifndef SOURCES SOURCES := foo.ml endif export SOURCES ifndef RES_CLIB_SUF RES_CLIB_SUF := _stubs endif export RES_CLIB_SUF ifndef RESULT RESULT := foo endif export RESULT export LIB_PACK_NAME ifndef DOC_FILES DOC_FILES := $(filter %.mli, $(SOURCES)) endif export DOC_FILES export BCSUFFIX export NCSUFFIX ifndef TOPSUFFIX TOPSUFFIX := .top endif export TOPSUFFIX # Eventually set include- and library-paths, libraries to link, # additional compilation-, link- and ocamlyacc-flags # Path- and library information needs not be written with "-I" and such... # Define THREADS if you need it, otherwise leave it unset (same for # USE_CAMLP4)! export THREADS export VMTHREADS export ANNOTATE export USE_CAMLP4 export INCDIRS export LIBDIRS export EXTLIBDIRS export RESULTDEPS export OCAML_DEFAULT_DIRS export LIBS export CLIBS export OCAMLFLAGS export OCAMLNCFLAGS export OCAMLBCFLAGS export OCAMLLDFLAGS export OCAMLNLDFLAGS export OCAMLBLDFLAGS ifndef OCAMLCPFLAGS OCAMLCPFLAGS := a endif export OCAMLCPFLAGS export PPFLAGS export YFLAGS export IDLFLAGS export OCAMLDOCFLAGS export OCAMLFIND_INSTFLAGS export DVIPSFLAGS export STATIC # Add a list of optional trash files that should be deleted by "make clean" export TRASH #################### variables depending on your OCaml-installation ifdef MINGW export MINGW WIN32 := 1 CFLAGS_WIN32 := -mno-cygwin endif ifdef MSVC export MSVC WIN32 := 1 ifndef STATIC CFLAGS_WIN32 := -DCAML_DLL endif CFLAGS_WIN32 += -nologo EXT_OBJ := obj EXT_LIB := lib ifeq ($(CC),gcc) # work around GNU Make default value ifdef THREADS CC := cl -MT else CC := cl endif endif ifeq ($(CXX),g++) # work around GNU Make default value CXX := $(CC) endif CFLAG_O := -Fo endif ifdef WIN32 EXT_CXX := cpp EXE := .exe endif ifndef EXT_OBJ EXT_OBJ := o endif ifndef EXT_LIB EXT_LIB := a endif ifndef EXT_CXX EXT_CXX := cc endif ifndef EXE EXE := # empty endif ifndef CFLAG_O CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! endif export CC export CXX export CFLAGS export CXXFLAGS export LDFLAGS ifndef RPATH_FLAG RPATH_FLAG := -R endif export RPATH_FLAG ifndef MSVC ifndef PIC_FLAGS PIC_FLAGS := -fPIC -DPIC endif endif export PIC_FLAGS BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) ifndef OCAMLFIND OCAMLFIND := ocamlfind endif export OCAMLFIND ifndef OCAMLC OCAMLC := ocamlc endif export OCAMLC ifndef OCAMLOPT OCAMLOPT := ocamlopt endif export OCAMLOPT ifndef OCAMLMKTOP OCAMLMKTOP := ocamlmktop endif export OCAMLMKTOP ifndef OCAMLCP OCAMLCP := ocamlcp endif export OCAMLCP ifndef OCAMLDEP OCAMLDEP := ocamldep endif export OCAMLDEP ifndef OCAMLLEX OCAMLLEX := ocamllex endif export OCAMLLEX ifndef OCAMLYACC OCAMLYACC := ocamlyacc endif export OCAMLYACC ifndef OCAMLMKLIB OCAMLMKLIB := ocamlmklib endif export OCAMLMKLIB ifndef OCAML_GLADECC OCAML_GLADECC := lablgladecc2 endif export OCAML_GLADECC ifndef OCAML_GLADECC_FLAGS OCAML_GLADECC_FLAGS := endif export OCAML_GLADECC_FLAGS ifndef CAMELEON_REPORT CAMELEON_REPORT := report endif export CAMELEON_REPORT ifndef CAMELEON_REPORT_FLAGS CAMELEON_REPORT_FLAGS := endif export CAMELEON_REPORT_FLAGS ifndef CAMELEON_ZOGGY CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo endif export CAMELEON_ZOGGY ifndef CAMELEON_ZOGGY_FLAGS CAMELEON_ZOGGY_FLAGS := endif export CAMELEON_ZOGGY_FLAGS ifndef OXRIDL OXRIDL := oxridl endif export OXRIDL ifndef CAMLIDL CAMLIDL := camlidl endif export CAMLIDL ifndef CAMLIDLDLL CAMLIDLDLL := camlidldll endif export CAMLIDLDLL ifndef NOIDLHEADER MAYBE_IDL_HEADER := -header endif export NOIDLHEADER export NO_CUSTOM ifndef CAMLP4 CAMLP4 := camlp4 endif export CAMLP4 ifdef PACKS empty := space := $(empty) $(empty) comma := , ifdef PREDS PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) else OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) OCAML_DEP_PACKAGES := endif OCAML_FIND_LINKPKG := -linkpkg REAL_OCAMLFIND := $(OCAMLFIND) endif export OCAML_FIND_PACKAGES export OCAML_DEP_PACKAGES export OCAML_FIND_LINKPKG export REAL_OCAMLFIND ifndef OCAMLDOC OCAMLDOC := ocamldoc endif export OCAMLDOC ifndef LATEX LATEX := latex endif export LATEX ifndef DVIPS DVIPS := dvips endif export DVIPS ifndef PS2PDF PS2PDF := ps2pdf endif export PS2PDF ifndef OCAMLMAKEFILE OCAMLMAKEFILE := OCamlMakefile endif export OCAMLMAKEFILE ifndef OCAMLLIBPATH OCAMLLIBPATH := \ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) endif export OCAMLLIBPATH ifndef OCAML_LIB_INSTALL OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib endif export OCAML_LIB_INSTALL ########################################################################### #################### change following sections only if #################### you know what you are doing! # delete target files when a build command fails .PHONY: .DELETE_ON_ERROR .DELETE_ON_ERROR: # for pedants using "--warn-undefined-variables" export MAYBE_IDL export REAL_RESULT export CAMLIDLFLAGS export THREAD_FLAG export RES_CLIB export MAKEDLL export ANNOT_FLAG export C_OXRIDL export SUBPROJS export CFLAGS_WIN32 INCFLAGS := SHELL := /bin/sh MLDEPDIR := ._d BCDIDIR := ._bcdi NCDIDIR := ._ncdi FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) FILTERED_REP := $(filter %.rep, $(FILTERED)) DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) AUTO_REP := $(FILTERED_REP:.rep=.ml) FILTERED_ZOG := $(filter %.zog, $(FILTERED)) DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) FILTERED_GLADE := $(filter %.glade, $(FILTERED)) DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) FILTERED_ML := $(filter %.ml, $(FILTERED)) DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) FILTERED_MLI := $(filter %.mli, $(FILTERED)) DEP_MLI := $(FILTERED_MLI:.mli=.di) FILTERED_MLL := $(filter %.mll, $(FILTERED)) DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) AUTO_MLL := $(FILTERED_MLL:.mll=.ml) FILTERED_MLY := $(filter %.mly, $(FILTERED)) DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) FILTERED_IDL := $(filter %.idl, $(FILTERED)) DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) ifndef NOIDLHEADER C_IDL += $(FILTERED_IDL:.idl=.h) endif OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) MLDEPS := $(filter %.d, $(ALL_DEPS)) MLIDEPS := $(filter %.di, $(ALL_DEPS)) BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) IMPLO_INTF := $(ALLML:%.mli=%.mli.__) IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ $(basename $(file)).cmi $(basename $(file)).cmo) IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) INTF := $(filter %.cmi, $(IMPLO_INTF)) IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) IMPL_ASM := $(IMPL_CMO:.cmo=.asm) IMPL_S := $(IMPL_CMO:.cmo=.s) OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) EXECS := $(addsuffix $(EXE), \ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) ifdef WIN32 EXECS += $(BCRESULT).dll $(NCRESULT).dll endif CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) ifneq ($(strip $(OBJ_LINK)),) RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) endif ifdef WIN32 DLLSONAME := $(CLIB_BASE).dll else DLLSONAME := dll$(CLIB_BASE).so endif NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o ifndef STATIC NONEXECS += $(DLLSONAME) endif ifndef LIBINSTALL_FILES LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) ifndef STATIC ifneq ($(strip $(OBJ_LINK)),) LIBINSTALL_FILES += $(DLLSONAME) endif endif endif export LIBINSTALL_FILES ifdef WIN32 # some extra stuff is created while linking DLLs NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib endif TARGETS := $(EXECS) $(NONEXECS) # If there are IDL-files ifneq ($(strip $(FILTERED_IDL)),) MAYBE_IDL := -cclib -lcamlidl endif ifdef USE_CAMLP4 CAMLP4PATH := \ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) INCFLAGS := -I $(CAMLP4PATH) CINCFLAGS := -I$(CAMLP4PATH) endif DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %) CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) ifndef MSVC CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \ $(OCAML_DEFAULT_DIRS:%=-L%) endif ifndef PROFILING INTF_OCAMLC := $(OCAMLC) else ifndef THREADS INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) else # OCaml does not support profiling byte code # with threads (yet), therefore we force an error. ifndef REAL_OCAMLC $(error Profiling of multithreaded byte code not yet supported by OCaml) endif INTF_OCAMLC := $(OCAMLC) endif endif ifndef MSVC COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \ $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) else COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " endif CLIBS_OPTS := $(CLIBS:%=-cclib -l%) ifdef MSVC ifndef STATIC # MSVC libraries do not have 'lib' prefix CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) endif endif ifneq ($(strip $(OBJ_LINK)),) ifdef CREATE_LIB OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) else OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) endif else OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) endif # If we have to make byte-code ifndef REAL_OCAMLC BYTE_OCAML := y # EXTRADEPS is added dependencies we have to insert for all # executable files we generate. Ideally it should be all of the # libraries we use, but it's hard to find the ones that get searched on # the path since I don't know the paths built into the compiler, so # just include the ones with slashes in their names. EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) REAL_OCAMLC := $(INTF_OCAMLC) REAL_IMPL := $(IMPL_CMO) REAL_IMPL_INTF := $(IMPLO_INTF) IMPL_SUF := .cmo DEPFLAGS := MAKE_DEPS := $(MLDEPS) $(BCDEPIS) ifdef CREATE_LIB CFLAGS := $(PIC_FLAGS) $(CFLAGS) ifndef STATIC ifneq ($(strip $(OBJ_LINK)),) MAKEDLL := $(DLLSONAME) ALL_LDFLAGS := -dllib $(DLLSONAME) endif endif endif ifndef NO_CUSTOM ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" ALL_LDFLAGS += -custom endif endif ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ $(COMMON_LDFLAGS) $(LIBS:%=%.cma) CAMLIDLDLLFLAGS := ifdef THREADS ifdef VMTHREADS THREAD_FLAG := -vmthread else THREAD_FLAG := -thread endif ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) ifndef CREATE_LIB ifndef REAL_OCAMLFIND ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) endif endif endif # we have to make native-code else EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) ifndef PROFILING SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) PLDFLAGS := else SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) PLDFLAGS := -p endif REAL_IMPL := $(IMPL_CMX) REAL_IMPL_INTF := $(IMPLX_INTF) IMPL_SUF := .cmx CFLAGS := -DNATIVE_CODE $(CFLAGS) DEPFLAGS := -native MAKE_DEPS := $(MLDEPS) $(NCDEPIS) ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) CAMLIDLDLLFLAGS := -opt ifndef CREATE_LIB ALL_LDFLAGS += $(LIBS:%=%.cmxa) else CFLAGS := $(PIC_FLAGS) $(CFLAGS) endif ifdef THREADS THREAD_FLAG := -thread ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) ifndef CREATE_LIB ifndef REAL_OCAMLFIND ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) endif endif endif endif export MAKE_DEPS ifdef ANNOTATE ANNOT_FLAG := -dtypes else endif ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) ifdef make_deps -include $(MAKE_DEPS) PRE_TARGETS := endif ########################################################################### # USER RULES # Call "OCamlMakefile QUIET=" to get rid of all of the @'s. QUIET=@ # generates byte-code (default) byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes bc: byte-code byte-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(BCRESULT)" make_deps=yes bcnl: byte-code-nolink top: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes # generates native-code native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes nc: native-code native-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncnl: native-code-nolink # generates byte-code libraries byte-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" \ CREATE_LIB=yes \ make_deps=yes bcl: byte-code-library # generates native-code libraries native-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes ncl: native-code-library ifdef WIN32 # generates byte-code dll byte-code-dll: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).dll \ REAL_RESULT="$(BCRESULT)" \ make_deps=yes bcd: byte-code-dll # generates native-code dll native-code-dll: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).dll \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncd: native-code-dll endif # generates byte-code with debugging information debug-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dc: debug-code debug-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dcnl: debug-code-nolink # generates byte-code libraries with debugging information debug-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ CREATE_LIB=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dcl: debug-code-library # generates byte-code for profiling profiling-byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ make_deps=yes pbc: profiling-byte-code # generates native-code profiling-native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ PROFILING="y" \ make_deps=yes pnc: profiling-native-code # generates byte-code libraries profiling-byte-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ CREATE_LIB=yes \ make_deps=yes pbcl: profiling-byte-code-library # generates native-code libraries profiling-native-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" PROFILING="y" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes pncl: profiling-native-code-library # packs byte-code objects pack-byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ REAL_RESULT="$(BCRESULT)" \ PACK_LIB=yes make_deps=yes pabc: pack-byte-code # packs native-code objects pack-native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(NCRESULT).cmx $(NCRESULT).o \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ PACK_LIB=yes make_deps=yes panc: pack-native-code # generates HTML-documentation htdoc: doc/$(RESULT)/html # generates Latex-documentation ladoc: doc/$(RESULT)/latex # generates PostScript-documentation psdoc: doc/$(RESULT)/latex/doc.ps # generates PDF-documentation pdfdoc: doc/$(RESULT)/latex/doc.pdf # generates all supported forms of documentation doc: htdoc ladoc psdoc pdfdoc ########################################################################### # LOW LEVEL RULES $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) ifdef WIN32 $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ -o $@ $(REAL_IMPL) endif %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \ .rep .zog .glade ifndef STATIC ifdef MINGW $(DLLSONAME): $(OBJ_LINK) $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ $(OCAMLLIBPATH)/ocamlrun.a \ -Wl,--export-all-symbols \ -Wl,--no-whole-archive else ifdef MSVC $(DLLSONAME): $(OBJ_LINK) link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ $(OCAMLLIBPATH)/ocamlrun.lib else $(DLLSONAME): $(OBJ_LINK) $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ $(OCAMLMKLIB_FLAGS) endif endif endif ifndef LIB_PACK_NAME $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) else ifdef BYTE_OCAML $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL) else $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL) endif $(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx endif $(RES_CLIB): $(OBJ_LINK) ifndef MSVC ifneq ($(strip $(OBJ_LINK)),) $(AR) rcs $@ $(OBJ_LINK) endif else ifneq ($(strip $(OBJ_LINK)),) lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) endif endif .mli.cmi: $(EXTRADEPS) $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ else \ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ fi .ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(ALL_OCAMLCFLAGS) $<; \ else \ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ fi ifdef PACK_LIB $(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(REAL_IMPL) endif .PRECIOUS: %.ml %.ml: %.mll $(OCAMLLEX) $< .PRECIOUS: %.ml %.mli %.ml %.mli: %.mly $(OCAMLYACC) $(YFLAGS) $< .PRECIOUS: %.ml %.ml: %.rep $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< .PRECIOUS: %.ml %.ml: %.zog $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ .PRECIOUS: %.ml %.ml: %.glade $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ .PRECIOUS: %.ml %.mli %.ml %.mli: %.oxridl $(OXRIDL) $< .PRECIOUS: %.ml %.mli %_stubs.c %.h %.ml %.mli %_stubs.c %.h: %.idl $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ $(CAMLIDLFLAGS) $< $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi .c.$(EXT_OBJ): $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< .$(EXT_CXX).$(EXT_OBJ): $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I'$(OCAMLLIBPATH)' \ $< $(CFLAG_O)$@ $(MLDEPDIR)/%.d: %.ml $(QUIET)echo making $@ from $< $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ $(DINCFLAGS) $< > $@; \ else \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ fi $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli $(QUIET)echo making $@ from $< $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ else \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ fi doc/$(RESULT)/html: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ else \ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES); \ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES); \ fi doc/$(RESULT)/latex: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \ $(DOC_FILES) -o $@/doc.tex; \ $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \ -o $@/doc.tex; \ else \ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ fi doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex cd doc/$(RESULT)/latex && \ $(LATEX) doc.tex && \ $(LATEX) doc.tex && \ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps cd doc/$(RESULT)/latex && $(PS2PDF) $( Buffer.add_string ldif_buffer "dn: "; Buffer.add_string ldif_buffer dn; Buffer.add_string ldif_buffer "\n"; List.iter (fun {attr_type=name;attr_vals=vals} -> List.iter (fun aval -> Buffer.add_string ldif_buffer name; Buffer.add_string ldif_buffer ": "; Buffer.add_string ldif_buffer aval; Buffer.add_string ldif_buffer "\n") vals) attrs; Buffer.add_string ldif_buffer "\n"; Buffer.output_buffer stdout ldif_buffer; Buffer.clear ldif_buffer | `Referral f -> () let main () = let usg = "test -H -D -w -b " in let host = ref "" in let port = ref 389 in let binddn = ref "" in let cred = ref "" in let base = ref "" in let filter = ref "" in let set_host x = host := x in let set_port x = port := x in let set_binddn x = binddn := x in let set_cred x = cred := x in let set_base x = base := x in let set_filter x = filter := x in let spec = [("-H", String(set_host), "host"); ("-D", String(set_binddn), "dn to bind with"); ("-w", String(set_cred), "password to use when binding"); ("-b", String(set_base), "search base")] in if (Array.length Sys.argv) > 9 then (parse spec set_filter usg; let con = init [!host] in bind_s con ~who:!binddn ~cred:!cred; let msgid = search con ~base:!base !filter in try while true do print_entry (get_search_entry con msgid); done with LDAP_Failure (`SUCCESS, _, _) -> print_endline "") else usage spec usg ;; main ();; ocamldap-2.1.8/testldif.ml0000644000175000017500000000221110444405447014776 0ustar gildorgildor(* a test program for the ldif libraries Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* $Id: testldif.ml 272 2005-10-19 00:53:46Z $ *) open Ooldif let _ = let ldif = new Ooldif.ldif () in ldif#write_entry ldif#read_entry, flush_all ocamldap-2.1.8/testoo.cmi0000644000175000017500000000123010444405447014635 0ustar gildorgildorCaml1999I010 &Testoo@[XS&Testoo0cµɕc0IK㠠-Ldap_ooclient0PTAJv{ndb$Š&Lexing0AS\6jS (%Array0ݖecV6ғ@<%Int320+oC߅mUraC&Printf0x~7>ъ젠&Buffer0EfF}P__*Pervasives0qE;&XF rt0Ldap_schemalexer0^9' f`ҭXXY&String0)+-,{K:}$Lber0ԌhF?S$List0Z25kя`aӠ#Arg0|L 5#Sys0w BUi]xA֠#Set0ŞAPÌE6(Ldap_url0 z!6+R^q1Ldap_schemaparser0ﵿ~Hrg?yǠ#Str0JY̞^5<*Ldap_types0wiM1i\tpjf'Ldif_oo0ߞ6xz&.Ldap_funclient0aWf|`'Hashtbl0!f{Ts@ocamldap-2.1.8/testoo.ml0000644000175000017500000000411510444405447014502 0ustar gildorgildor(* a test program for ldap_ooclient Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Ldap_types open Ldap_url open Ldap_funclient open Ldap_ooclient open Ldif_oo open Arg open Printf let _ = (* stuff to handle command line args *) let usg = "testoo -H -D -w -b " in let host = ref "" in let port = ref 389 in let binddn = ref "" in let cred = ref "" in let base = ref "" in let filter = ref "" in let set_host x = host := x in let set_port x = port := x in let set_binddn x = binddn := x in let set_cred x = cred := x in let set_base x = base := x in let set_filter x = filter := x in let spec = [("-H", String(set_host), "host"); ("-D", String(set_binddn), "dn to bind with"); ("-w", String(set_cred), "password to use when binding"); ("-b", String(set_base), "search base")] in (* do the ldap part *) if (Array.length Sys.argv) > 9 then (parse spec set_filter usg; let ldap = new ldapcon [!host] in let ldif = new ldif () in ldap#bind !binddn ~cred: !cred; Ldap_ooclient.iter (fun e -> ldif#write_entry e) (ldap#search_a ~base: !base !filter)) else usage spec usg ocamldap-2.1.8/ulist.ml0000644000175000017500000000303610444405447014326 0ustar gildorgildor(* case insensitive, case perserving, unique lists based on hash tables Copyright (C) 2004 Eric Stokes, and The California State University at Northridge This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type t = (string, string) Hashtbl.t;; let create n = Hashtbl.create n;; let mem lst item = Hashtbl.mem lst (String.lowercase item);; let add lst item = let lcitem = String.lowercase item in if (Hashtbl.mem lst lcitem) = false then Hashtbl.add lst lcitem item; ();; let addlst lst lst1 = List.iter (fun i -> add lst i) lst1;; let remove lst item = Hashtbl.remove lst (String.lowercase item);; let iter func lst = Hashtbl.iter (fun key valu -> func key) lst;; let tolst lst = Hashtbl.fold (fun k v l -> v :: l) lst [];;